diff options
| -rw-r--r-- | src/ChangeLog | 5 | ||||
| -rw-r--r-- | src/boot/ast.boot | 10 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 87 | ||||
| -rw-r--r-- | src/boot/strap/includer.clisp | 4 | ||||
| -rw-r--r-- | src/boot/strap/scanner.clisp | 22 |
5 files changed, 34 insertions, 94 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 9f822929..43a06c68 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,10 @@ 2012-05-26 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/ast.boot (bfMDef): Simplify. + (backquote): Do not quote integer and string literals. + +2012-05-26 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/tokens.boot: freshLine, functionSymbol?, and symbolGlobal? are now builin. * boot/ast.boot: Tidy. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index fe569735..6fef514a 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -916,13 +916,8 @@ bfMDef (op,args,body) == argl := bfTupleP args => rest args [args] - [gargl,sgargl,nargl,largl]:=bfGargl argl - sb := [[i,:j] for i in nargl for j in sgargl] - body := applySubst(sb,body) - sb2 := [["CONS",quote i,j] for i in sgargl for j in largl] - body := ["applySubst",["LIST",:sb2],quote body] - lamex:= ["MLAMBDA",gargl,body] - def:= [op,lamex] + lamex := ["MLAMBDA",argl,backquote(body,argl)] + def := [op,lamex] [shoeComp def,:[:shoeComps bfDef1 d for d in $wheredefs]] bfGargl argl== @@ -1424,6 +1419,7 @@ backquote(form,params) == params = nil => quote form form isnt [.,:.] => symbolMember?(form,params) => form + integer? form or string? form => form quote form ["LIST",:[backquote(t,params) for t in form]] diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 249192fa..ec55fefc 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -1462,86 +1462,30 @@ (LIST 'LAMBDA |vars| |body|))) (DEFUN |bfMDef| (|op| |args| |body|) - (LET* (|def| - |lamex| - |sb2| - |sb| - |largl| - |nargl| - |sgargl| - |gargl| - |LETTMP#1| - |argl|) + (LET* (|def| |lamex| |argl|) (DECLARE (SPECIAL |$wheredefs|)) (PROGN (SETQ |argl| (COND ((|bfTupleP| |args|) (CDR |args|)) (T (LIST |args|)))) - (SETQ |LETTMP#1| (|bfGargl| |argl|)) - (SETQ |gargl| (CAR |LETTMP#1|)) - (SETQ |sgargl| (CADR . #1=(|LETTMP#1|))) - (SETQ |nargl| (CADDR . #1#)) - (SETQ |largl| (CADDDR . #1#)) - (SETQ |sb| - (LET ((|bfVar#3| NIL) - (|bfVar#4| NIL) - (|bfVar#1| |nargl|) - (|i| NIL) - (|bfVar#2| |sgargl|) - (|j| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#1|)) - (PROGN (SETQ |i| (CAR |bfVar#1|)) NIL) - (NOT (CONSP |bfVar#2|)) - (PROGN (SETQ |j| (CAR |bfVar#2|)) NIL)) - (RETURN |bfVar#3|)) - ((NULL |bfVar#3|) - (SETQ |bfVar#3| #2=(CONS (CONS |i| |j|) NIL)) - (SETQ |bfVar#4| |bfVar#3|)) - (T (RPLACD |bfVar#4| #2#) (SETQ |bfVar#4| (CDR |bfVar#4|)))) - (SETQ |bfVar#1| (CDR |bfVar#1|)) - (SETQ |bfVar#2| (CDR |bfVar#2|))))) - (SETQ |body| (|applySubst| |sb| |body|)) - (SETQ |sb2| - (LET ((|bfVar#7| NIL) - (|bfVar#8| NIL) - (|bfVar#5| |sgargl|) - (|i| NIL) - (|bfVar#6| |largl|) - (|j| NIL)) - (LOOP - (COND - ((OR (NOT (CONSP |bfVar#5|)) - (PROGN (SETQ |i| (CAR |bfVar#5|)) NIL) - (NOT (CONSP |bfVar#6|)) - (PROGN (SETQ |j| (CAR |bfVar#6|)) NIL)) - (RETURN |bfVar#7|)) - ((NULL |bfVar#7|) - (SETQ |bfVar#7| #3=(CONS (LIST 'CONS (|quote| |i|) |j|) NIL)) - (SETQ |bfVar#8| |bfVar#7|)) - (T (RPLACD |bfVar#8| #3#) (SETQ |bfVar#8| (CDR |bfVar#8|)))) - (SETQ |bfVar#5| (CDR |bfVar#5|)) - (SETQ |bfVar#6| (CDR |bfVar#6|))))) - (SETQ |body| (LIST '|applySubst| (CONS 'LIST |sb2|) (|quote| |body|))) - (SETQ |lamex| (LIST 'MLAMBDA |gargl| |body|)) + (SETQ |lamex| (LIST 'MLAMBDA |argl| (|backquote| |body| |argl|))) (SETQ |def| (LIST |op| |lamex|)) (CONS (|shoeComp| |def|) - (LET ((|bfVar#10| NIL) - (|bfVar#11| NIL) - (|bfVar#9| |$wheredefs|) + (LET ((|bfVar#2| NIL) + (|bfVar#3| NIL) + (|bfVar#1| |$wheredefs|) (|d| NIL)) (LOOP (COND - ((OR (NOT (CONSP |bfVar#9|)) - (PROGN (SETQ |d| (CAR |bfVar#9|)) NIL)) - (RETURN |bfVar#10|)) + ((OR (NOT (CONSP |bfVar#1|)) + (PROGN (SETQ |d| (CAR |bfVar#1|)) NIL)) + (RETURN |bfVar#2|)) (T - (LET ((|bfVar#12| (|copyList| (|shoeComps| (|bfDef1| |d|))))) - (COND ((NULL |bfVar#12|) NIL) - ((NULL |bfVar#10|) (SETQ |bfVar#10| |bfVar#12|) - (SETQ |bfVar#11| (|lastNode| |bfVar#10|))) - (T (RPLACD |bfVar#11| |bfVar#12|) - (SETQ |bfVar#11| (|lastNode| |bfVar#11|))))))) - (SETQ |bfVar#9| (CDR |bfVar#9|)))))))) + (LET ((|bfVar#4| (|copyList| (|shoeComps| (|bfDef1| |d|))))) + (COND ((NULL |bfVar#4|) NIL) + ((NULL |bfVar#2|) (SETQ |bfVar#2| |bfVar#4|) + (SETQ |bfVar#3| (|lastNode| |bfVar#2|))) + (T (RPLACD |bfVar#3| |bfVar#4|) + (SETQ |bfVar#3| (|lastNode| |bfVar#3|))))))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))))))) (DEFUN |bfGargl| (|argl|) (LET* (|f| |d| |c| |b| |a| |LETTMP#1|) @@ -2769,6 +2713,7 @@ (COND ((NULL |params|) (|quote| |form|)) ((NOT (CONSP |form|)) (COND ((|symbolMember?| |form| |params|) |form|) + ((OR (INTEGERP |form|) (STRINGP |form|)) |form|) (T (|quote| |form|)))) (T (CONS 'LIST diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp index 02d2408b..ce957612 100644 --- a/src/boot/strap/includer.clisp +++ b/src/boot/strap/includer.clisp @@ -68,9 +68,7 @@ (DEFMACRO |sourceLineNumber| (|bfVar#1|) (LIST '|%SourceLine-num| |bfVar#1|)) -(DEFMACRO |makeSourceLine| (|bfVar#2| |bfVar#1|) - (|applySubst| (LIST (CONS '|bfVar#2| |bfVar#2|) (CONS '|bfVar#1| |bfVar#1|)) - '(|mk%SourceLine| |bfVar#2| |bfVar#1|))) +(DEFMACRO |makeSourceLine| (|s| |n|) (LIST '|mk%SourceLine| |s| |n|)) (DEFUN |lineNo| (|p|) (|sourceLineNumber| (CAAR |p|))) diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index 48582bbf..e1b8418a 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -34,13 +34,11 @@ (DEFUN |makeLexer| () (|mk%Lexer| NIL NIL)) -(DEFMACRO |lexerRefresh?| (|bfVar#1|) - (|applySubst| (LIST (CONS '|bfVar#1| |bfVar#1|)) - '(NULL (|lexerCurrentPosition| |bfVar#1|)))) +(DEFMACRO |lexerRefresh?| (|lex|) + (LIST 'NULL (LIST '|lexerCurrentPosition| |lex|))) -(DEFMACRO |lexerLineLength| (|bfVar#1|) - (|applySubst| (LIST (CONS '|bfVar#1| |bfVar#1|)) - '(LENGTH (|lexerLineString| |bfVar#1|)))) +(DEFMACRO |lexerLineLength| (|lex|) + (LIST 'LENGTH (LIST '|lexerLineString| |lex|))) (DEFUN |lexerSetLine!| (|lex| |line|) (PROGN @@ -63,14 +61,12 @@ (DEFUN |lexerCharCountToCompleteTab| (|lex|) (- 7 (REM (|lexerCurrentPosition| |lex|) 8))) -(DEFMACRO |lexerCurrentChar| (|bfVar#1|) - (|applySubst| (LIST (CONS '|bfVar#1| |bfVar#1|)) - '(SCHAR (|lexerLineString| |bfVar#1|) - (|lexerCurrentPosition| |bfVar#1|)))) +(DEFMACRO |lexerCurrentChar| (|lex|) + (LIST 'SCHAR (LIST '|lexerLineString| |lex|) + (LIST '|lexerCurrentPosition| |lex|))) -(DEFMACRO |lexerCharacterAt| (|bfVar#2| |bfVar#1|) - (|applySubst| (LIST (CONS '|bfVar#2| |bfVar#2|) (CONS '|bfVar#1| |bfVar#1|)) - '(SCHAR (|lexerLineString| |bfVar#2|) |bfVar#1|))) +(DEFMACRO |lexerCharacterAt| (|lex| |k|) + (LIST 'SCHAR (LIST '|lexerLineString| |lex|) |k|)) (DEFUN |lexerCharPosition| (|lex| |c|) (OR |