aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/boot/ast.boot39
-rw-r--r--src/boot/parser.boot2
-rw-r--r--src/boot/strap/ast.clisp40
-rw-r--r--src/boot/strap/parser.clisp2
-rw-r--r--src/boot/strap/translator.clisp8
-rw-r--r--src/boot/translator.boot8
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.
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-05 02:50:30 +0000