From bb81c833c0ff2ff8df936a0cd0182cf255729a41 Mon Sep 17 00:00:00 2001 From: Gabriel Dos Reis Date: Thu, 24 Dec 2015 10:22:27 -0800 Subject: Translate apply(f,[args]) as FUNCALL(f,args) --- src/boot/strap/ast.clisp | 74 +++++++++++++++++++++++++++++++++++++++-- src/boot/strap/includer.clisp | 4 +-- src/boot/strap/parser.clisp | 43 +++++++++++------------- src/boot/strap/tokens.clisp | 12 +++---- src/boot/strap/translator.clisp | 21 ++++++++---- src/boot/strap/utility.clisp | 58 +++++++++++++++++++++++++++++--- 6 files changed, 168 insertions(+), 44 deletions(-) (limited to 'src/boot/strap') diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 2b71acb9..820f308e 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -5,7 +5,8 @@ (PROVIDE "ast") -(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (EXPORT '|quote|)) +(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) + (EXPORT '(|quote| |translateForm|))) (DEFPARAMETER |$bfClamming| NIL) @@ -1282,7 +1283,7 @@ ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |y| (CAR |bfVar#1|)) NIL)) (RETURN |bfVar#2|)) - (T (SETQ |bfVar#2| (APPLY |pred| |y| NIL)) + (T (SETQ |bfVar#2| (FUNCALL |pred| |y|)) (COND ((NOT |bfVar#2|) (RETURN NIL))))) (SETQ |bfVar#1| (CDR |bfVar#1|))))))) @@ -2859,6 +2860,75 @@ (SETQ |args| (CDR |head|)) (LIST 'DEFTYPE |op| |args| (|backquote| |body| |args|))))) +(DEFUN |translateForm| (|x|) + (LET* (|ISTMP#2| |bindings| |init| |var| |ys| |args| |fun| |ISTMP#1|) + (COND ((NOT (CONSP |x|)) |x|) ((EQ (CAR |x|) 'QUOTE) |x|) + ((AND (EQ (CAR |x|) 'APPLY) + (PROGN + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SETQ |fun| (CAR |ISTMP#1|)) + (SETQ |args| (CDR |ISTMP#1|)) + T)))) + (COND + ((EQ (|lastItem| |args|) 'NIL) + (CONS 'FUNCALL + (CONS (|translateForm| |fun|) + (|listMap!| (|butLast!| |args|) #'|translateForm|)))) + ((AND (CONSP |args|) (NULL (CDR |args|)) + (PROGN + (SETQ |ISTMP#1| (CAR |args|)) + (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'LIST) + (PROGN (SETQ |ys| (CDR |ISTMP#1|)) T)))) + (CONS 'FUNCALL + (CONS (|translateForm| |fun|) + (|listMap!| |ys| #'|translateForm|)))) + (T (|listMap!| |x| #'|translateForm|)))) + ((EQ (CAR |x|) 'LET) + (SETQ |bindings| + (LET ((|bfVar#3| NIL) + (|bfVar#4| NIL) + (|bfVar#2| (CAR (CDR |x|))) + (|bfVar#1| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#2|)) + (PROGN (SETQ |bfVar#1| (CAR |bfVar#2|)) NIL)) + (RETURN |bfVar#3|)) + (T + (AND (CONSP |bfVar#1|) + (PROGN + (SETQ |var| (CAR |bfVar#1|)) + (SETQ |ISTMP#1| (CDR |bfVar#1|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (PROGN (SETQ |init| (CAR |ISTMP#1|)) T))) + (COND + ((NULL |bfVar#3|) + (SETQ |bfVar#3| + #1=(CONS + (LIST |var| + (|translateForm| |init|)) + NIL)) + (SETQ |bfVar#4| |bfVar#3|)) + (T (RPLACD |bfVar#4| #1#) + (SETQ |bfVar#4| (CDR |bfVar#4|))))))) + (SETQ |bfVar#2| (CDR |bfVar#2|))))) + (LIST (CAR |x|) |bindings| (|translateForm| (CADR (CDR |x|))))) + ((AND (CONSP |x|) (EQ (CAR |x|) 'L%T) + (PROGN + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) + (PROGN + (SETQ |var| (CAR |ISTMP#1|)) + (SETQ |ISTMP#2| (CDR |ISTMP#1|)) + (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) + (PROGN (SETQ |init| (CAR |ISTMP#2|)) T)))))) + (LIST (CAR |x|) |var| (|translateForm| |init|))) + ((|symbolMember?| (CAR |x|) '(PROGN LOOP RETURN)) + (CONS (CAR |x|) (|listMap!| (CDR |x|) #'|translateForm|))) + (T (|listMap!| |x| #'|translateForm|))))) + (DEFCONSTANT |$NativeSimpleDataTypes| '(|char| |byte| |int| |pointer| |int8| |uint8| |int16| |uint16| |int32| |uint32| |int64| |uint64| |float| |float32| |double| |float64|)) diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp index e2cf37f2..bd556ea1 100644 --- a/src/boot/strap/includer.clisp +++ b/src/boot/strap/includer.clisp @@ -83,7 +83,7 @@ (DEFUN |bMap1| (|f| |x|) (COND ((|bStreamNull| |x|) |$bStreamNil|) - (T (CONS (APPLY |f| (LIST (CAR |x|))) (|bMap| |f| (CDR |x|)))))) + (T (CONS (FUNCALL |f| (CAR |x|)) (|bMap| |f| (CDR |x|)))))) (DEFUN |bDelay| (|f| |x|) (CONS '|nonnullstream| (CONS |f| |x|))) @@ -100,7 +100,7 @@ (DEFUN |bNext1| (|f| |s|) (LET* (|h|) (COND ((|bStreamNull| |s|) (LIST '|nullstream|)) - (T (SETQ |h| (APPLY |f| (LIST |s|))) + (T (SETQ |h| (FUNCALL |f| |s|)) (|bAppend| (CAR |h|) (|bNext| |f| (CDR |h|))))))) (DEFUN |bRgen| (|s|) (|bDelay| #'|bRgen1| (LIST |s|))) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 7684716b..50a1b076 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -84,7 +84,7 @@ (SETF (|parserTokens| |ps|) (CDR (|parserTokens| |ps|))) (|bpFirstToken| |ps|))) -(DEFUN |bpRequire| (|ps| |f|) (OR (APPLY |f| |ps| NIL) (|bpTrap| |ps|))) +(DEFUN |bpRequire| (|ps| |f|) (OR (FUNCALL |f| |ps|) (|bpTrap| |ps|))) (DEFUN |bpState| (|ps|) (LIST (|parserTokens| |ps|) (|parserTrees| |ps|) (|parserNesting| |ps|) @@ -140,7 +140,7 @@ (SETF (|parserNesting| |ps|) (+ (|parserNesting| |ps|) 1)) (|bpNext| |ps|) (COND - ((AND (APPLY |f| |ps| NIL) (|bpFirstTok| |ps|) + ((AND (FUNCALL |f| |ps|) (|bpFirstTok| |ps|) (OR (|bpEqPeek| |ps| 'CPAREN) (|bpParenTrap| |ps| |a|))) (SETF (|parserNesting| |ps|) (- (|parserNesting| |ps|) 1)) (|bpNextToken| |ps|) @@ -167,7 +167,7 @@ (COND ((|bpEqKey| |ps| 'OPAREN) (COND - ((AND (APPLY |f| |ps| NIL) + ((AND (FUNCALL |f| |ps|) (OR (|bpEqKey| |ps| 'CPAREN) (|bpParenTrap| |ps| |a|))) T) ((|bpEqKey| |ps| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL)) T) @@ -181,7 +181,7 @@ (COND ((|bpEqKey| |ps| 'OBRACK) (COND - ((AND (APPLY |f| |ps| NIL) + ((AND (FUNCALL |f| |ps|) (OR (|bpEqKey| |ps| 'CBRACK) (|bpBrackTrap| |ps| |a|))) (|bpPush| |ps| (|bfBracket| (|bpPop1| |ps|)))) ((|bpEqKey| |ps| 'CBRACK) (|bpPush| |ps| NIL)) @@ -192,7 +192,7 @@ (COND ((|bpEqKey| |ps| 'SETTAB) (COND ((|bpEqKey| |ps| 'BACKTAB) T) - ((AND (APPLY |f| |ps| NIL) + ((AND (FUNCALL |f| |ps|) (OR (|bpEqKey| |ps| 'BACKTAB) (|bpPileTrap| |ps|))) (|bpPush| |ps| (|bfPile| (|bpPop1| |ps|)))) (T NIL))) @@ -201,7 +201,7 @@ (DEFUN |bpListof| (|ps| |f| |str1| |g|) (LET* (|a|) (COND - ((APPLY |f| |ps| NIL) + ((FUNCALL |f| |ps|) (COND ((AND (|bpEqKey| |ps| |str1|) (|bpRequire| |ps| |f|)) (SETQ |a| (|parserTrees| |ps|)) (SETF (|parserTrees| |ps|) NIL) @@ -222,14 +222,13 @@ (DEFUN |bpListofFun| (|ps| |f| |h| |g|) (LET* (|a|) (COND - ((APPLY |f| |ps| NIL) + ((FUNCALL |f| |ps|) (COND - ((AND (APPLY |h| |ps| NIL) (|bpRequire| |ps| |f|)) + ((AND (FUNCALL |h| |ps|) (|bpRequire| |ps| |f|)) (SETQ |a| (|parserTrees| |ps|)) (SETF (|parserTrees| |ps|) NIL) (LOOP (COND - ((NOT (AND (APPLY |h| |ps| NIL) (|bpRequire| |ps| |f|))) - (RETURN NIL)) + ((NOT (AND (FUNCALL |h| |ps|) (|bpRequire| |ps| |f|))) (RETURN NIL)) (T NIL))) (SETF (|parserTrees| |ps|) (CONS (|reverse!| (|parserTrees| |ps|)) |a|)) @@ -243,7 +242,7 @@ (DEFUN |bpList| (|ps| |f| |str1|) (LET* (|a|) (COND - ((APPLY |f| |ps| NIL) + ((FUNCALL |f| |ps|) (COND ((AND (|bpEqKey| |ps| |str1|) (|bpRequire| |ps| |f|)) (SETQ |a| (|parserTrees| |ps|)) (SETF (|parserTrees| |ps|) NIL) @@ -263,15 +262,15 @@ (DEFUN |bpOneOrMore| (|ps| |f|) (LET* (|a|) (COND - ((APPLY |f| |ps| NIL) (SETQ |a| (|parserTrees| |ps|)) + ((FUNCALL |f| |ps|) (SETQ |a| (|parserTrees| |ps|)) (SETF (|parserTrees| |ps|) NIL) - (LOOP (COND ((NOT (APPLY |f| |ps| NIL)) (RETURN NIL)) (T NIL))) + (LOOP (COND ((NOT (FUNCALL |f| |ps|)) (RETURN NIL)) (T NIL))) (SETF (|parserTrees| |ps|) (CONS (|reverse!| (|parserTrees| |ps|)) |a|)) (|bpPush| |ps| (CONS (|bpPop2| |ps|) (|bpPop1| |ps|)))) (T NIL)))) (DEFUN |bpAnyNo| (|ps| |s|) - (PROGN (LOOP (COND ((NOT (APPLY |s| |ps| NIL)) (RETURN NIL)) (T NIL))) T)) + (PROGN (LOOP (COND ((NOT (FUNCALL |s| |ps|)) (RETURN NIL)) (T NIL))) T)) (DEFUN |bpAndOr| (|ps| |keyword| |p| |f|) (AND (|bpEqKey| |ps| |keyword|) (|bpRequire| |ps| |p|) @@ -388,9 +387,8 @@ (COND (|done| (RETURN NIL)) (T (SETQ |found| - (LET ((#1=#:G727 - (CATCH :OPEN-AXIOM-CATCH-POINT - (APPLY |f| |ps| NIL)))) + (LET ((#1=#:G392 + (CATCH :OPEN-AXIOM-CATCH-POINT (FUNCALL |f| |ps|)))) (COND ((AND (CONSP #1#) (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT)) @@ -730,7 +728,7 @@ (PROGN (SETQ |a| (|bpState| |ps|)) (COND - ((APPLY |p| |ps| NIL) + ((FUNCALL |p| |ps|) (LOOP (COND ((NOT @@ -746,7 +744,7 @@ (DEFUN |bpLeftAssoc| (|ps| |operations| |parser|) (COND - ((APPLY |parser| |ps| NIL) + ((FUNCALL |parser| |ps|) (LOOP (COND ((NOT @@ -1057,9 +1055,8 @@ (DEFUN |bpCompoundDefinitionTail| (|ps| |f|) (AND (|bpVariable| |ps|) (|bpEqKey| |ps| 'DEF) (|bpRequire| |ps| #'|bpWhere|) (|bpPush| |ps| - (APPLY |f| - (LIST (|bpPop3| |ps|) (|bpPop2| |ps|) - (|bpPop1| |ps|)))))) + (FUNCALL |f| (|bpPop3| |ps|) (|bpPop2| |ps|) + (|bpPop1| |ps|))))) (DEFUN |bpDefTail| (|ps| |f|) (OR (|bpSimpleDefinitionTail| |ps|) (|bpCompoundDefinitionTail| |ps| |f|))) @@ -1378,7 +1375,7 @@ (SETQ |op| (|enclosingFunction| (|parserLoadUnit| |ps|))) (SETQ |varno| (|parserGensymSequenceNumber| |ps|)) (UNWIND-PROTECT - (LET ((#1=#:G728 + (LET ((#1=#:G393 (CATCH :OPEN-AXIOM-CATCH-POINT (PROGN (SETF (|enclosingFunction| (|parserLoadUnit| |ps|)) NIL) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 6fa7d340..9f975637 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -84,10 +84,10 @@ (LET* (|s|) (COND ((SETQ |s| - (WITH-HASH-TABLE-ITERATOR (#1=#:G726 |shoeKeyTable|) + (WITH-HASH-TABLE-ITERATOR (#1=#:G391 |shoeKeyTable|) (LET ((|bfVar#1| NIL)) (LOOP - (MULTIPLE-VALUE-BIND (#2=#:G727 |k| |v|) + (MULTIPLE-VALUE-BIND (#2=#:G392 |k| |v|) (#1#) (COND ((NOT #2#) (RETURN |bfVar#1|)) (T @@ -138,9 +138,9 @@ (COND ((> |i| 255) (RETURN NIL)) (T (SETF (ELT |a| |i|) |b|))) (SETQ |i| (+ |i| 1)))) |a|)) - (WITH-HASH-TABLE-ITERATOR (#1=#:G728 |shoeKeyTable|) + (WITH-HASH-TABLE-ITERATOR (#1=#:G393 |shoeKeyTable|) (LOOP - (MULTIPLE-VALUE-BIND (#2=#:G729 |s| #:G730) + (MULTIPLE-VALUE-BIND (#2=#:G394 |s| #:G395) (#1#) (COND ((NOT #2#) (RETURN NIL)) (T (|shoeInsert| |s| |d|)))))) |d|))) @@ -154,9 +154,9 @@ (LET ((|i| 0)) (LOOP (COND ((> |i| 255) (RETURN NIL)) (T (SETF (SBIT |a| |i|) 0))) (SETQ |i| (+ |i| 1)))) - (WITH-HASH-TABLE-ITERATOR (#1=#:G731 |shoeKeyTable|) + (WITH-HASH-TABLE-ITERATOR (#1=#:G396 |shoeKeyTable|) (LOOP - (MULTIPLE-VALUE-BIND (#2=#:G732 |k| #:G733) + (MULTIPLE-VALUE-BIND (#2=#:G397 |k| #:G398) (#1#) (COND ((NOT #2#) (RETURN NIL)) ((|shoeStartsId| (SCHAR |k| 0)) NIL) (T (SETF (SBIT |a| (CHAR-CODE (SCHAR |k| 0))) 1)))))) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index 99d7f82a..8e7ab21c 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -16,7 +16,7 @@ (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (EXPORT '(|evalBootFile| |loadNativeModule| |loadSystemRuntimeCore| - |string2BootTree| |genImportDeclaration|))) + |string2BootTree| |genImportDeclaration| |retainFile?|))) (DEFPARAMETER |$currentModuleName| NIL) @@ -416,7 +416,7 @@ (SETQ |ps| (|makeParserState| |toks|)) (|bpFirstTok| |ps|) (SETQ |found| - (LET ((#1=#:G736 + (LET ((#1=#:G401 (CATCH :OPEN-AXIOM-CATCH-POINT (|bpOutItem| |ps|)))) (COND ((AND (CONSP #1#) (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT)) @@ -585,7 +585,9 @@ (LET ((|op| (CADR |b|)) (|args| (CADDR |b|)) (|body| (CADDDR |b|))) - (CDR (|bfDef| (|parserLoadUnit| |ps|) |op| |args| |body|)))) + (CDR + (|bfDef| (|parserLoadUnit| |ps|) |op| |args| + (|translateForm| |body|))))) (|%Module| (LET ((|m| (CADR |b|)) (|ns| (CADDR |b|)) (|ds| (CADDDR |b|))) (PROGN @@ -659,7 +661,7 @@ (SETQ |sig| (|genDeclaration| |n| |t|)) (SETQ |lhs| |n|))) (SETQ |$constantIdentifiers| (CONS |lhs| |$constantIdentifiers|)) - (LIST (LIST 'DEFCONSTANT |lhs| |rhs|)))))) + (LIST (LIST 'DEFCONSTANT |lhs| (|translateForm| |rhs|))))))) (|%Assignment| (LET ((|lhs| (CADR |b|)) (|rhs| (CADDR |b|))) (PROGN @@ -676,12 +678,16 @@ (PROGN (SETQ |t| (CAR |ISTMP#2|)) T)))))) (SETQ |sig| (|genDeclaration| |n| |t|)) (SETQ |lhs| |n|))) (COND (|$InteractiveMode| (LIST (LIST 'SETF |lhs| |rhs|))) - (T (LIST (LIST 'DEFPARAMETER |lhs| |rhs|))))))) + (T + (LIST + (LIST 'DEFPARAMETER |lhs| + (|translateForm| |rhs|)))))))) (|%Macro| (LET ((|op| (CADR |b|)) (|args| (CADDR |b|)) (|body| (CADDDR |b|))) - (|bfMDef| (|parserLoadUnit| |ps|) |op| |args| |body|))) + (|bfMDef| (|parserLoadUnit| |ps|) |op| |args| + (|translateForm| |body|)))) (|%Structure| (LET ((|t| (CADR |b|)) (|alts| (CADDR |b|))) (COND @@ -733,7 +739,8 @@ (|%Lisp| (LET ((|s| (CADR |b|))) (|shoeReadLispString| |s| 0))) - (T (LIST (|translateToplevelExpression| |b|)))))))) + (T + (LIST (|translateToplevelExpression| (|translateForm| |b|))))))))) (DEFUN |shoeAddbootIfNec| (|s|) (LET* (|n2| |n1| |ext|) diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp index 1a288c10..784ec366 100644 --- a/src/boot/strap/utility.clisp +++ b/src/boot/strap/utility.clisp @@ -18,7 +18,8 @@ '(|objectMember?| |symbolMember?| |stringMember?| |charMember?| |scalarMember?| |listMember?| |reverse| |reverse!| |lastNode| |append| |append!| |copyList| |substitute| - |substitute!| |setDifference| |setUnion| |setIntersection| + |substitute!| |listMap| |listMap!| |butLast| |butLast!| + |lastItem| |setDifference| |setUnion| |setIntersection| |symbolAssoc| |applySubst| |applySubst!| |applySubstNQ| |objectAssoc| |invertSubst| |substTarget| |substSource| |remove| |removeSymbol| |atomic?| |every?| |any?| |take| @@ -43,6 +44,12 @@ (FTYPE (FUNCTION ((|%List| |%Thing|)) (|%Maybe| (|%Node| |%Thing|))) |lastNode|)) +(DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|)) |%Thing|) |lastItem|)) + +(DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|)) (|%List| |%Thing|)) |butLast|)) + +(DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|)) (|%List| |%Thing|)) |butLast!|)) + (DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|) |%Symbol|) (|%List| |%Thing|)) |removeSymbol|)) @@ -120,7 +127,7 @@ (COND ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) (RETURN |bfVar#2|)) - (T (SETQ |bfVar#2| (APPLY |f| |x| NIL)) + (T (SETQ |bfVar#2| (FUNCALL |f| |x|)) (COND ((NOT |bfVar#2|) (RETURN NIL))))) (SETQ |bfVar#1| (CDR |bfVar#1|))))) @@ -130,7 +137,7 @@ (COND ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) (RETURN |bfVar#2|)) - (T (SETQ |bfVar#2| (APPLY |f| |x| NIL)) + (T (SETQ |bfVar#2| (FUNCALL |f| |x|)) (COND (|bfVar#2| (RETURN |bfVar#2|))))) (SETQ |bfVar#1| (CDR |bfVar#1|))))) @@ -159,7 +166,7 @@ (LOOP (COND ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL) - (NOT (APPLY |f| |x| NIL))) + (NOT (FUNCALL |f| |x|))) (RETURN |bfVar#2|)) ((NULL |bfVar#2|) (SETQ |bfVar#2| #1=(CONS |x| NIL)) (SETQ |bfVar#3| |bfVar#2|)) @@ -254,6 +261,29 @@ (T (SETQ |l| |l'|)))) |l|))) +(DEFUN |lastItem| (|l|) (CAR (|lastNode| |l|))) + +(DEFUN |butLast| (|l|) + (LET* (|xs| |LETTMP#1|) + (COND ((NOT (CONSP |l|)) NIL) + (T (SETQ |LETTMP#1| (|reverse| |l|)) + (SETQ |xs| (|reverse!| (CDR |LETTMP#1|))) |xs|)))) + +(DEFUN |butLast!| (|l|) + (LET* (|ISTMP#1|) + (COND ((OR (NOT (CONSP |l|)) (NULL (CDR |l|))) NIL) + (T + (LET ((|xs| |l|)) + (LOOP + (COND ((NOT (CONSP |xs|)) (RETURN NIL)) + ((AND (CONSP |xs|) + (PROGN + (SETQ |ISTMP#1| (CDR |xs|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))))) + (IDENTITY (RETURN (RPLACD |xs| NIL))))) + (SETQ |xs| (CDR |xs|)))) + |l|)))) + (DEFUN |copyList| (|l|) (LET* (|l'| |t|) (COND ((NOT (CONSP |l|)) |l|) @@ -271,6 +301,26 @@ (DEFUN |append| (|x| |y|) (|append!| (|copyList| |x|) |y|)) +(DEFUN |listMap| (|l| |fun|) + (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| |l|) (|x| NIL)) + (LOOP + (COND + ((OR (NOT (CONSP |bfVar#1|)) (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) + ((NULL |bfVar#2|) (SETQ |bfVar#2| #1=(CONS (FUNCALL |fun| |x|) NIL)) + (SETQ |bfVar#3| |bfVar#2|)) + (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|)))) + (SETQ |bfVar#1| (CDR |bfVar#1|))))) + +(DEFUN |listMap!| (|l| |fun|) + (PROGN + (LET ((|xs| |l|)) + (LOOP + (COND ((NOT (CONSP |xs|)) (RETURN NIL)) + (T (RPLACA |xs| (FUNCALL |fun| (CAR |xs|))))) + (SETQ |xs| (CDR |xs|)))) + |l|)) + (DEFUN |symbolAssoc| (|s| |l|) (LET* (|x|) (LOOP -- cgit v1.2.3