diff options
author | dos-reis <gdr@axiomatics.org> | 2009-01-06 06:53:21 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2009-01-06 06:53:21 +0000 |
commit | 258d6427280f1ee0cce0dcdf12c38ad65b5e36cc (patch) | |
tree | 7c37449e24bbcfba741729b6d16a71b9c5007ea4 /src/algebra/strap/LSAGG-.lsp | |
parent | bd3fb898659b91542e7a3109f36b2f8b17e05a5d (diff) | |
download | open-axiom-258d6427280f1ee0cce0dcdf12c38ad65b5e36cc.tar.gz |
* interp/sys-utility.boot (getVMType): IndexList are lists.
* interp/g-util.boot (isSubDomain): Tidy.
* interp/g-opt.boot (isVMConstantForm): New.
(findVMFreeVars): Likewise.
* interp/define.boot (insertViewMorphisms): Remove.
(emitSubdomainInfo): New.
(checkVariableName): Likewise.
(checkParameterNames): Likewise.
(checkRepresentation): Set $subdomain where appropriate.
(compDefines): Check parameter names.
(compDefineFunctor1): Propagate subdomain info.
(doIt): Don't call insertViewMorphisms.
* interp/compiler.boot (setqSingle): Check variable name.
(compIterator): Likewise.
(commonSuperType): New.
(satisfies): Likewise.
(coerceSubset): Use them to implemen cross-subdomain coercion.
(coerceSuperset): New.
(comCoerce1): Use it.
(compPer): New.
(compRep): Likewise.
* interp/c-util.boot (getRepresentation): New.
(proclaimCapsuleFunction): Improve for specialized subdomains.
* algebra/stream.spad.pamphlet: Don't use `per' as variable name.
* algebra/si.spad.pamphlet (size$SingleInteger): Tidy.
(coerce$SingleInteger): Likewise.
* algebra/reclos.spad.pamphlet (nonNull$RealClosure): Don't use
`rep' as parameter name.
* algebra/data.spad.pamphlet (Byte): Now a subdomain of
NonNegativeInteger. Tidy.
Diffstat (limited to 'src/algebra/strap/LSAGG-.lsp')
-rw-r--r-- | src/algebra/strap/LSAGG-.lsp | 51 |
1 files changed, 33 insertions, 18 deletions
diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp index c33ce4f3..380c9292 100644 --- a/src/algebra/strap/LSAGG-.lsp +++ b/src/algebra/strap/LSAGG-.lsp @@ -238,7 +238,7 @@ (EXIT |r|)))))))) (DEFUN |LSAGG-;insert!;SAIA;7| (|s| |x| |i| $) - (PROG (|m| #0=#:G1464 |y| |z|) + (PROG (|m| #0=#:G1465 |y| |z|) (RETURN (SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 31)) |LSAGG-;insert!;SAIA;7|) @@ -252,7 +252,8 @@ (PROG1 (LETT #0# (- (- |i| 1) |m|) |LSAGG-;insert!;SAIA;7|) - (|check-subtype| (>= #0# 0) + (|check-subtype| + (COND ((< #0# 0) 'NIL) ('T 'T)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 32)) |LSAGG-;insert!;SAIA;7|) @@ -265,7 +266,7 @@ (EXIT |x|))))))))) (DEFUN |LSAGG-;insert!;2AIA;8| (|w| |x| |i| $) - (PROG (|m| #0=#:G1468 |y| |z|) + (PROG (|m| #0=#:G1469 |y| |z|) (RETURN (SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 31)) |LSAGG-;insert!;2AIA;8|) @@ -279,7 +280,8 @@ (PROG1 (LETT #0# (- (- |i| 1) |m|) |LSAGG-;insert!;2AIA;8|) - (|check-subtype| (>= #0# 0) + (|check-subtype| + (COND ((< #0# 0) 'NIL) ('T 'T)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 32)) |LSAGG-;insert!;2AIA;8|) @@ -344,7 +346,7 @@ (EXIT |x|))))))))) (DEFUN |LSAGG-;delete!;AIA;10| (|x| |i| $) - (PROG (|m| #0=#:G1480 |y|) + (PROG (|m| #0=#:G1481 |y|) (RETURN (SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 31)) |LSAGG-;delete!;AIA;10|) @@ -358,7 +360,8 @@ (PROG1 (LETT #0# (- (- |i| 1) |m|) |LSAGG-;delete!;AIA;10|) - (|check-subtype| (>= #0# 0) + (|check-subtype| + (COND ((< #0# 0) 'NIL) ('T 'T)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 32)) |LSAGG-;delete!;AIA;10|) @@ -368,7 +371,7 @@ (EXIT |x|))))))))) (DEFUN |LSAGG-;delete!;AUsA;11| (|x| |i| $) - (PROG (|l| |m| |h| #0=#:G1485 #1=#:G1486 |t| #2=#:G1487) + (PROG (|l| |m| |h| #0=#:G1486 #1=#:G1487 |t| #2=#:G1488) (RETURN (SEQ (LETT |l| (SPADCALL |i| (|getShellEntry| $ 39)) |LSAGG-;delete!;AUsA;11|) @@ -391,7 +394,10 @@ (PROG1 (LETT #0# (- (+ |h| 1) |m|) |LSAGG-;delete!;AUsA;11|) - (|check-subtype| (>= #0# 0) + (|check-subtype| + (COND + ((< #0# 0) 'NIL) + ('T 'T)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 32))) ('T @@ -400,7 +406,10 @@ (PROG1 (LETT #1# (- (- |l| 1) |m|) |LSAGG-;delete!;AUsA;11|) - (|check-subtype| (>= #1# 0) + (|check-subtype| + (COND + ((< #1# 0) 'NIL) + ('T 'T)) '(|NonNegativeInteger|) #1#)) (|getShellEntry| $ 32)) @@ -410,7 +419,10 @@ (PROG1 (LETT #2# (+ (- |h| |l|) 2) |LSAGG-;delete!;AUsA;11|) - (|check-subtype| (>= #2# 0) + (|check-subtype| + (COND + ((< #2# 0) 'NIL) + ('T 'T)) '(|NonNegativeInteger|) #2#)) (|getShellEntry| $ 32)) @@ -461,7 +473,7 @@ ('T |k|))))))) (DEFUN |LSAGG-;mergeSort| (|f| |p| |n| $) - (PROG (#0=#:G1507 |l| |q|) + (PROG (#0=#:G1508 |l| |q|) (RETURN (SEQ (COND ((EQL |n| 2) @@ -478,7 +490,8 @@ (SEQ (LETT |l| (PROG1 (LETT #0# (QUOTIENT2 |n| 2) |LSAGG-;mergeSort|) - (|check-subtype| (>= #0# 0) + (|check-subtype| + (COND ((< #0# 0) 'NIL) ('T 'T)) '(|NonNegativeInteger|) #0#)) |LSAGG-;mergeSort|) (LETT |q| @@ -495,7 +508,7 @@ (|getShellEntry| $ 23))))))))))) (DEFUN |LSAGG-;sorted?;MAB;15| (|f| |l| $) - (PROG (#0=#:G1516 |p|) + (PROG (#0=#:G1517 |p|) (RETURN (SEQ (EXIT (COND ((SPADCALL |l| (|getShellEntry| $ 16)) 'T) @@ -675,7 +688,7 @@ (EXIT (SPADCALL |y| (|getShellEntry| $ 47))))))) (DEFUN |LSAGG-;copyInto!;2AIA;22| (|y| |x| |s| $) - (PROG (|m| #0=#:G1545 |z|) + (PROG (|m| #0=#:G1546 |z|) (RETURN (SEQ (LETT |m| (SPADCALL |y| (|getShellEntry| $ 31)) |LSAGG-;copyInto!;2AIA;22|) @@ -687,7 +700,8 @@ (PROG1 (LETT #0# (- |s| |m|) |LSAGG-;copyInto!;2AIA;22|) - (|check-subtype| (>= #0# 0) + (|check-subtype| + (COND ((< #0# 0) 'NIL) ('T 'T)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 32)) |LSAGG-;copyInto!;2AIA;22|) @@ -719,7 +733,7 @@ (EXIT |y|))))))))) (DEFUN |LSAGG-;position;SA2I;23| (|w| |x| |s| $) - (PROG (|m| #0=#:G1552 |k|) + (PROG (|m| #0=#:G1553 |k|) (RETURN (SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 31)) |LSAGG-;position;SA2I;23|) @@ -731,7 +745,8 @@ (PROG1 (LETT #0# (- |s| |m|) |LSAGG-;position;SA2I;23|) - (|check-subtype| (>= #0# 0) + (|check-subtype| + (COND ((< #0# 0) 'NIL) ('T 'T)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 32)) |LSAGG-;position;SA2I;23|) @@ -795,7 +810,7 @@ (|getShellEntry| $ 61)))))) (DEFUN |LSAGG-;<;2AB;25| (|x| |y| $) - (PROG (#0=#:G1566) + (PROG (#0=#:G1567) (RETURN (SEQ (EXIT (SEQ (SEQ G190 (COND |