diff options
author | dos-reis <gdr@axiomatics.org> | 2011-08-05 16:42:50 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-08-05 16:42:50 +0000 |
commit | 207c5a13c6987ad88975c35006d16c74d0e58e1a (patch) | |
tree | 9c15509f1153868e6df6210cca98dffb84ea7000 | |
parent | 2a4baaa2a295381d6c37ec2fc7c3f7ec8fd089cf (diff) | |
download | open-axiom-207c5a13c6987ad88975c35006d16c74d0e58e1a.tar.gz |
cleanup
-rw-r--r-- | src/boot/ast.boot | 39 | ||||
-rw-r--r-- | src/boot/parser.boot | 2 | ||||
-rw-r--r-- | src/boot/strap/ast.clisp | 40 | ||||
-rw-r--r-- | src/boot/strap/parser.clisp | 2 | ||||
-rw-r--r-- | src/boot/strap/translator.clisp | 8 | ||||
-rw-r--r-- | src/boot/translator.boot | 8 |
6 files changed, 46 insertions, 53 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot index a3d84d33..8d5405e5 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -148,7 +148,7 @@ bfColonColon(package, name) == bfSymbol: %Thing -> %Thing bfSymbol x== string? x=> x - ['QUOTE,x] + quote x bfDot: () -> %Symbol @@ -702,7 +702,7 @@ bfIS1(lhs,rhs) == bfHas(expr,prop) == - symbol? prop => ["GET",expr,["QUOTE",prop]] + symbol? prop => ["GET",expr, quote prop] bpSpecificErrorHere('"expected identifier as property name") bfApplication(bfop, bfarg) == @@ -734,7 +734,7 @@ bfMember(var,seq) == seq is ["QUOTE",[x]] => ["EQL",var,x] ["scalarMember?",var,seq] defQuoteId var or sequence?(seq,function symbol?) => - seq is ["QUOTE",[x]] => ["EQ",var,["QUOTE",x]] + seq is ["QUOTE",[x]] => ["EQ",var, quote x] ["symbolMember?",var,seq] idList? seq => seq.args is [.] => ["EQ",var,:seq.args] @@ -837,8 +837,8 @@ bfMDef (op,args,body) == [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]] + 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] [shoeComp def,:[:shoeComps bfDef1 d for d in $wheredefs]] @@ -848,7 +848,7 @@ bfGargl argl== [a,b,c,d] := bfGargl rest argl first argl is "&REST" => [[first argl,:b],b,c, - [["CONS",["QUOTE","LIST"],first d],:rest d]] + [["CONS",quote "LIST",first d],:rest d]] f := bfGenSymbol() [[f,:a],[f,:b],[first argl,:c],[f,:d]] @@ -864,8 +864,8 @@ shoeLAM (op,args,control,body)== margs :=bfGenSymbol() innerfunc:= makeSymbol strconc(symbolName op,'",LAM") [[innerfunc,["LAMBDA",args,body]], - [op,["MLAMBDA",["&REST",margs],["CONS",["QUOTE", innerfunc], - ["WRAP",margs, ["QUOTE", control]]]]]] + [op,["MLAMBDA",["&REST",margs],["CONS", quote innerfunc, + ["WRAP",margs,quote control]]]]] bfDef(op,args,body) == $bfClamming => @@ -1159,16 +1159,13 @@ bfMain(auxfn,op)== mainFunction:= ["DEFUN",op,arg,codeBody] cacheType:= 'hash_-table - cacheResetCode:= ['SETQ,cacheName,['MAKE_-HASHTABLE, - ["QUOTE","UEQUAL"]]] - cacheCountCode:= ['hashCount,cacheName] + cacheResetCode := ['SETQ,cacheName,['MAKE_-HASHTABLE,quote "UEQUAL"]] + cacheCountCode := ['hashCount,cacheName] cacheVector:= [op,cacheName,cacheType,cacheResetCode,cacheCountCode] - defCode := ["DEFPARAMETER",cacheName, - ['MAKE_-HASHTABLE,["QUOTE","UEQUAL"]]] + defCode := ["DEFPARAMETER",cacheName,['MAKE_-HASHTABLE,quote "UEQUAL"]] [defCode,mainFunction, - ["SETF",["GET", - ["QUOTE", op],["QUOTE",'cacheInfo]],["QUOTE", cacheVector]]] + ["SETF",["GET",quote op,quote 'cacheInfo],quote cacheVector]] bfNamespace x == @@ -1188,9 +1185,9 @@ bfNameArgs (x,y)== bfCreateDef: %Thing -> %Form bfCreateDef x== - x is [f] => ["DEFCONSTANT",f,["LIST",["QUOTE",f]]] + x is [f] => ["DEFCONSTANT",f,["LIST",quote f]] a := [bfGenSymbol() for i in rest x] - ["DEFUN",first x,a,["CONS",["QUOTE",first x],["LIST",:a]]] + ["DEFUN",first x,a,["CONS",quote first x,["LIST",:a]]] bfCaseItem: (%Thing,%Thing) -> %Form bfCaseItem(x,y) == @@ -1237,8 +1234,8 @@ bfHandlers(n,e,hs) == main(n,e,hs,nil) where [[true,["THROW",KEYWORD::OPEN_-AXIOM_-CATCH_-POINT,n]],:xs]] hs is [['%Catch,['%Signature,v,t],s],:hs'] => t := - symbol? t => ["QUOTE",[t]] -- instantiate niladic type ctor - ["QUOTE",t] + symbol? t => quote [t] -- instantiate niladic type ctor + quote t main(n,e,hs',[[bfQ(["CAR",e],t),["LET",[[v,["CDR",e]]],s]],:xs]) bpTrap() @@ -1268,8 +1265,8 @@ bfThrow e == t := "SystemException" x := e t := - symbol? t => ["QUOTE",[t]] - ["QOUTE",t] + symbol? t => quote [t] + quote t ["THROW",KEYWORD::OPEN_-AXIOM_-CATCH_-POINT, ["CONS",KEYWORD::OPEN_-AXIOM_-CATCH_-POINT,["CONS",t,x]]] diff --git a/src/boot/parser.boot b/src/boot/parser.boot index dd42631d..35608364 100644 --- a/src/boot/parser.boot +++ b/src/boot/parser.boot @@ -645,7 +645,7 @@ bpLeftAssoc(operations,parser)== bpString()== shoeTokType $stok is "STRING" and - bpPush(["QUOTE",makeSymbol $ttok]) and bpNext() + bpPush(quote makeSymbol $ttok) and bpNext() bpThetaName() == $stok is ["ID",:.] and $ttok has SHOETHETA => diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 03b0b55f..3c4e2be5 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -189,8 +189,7 @@ (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |bfSymbol|)) -(DEFUN |bfSymbol| (|x|) - (COND ((STRINGP |x|) |x|) (T (LIST 'QUOTE |x|)))) +(DEFUN |bfSymbol| (|x|) (COND ((STRINGP |x|) |x|) (T (|quote| |x|)))) (DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfDot|)) @@ -1146,7 +1145,7 @@ (DEFUN |bfHas| (|expr| |prop|) (COND - ((SYMBOLP |prop|) (LIST 'GET |expr| (LIST 'QUOTE |prop|))) + ((SYMBOLP |prop|) (LIST 'GET |expr| (|quote| |prop|))) (T (|bpSpecificErrorHere| "expected identifier as property name")))) (DEFUN |bfApplication| (|bfop| |bfarg|) @@ -1240,7 +1239,7 @@ (SETQ |ISTMP#2| (CAR |ISTMP#1|)) (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|)) (PROGN (SETQ |x| (CAR |ISTMP#2|)) T)))))) - (LIST 'EQ |var| (LIST 'QUOTE |x|))) + (LIST 'EQ |var| (|quote| |x|))) (T (LIST '|symbolMember?| |var| |seq|)))) ((|idList?| |seq|) (COND @@ -1493,16 +1492,14 @@ (RETURN |bfVar#7|)) ((NULL |bfVar#7|) (SETQ |bfVar#7| - #2=(CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|) - NIL)) + #2=(CONS (LIST 'CONS (|quote| |i|) |j|) NIL)) (SETQ |bfVar#8| |bfVar#7|)) (T (RPLACD |bfVar#8| #2#) (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|) - (LIST 'QUOTE |body|))) + (LIST '|applySubst| (CONS 'LIST |sb2|) (|quote| |body|))) (SETQ |lamex| (LIST 'MLAMBDA |gargl| |body|)) (SETQ |def| (LIST |op| |lamex|)) (CONS (|shoeComp| |def|) @@ -1537,7 +1534,7 @@ (COND ((EQ (CAR |argl|) '&REST) (LIST (CONS (CAR |argl|) |b|) |b| |c| - (CONS (LIST 'CONS (LIST 'QUOTE 'LIST) (CAR |d|)) + (CONS (LIST 'CONS (|quote| 'LIST) (CAR |d|)) (CDR |d|)))) (T (SETQ |f| (|bfGenSymbol|)) (LIST (CONS |f| |a|) (CONS |f| |b|) @@ -1573,9 +1570,9 @@ (LIST (LIST |innerfunc| (LIST 'LAMBDA |args| |body|)) (LIST |op| (LIST 'MLAMBDA (LIST '&REST |margs|) - (LIST 'CONS (LIST 'QUOTE |innerfunc|) + (LIST 'CONS (|quote| |innerfunc|) (LIST 'WRAP |margs| - (LIST 'QUOTE |control|)))))))))) + (|quote| |control|)))))))))) (DEFUN |bfDef| (|op| |args| |body|) (PROG (|body1| |arg1| |op1| |LETTMP#1|) @@ -2215,19 +2212,18 @@ (SETQ |cacheType| '|hash-table|) (SETQ |cacheResetCode| (LIST 'SETQ |cacheName| - (LIST 'MAKE-HASHTABLE (LIST 'QUOTE 'UEQUAL)))) + (LIST 'MAKE-HASHTABLE (|quote| 'UEQUAL)))) (SETQ |cacheCountCode| (LIST '|hashCount| |cacheName|)) (SETQ |cacheVector| (LIST |op| |cacheName| |cacheType| |cacheResetCode| |cacheCountCode|)) (SETQ |defCode| (LIST 'DEFPARAMETER |cacheName| - (LIST 'MAKE-HASHTABLE (LIST 'QUOTE 'UEQUAL)))) + (LIST 'MAKE-HASHTABLE (|quote| 'UEQUAL)))) (LIST |defCode| |mainFunction| (LIST 'SETF - (LIST 'GET (LIST 'QUOTE |op|) - (LIST 'QUOTE '|cacheInfo|)) - (LIST 'QUOTE |cacheVector|))))))) + (LIST 'GET (|quote| |op|) (|quote| '|cacheInfo|)) + (|quote| |cacheVector|))))))) (DEFUN |bfNamespace| (|x|) (LIST '|%Namespace| |x|)) @@ -2254,7 +2250,7 @@ (RETURN (COND ((AND (CONSP |x|) (NULL (CDR |x|))) (SETQ |f| (CAR |x|)) - (LIST 'DEFCONSTANT |f| (LIST 'LIST (LIST 'QUOTE |f|)))) + (LIST 'DEFCONSTANT |f| (LIST 'LIST (|quote| |f|)))) (T (SETQ |a| (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) (|bfVar#1| (CDR |x|)) (|i| NIL)) @@ -2270,7 +2266,7 @@ (SETQ |bfVar#3| (CDR |bfVar#3|)))) (SETQ |bfVar#1| (CDR |bfVar#1|))))) (LIST 'DEFUN (CAR |x|) |a| - (LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|)))))))) + (LIST 'CONS (|quote| (CAR |x|)) (CONS 'LIST |a|)))))))) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing|) |%Form|) |bfCaseItem|)) @@ -2410,8 +2406,8 @@ (SETQ |hs'| (CDR |hs|)) (SETQ |t| (COND - ((SYMBOLP |t|) (LIST 'QUOTE (LIST |t|))) - (T (LIST 'QUOTE |t|)))) + ((SYMBOLP |t|) (|quote| (LIST |t|))) + (T (|quote| |t|)))) (|bfHandlers,main| |n| |e| |hs'| (CONS (LIST (|bfQ| (LIST 'CAR |e|) |t|) (LIST 'LET (LIST (LIST |v| (LIST 'CDR |e|))) @@ -2474,8 +2470,8 @@ (T (SETQ |t| '|SystemException|) (SETQ |x| |e|))) (SETQ |t| (COND - ((SYMBOLP |t|) (LIST 'QUOTE (LIST |t|))) - (T (LIST 'QOUTE |t|)))) + ((SYMBOLP |t|) (|quote| (LIST |t|))) + (T (|quote| |t|)))) (LIST 'THROW :OPEN-AXIOM-CATCH-POINT (LIST 'CONS :OPEN-AXIOM-CATCH-POINT (LIST 'CONS |t| |x|))))))) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 9b36ba0d..0d5f4199 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -692,7 +692,7 @@ (DEFUN |bpString| () (DECLARE (SPECIAL |$ttok| |$stok|)) (AND (EQ (|shoeTokType| |$stok|) 'STRING) - (|bpPush| (LIST 'QUOTE (INTERN |$ttok|))) (|bpNext|))) + (|bpPush| (|quote| (INTERN |$ttok|))) (|bpNext|))) (DEFUN |bpThetaName| () (DECLARE (SPECIAL |$ttok| |$stok|)) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index 3e93facc..ae9f2de2 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -39,7 +39,7 @@ (CONS (LIST 'MAPC (LIST 'FUNCTION 'FMAKUNBOUND) - (LIST 'QUOTE + (|quote| (LET ((|bfVar#2| NIL) (|bfVar#3| NIL) @@ -84,7 +84,7 @@ (SETQ |bfVar#5| #1=(CONS (LIST 'EVAL - (LIST 'QUOTE |d|)) + (|quote| |d|)) NIL)) (SETQ |bfVar#6| |bfVar#5|)) @@ -99,7 +99,7 @@ (DEFUN |genOptimizeOptions| (|stream|) (REALLYPRETTYPRINT (LIST 'PROCLAIM - (LIST 'QUOTE (CONS 'OPTIMIZE |$LispOptimizeOptions|))) + (|quote| (CONS 'OPTIMIZE |$LispOptimizeOptions|))) |stream|)) (DEFUN |AxiomCore|::|%sysInit| () @@ -619,7 +619,7 @@ (DEFUN |exportNames| (|ns|) (COND ((NULL |ns|) NIL) - (T (LIST (|inAllContexts| (LIST 'EXPORT (LIST 'QUOTE |ns|))))))) + (T (LIST (|inAllContexts| (LIST 'EXPORT (|quote| |ns|))))))) (DEFUN |translateToplevel| (|b| |export?|) (PROG (|lhs| |t| |ISTMP#2| |sig| |n| |ISTMP#1| |xs|) diff --git a/src/boot/translator.boot b/src/boot/translator.boot index c939e52b..e9d720a2 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -56,14 +56,14 @@ genModuleFinalization(stream) == init := ["DEFUN", makeSymbol strconc($currentModuleName,'"InitCLispFFI"), nil, ["MAPC",["FUNCTION", "FMAKUNBOUND"], - ["QUOTE",[second d for d in $foreignsDefsForCLisp]]], - :[["EVAL",["QUOTE",d]] for d in $foreignsDefsForCLisp]] + quote [second d for d in $foreignsDefsForCLisp]], + :[["EVAL",quote d] for d in $foreignsDefsForCLisp]] REALLYPRETTYPRINT(init,stream) nil genOptimizeOptions stream == REALLYPRETTYPRINT - (["PROCLAIM",["QUOTE",["OPTIMIZE",:$LispOptimizeOptions]]],stream) + (["PROCLAIM",quote ["OPTIMIZE",:$LispOptimizeOptions]],stream) AxiomCore::%sysInit() == SETQ(_*LOAD_-VERBOSE_*,false) @@ -418,7 +418,7 @@ inAllContexts x == exportNames ns == ns = nil => nil - [inAllContexts ["EXPORT",["QUOTE",ns]]] + [inAllContexts ["EXPORT",quote ns]] translateToplevel(b,export?) == atom b => [b] -- generally happens in interactive mode. |