aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2012-05-26 20:44:45 +0000
committerdos-reis <gdr@axiomatics.org>2012-05-26 20:44:45 +0000
commit7be5c459a3b8d02d87e3a21edabfbf7227df613c (patch)
tree798aa13f0750fba0634acfc389937a6f5999eff3 /src
parent45e2d6c43648709ef9c00bf654617faf3229e1e6 (diff)
downloadopen-axiom-7be5c459a3b8d02d87e3a21edabfbf7227df613c.tar.gz
* boot/ast.boot (bfMDef): Simplify.
(backquote): Do not quote integer and string literals.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog5
-rw-r--r--src/boot/ast.boot10
-rw-r--r--src/boot/strap/ast.clisp87
-rw-r--r--src/boot/strap/includer.clisp4
-rw-r--r--src/boot/strap/scanner.clisp22
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