diff options
| author | dos-reis <gdr@axiomatics.org> | 2011-02-27 00:57:26 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2011-02-27 00:57:26 +0000 |
| commit | e8ca9eab6dee408a68683147e9df2f0c81c4354e (patch) | |
| tree | ff2edb143d41d09c3a5d57ac5485c3039368dea0 /src/algebra/strap/FFIELDC-.lsp | |
| parent | df02d2410007b60d0ee057da174552847c0005f0 (diff) | |
| download | open-axiom-e8ca9eab6dee408a68683147e9df2f0c81c4354e.tar.gz | |
* interp/g-opt.boot (optCond): Recognize conjunction and
disjunction forms.
Diffstat (limited to 'src/algebra/strap/FFIELDC-.lsp')
| -rw-r--r-- | src/algebra/strap/FFIELDC-.lsp | 42 |
1 files changed, 23 insertions, 19 deletions
diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp index 80bd0663..81b79b54 100644 --- a/src/algebra/strap/FFIELDC-.lsp +++ b/src/algebra/strap/FFIELDC-.lsp @@ -115,25 +115,29 @@ (EXIT |e|)))))) (DEFUN |FFIELDC-;primitive?;SB;9| (|a| $) - (COND - ((SPADCALL |a| (|shellEntry| $ 16)) NIL) - (T (LET ((|explist| (SPADCALL (|shellEntry| $ 56))) - (|q| (- (SPADCALL (|shellEntry| $ 40)) 1)) - (|equalone| NIL)) - (SEQ (LET ((#0=#:G1488 |explist|) (|exp| NIL)) - (LOOP - (COND - ((OR (ATOM #0#) (PROGN (SETQ |exp| (CAR #0#)) NIL) - (NOT (NOT |equalone|))) - (RETURN NIL)) - (T (SETQ |equalone| - (SPADCALL - (SPADCALL |a| - (TRUNCATE |q| (CAR |exp|)) - (|shellEntry| $ 58)) - (|shellEntry| $ 59))))) - (SETQ #0# (CDR #0#)))) - (EXIT (NOT |equalone|))))))) + (PROG (|explist| |q| |equalone|) + (RETURN + (AND (NOT (SPADCALL |a| (|shellEntry| $ 16))) + (SEQ (LETT |explist| (SPADCALL (|shellEntry| $ 56)) + |FFIELDC-;primitive?;SB;9|) + (LETT |q| (- (SPADCALL (|shellEntry| $ 40)) 1) + |FFIELDC-;primitive?;SB;9|) + (LETT |equalone| NIL |FFIELDC-;primitive?;SB;9|) + (LET ((#0=#:G1488 |explist|) (|exp| NIL)) + (LOOP + (COND + ((OR (ATOM #0#) + (PROGN (SETQ |exp| (CAR #0#)) NIL) + (NOT (NOT |equalone|))) + (RETURN NIL)) + (T (SETQ |equalone| + (SPADCALL + (SPADCALL |a| + (TRUNCATE |q| (CAR |exp|)) + (|shellEntry| $ 58)) + (|shellEntry| $ 59))))) + (SETQ #0# (CDR #0#)))) + (EXIT (NOT |equalone|))))))) (DEFUN |FFIELDC-;order;SPi;10| (|e| $) (PROG (|primeDivisor| |a| |goon|) |