diff options
author | dos-reis <gdr@axiomatics.org> | 2011-05-14 17:11:52 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-05-14 17:11:52 +0000 |
commit | 81c55a49db8873b2a67f3c7c8ffe3786731e81bd (patch) | |
tree | c9dffc490885f663070849f1c8709b5d8943d97e | |
parent | 0df19c03c721d4ef214b335445a530dbfa66d570 (diff) | |
download | open-axiom-81c55a49db8873b2a67f3c7c8ffe3786731e81bd.tar.gz |
cleanup
-rw-r--r-- | src/boot/ast.boot | 4 | ||||
-rw-r--r-- | src/boot/includer.boot | 2 | ||||
-rw-r--r-- | src/boot/scanner.boot | 6 | ||||
-rw-r--r-- | src/boot/strap/ast.clisp | 4 | ||||
-rw-r--r-- | src/boot/strap/includer.clisp | 2 | ||||
-rw-r--r-- | src/boot/strap/scanner.clisp | 6 | ||||
-rw-r--r-- | src/boot/strap/tokens.clisp | 4 | ||||
-rw-r--r-- | src/boot/strap/translator.clisp | 17 | ||||
-rw-r--r-- | src/boot/tokens.boot | 1 | ||||
-rw-r--r-- | src/boot/translator.boot | 16 |
10 files changed, 33 insertions, 29 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot index b7b50c51..e59d290d 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -848,7 +848,7 @@ bfDef1 [op,args,body] == shoeLAM (op,args,control,body)== margs :=bfGenSymbol() - innerfunc:= makeSymbol strconc(symbolName op,",LAM") + innerfunc:= makeSymbol strconc(symbolName op,'",LAM") [[innerfunc,["LAMBDA",args,body]], [op,["MLAMBDA",["&REST",margs],["CONS",["QUOTE", innerfunc], ["WRAP",margs, ["QUOTE", control]]]]]] @@ -1696,7 +1696,7 @@ genCLOZUREnativeTranslation(op,s,t,op') == -- Note that Clozure CL does not mangle foreign function call for -- us, so we're left with more platform dependencies than needed. if %hasFeature KEYWORD::DARWIN then - op' := strconc("__",op') + op' := strconc('"__",op') call := [bfColonColon("CCL","EXTERNAL-CALL"), STRING op', :args, rettype] where args() == [:[x, parm] for x in argtypes for p in parms] diff --git a/src/boot/includer.boot b/src/boot/includer.boot index f9749df2..e286d843 100644 --- a/src/boot/includer.boot +++ b/src/boot/includer.boot @@ -75,7 +75,7 @@ shoeNotFound fn == shoeReadLispString(s,n) == l := #s n >= l => nil - readLispFromString strconc( "(", subString(s,n,l-n) ,")") + readLispFromString strconc('"(", subString(s,n,l-n) ,'")") -- read a line from stream shoeReadLine stream == diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot index 841d26db..7a84cb96 100644 --- a/src/boot/scanner.boot +++ b/src/boot/scanner.boot @@ -90,7 +90,7 @@ shoeNextLine(s)== $n = nil => true stringChar($ln,$n) = shoeTAB => a := makeString(7-REM($n,8),char " ") - $ln.$n := char " " + stringChar($ln,$n) := char " " $ln := strconc(a,$ln) s1:=[[$ln,:rest $f],:$r] shoeNextLine s1 @@ -443,10 +443,10 @@ shoeOrdToNum x== digit? x shoeKeyWord st == - GETHASH(st,shoeKeyTable) + tableValue(shoeKeyTable,st) shoeKeyWordP st == - GETHASH(st,shoeKeyTable) ~= nil + tableValue(shoeKeyTable,st) ~= nil shoeMatch(l,i) == shoeSubStringMatch(l,shoeDict,i) diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 90c9eab9..6aeeec23 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -1571,7 +1571,7 @@ (RETURN (PROGN (SETQ |margs| (|bfGenSymbol|)) - (SETQ |innerfunc| (INTERN (CONCAT (SYMBOL-NAME |op|) '|,LAM|))) + (SETQ |innerfunc| (INTERN (CONCAT (SYMBOL-NAME |op|) ",LAM"))) (LIST (LIST |innerfunc| (LIST 'LAMBDA |args| |body|)) (LIST |op| (LIST 'MLAMBDA (LIST '&REST |margs|) @@ -3433,7 +3433,7 @@ (SETQ |bfVar#228| (CDR |bfVar#228|)) (SETQ |bfVar#229| (CDR |bfVar#229|)))) (COND - ((|%hasFeature| :DARWIN) (SETQ |op'| (CONCAT '_ |op'|)))) + ((|%hasFeature| :DARWIN) (SETQ |op'| (CONCAT "_" |op'|)))) (SETQ |call| (CONS (|bfColonColon| 'CCL 'EXTERNAL-CALL) (CONS (STRING |op'|) diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp index 57079461..ad66a280 100644 --- a/src/boot/strap/includer.clisp +++ b/src/boot/strap/includer.clisp @@ -22,7 +22,7 @@ (COND ((NOT (< |n| |l|)) NIL) (T (READ-FROM-STRING - (CONCAT '|(| (|subString| |s| |n| (- |l| |n|)) '|)|)))))))) + (CONCAT "(" (|subString| |s| |n| (- |l| |n|)) ")")))))))) (DEFUN |shoeReadLine| (|stream|) (READ-LINE |stream| NIL NIL)) diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index 208c588a..1d06b54d 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -54,7 +54,7 @@ ((CHAR= (SCHAR |$ln| |$n|) |shoeTAB|) (SETQ |a| (|makeString| (- 7 (REM |$n| 8)) (|char| '| |))) - (SETF (ELT |$ln| |$n|) (|char| '| |)) + (SETF (SCHAR |$ln| |$n|) (|char| '| |)) (SETQ |$ln| (CONCAT |a| |$ln|)) (SETQ |s1| (CONS (CONS |$ln| (CDR |$f|)) |$r|)) (|shoeNextLine| |s1|)) @@ -517,9 +517,9 @@ (DEFUN |shoeOrdToNum| (|x|) (DIGIT-CHAR-P |x|)) -(DEFUN |shoeKeyWord| (|st|) (GETHASH |st| |shoeKeyTable|)) +(DEFUN |shoeKeyWord| (|st|) (|tableValue| |shoeKeyTable| |st|)) -(DEFUN |shoeKeyWordP| (|st|) (GETHASH |st| |shoeKeyTable|)) +(DEFUN |shoeKeyWordP| (|st|) (|tableValue| |shoeKeyTable| |st|)) (DEFUN |shoeMatch| (|l| |i|) (|shoeSubStringMatch| |l| |shoeDict| |i|)) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 8080f322..b8eae135 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -249,7 +249,9 @@ (LIST '|string?| 'STRINGP) (LIST '|stringEq?| 'STRING=) (LIST '|stringUpcase| 'STRING-UPCASE) - (LIST '|subSequence| 'SUBSEQ) (LIST '|symbolEq?| 'EQ) + (LIST '|subSequence| 'SUBSEQ) + (LIST '|symbolScope| 'SYMBOL-PACKAGE) + (LIST '|symbolEq?| 'EQ) (LIST '|symbolFunction| 'SYMBOL-FUNCTION) (LIST '|symbolName| 'SYMBOL-NAME) (LIST '|symbolValue| 'SYMBOL-VALUE) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index 312bca9e..dc23cc1f 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -34,7 +34,7 @@ (T (SETQ |init| (CONS 'DEFUN (CONS (INTERN (CONCAT |$currentModuleName| - '|InitCLispFFI|)) + "InitCLispFFI")) (CONS NIL (CONS (LIST 'MAPC @@ -871,7 +871,7 @@ ((OR (ATOM |bfVar#21|) (PROGN (SETQ |i| (CAR |bfVar#21|)) NIL)) (RETURN |bfVar#22|)) - (T (AND (NOT (GETHASH |i| |$bootUsed|)) + (T (AND (NOT (|tableValue| |$bootUsed| |i|)) (COND ((NULL |bfVar#22|) (SETQ |bfVar#22| #0=(CONS |i| NIL)) @@ -893,7 +893,7 @@ ((OR (ATOM |bfVar#24|) (PROGN (SETQ |i| (CAR |bfVar#24|)) NIL)) (RETURN |bfVar#25|)) - (T (AND (NOT (GETHASH |i| |$bootDefined|)) + (T (AND (NOT (|tableValue| |$bootDefined| |i|)) (COND ((NULL |bfVar#25|) (SETQ |bfVar#25| #1=(CONS |i| NIL)) @@ -908,7 +908,7 @@ (PROGN (SETQ |i| (CAR |bfVar#27|)) NIL)) (RETURN NIL)) (T (SETQ |b| (CONCAT (PNAME |i|) " is used in ")) - (|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|)) + (|bootOutLines| (SSORT (|tableValue| |$bootUsed| |i|)) |stream| |b|))) (SETQ |bfVar#27| (CDR |bfVar#27|)))))))) @@ -999,7 +999,7 @@ (SETQ |nee| (CAR |LETTMP#1|)) (SETQ |niens| (CADR |LETTMP#1|)) (COND - ((GETHASH |nee| |$bootDefined|) + ((|tableValue| |$bootDefined| |nee|) (SETQ |$bootDefinedTwice| (COND ((EQ |nee| 'TOP-LEVEL) |$bootDefinedTwice|) @@ -1100,7 +1100,7 @@ (DEFUN |defusebuiltin| (|x|) (DECLARE (SPECIAL |$lispWordTable|)) - (GETHASH |x| |$lispWordTable|)) + (|tableValue| |$lispWordTable| |x|)) (DEFUN |bootOut| (|l| |outfn|) (LET ((|bfVar#31| |l|) (|i| NIL)) @@ -1173,7 +1173,7 @@ (PROGN (SETQ |i| (CAR |bfVar#32|)) NIL)) (RETURN NIL)) (T (SETQ |a| (CONCAT (PNAME |i|) " is used in ")) - (|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|)) + (|bootOutLines| (SSORT (|tableValue| |$bootUsed| |i|)) |stream| |a|))) (SETQ |bfVar#32| (CDR |bfVar#32|)))))))) @@ -1206,7 +1206,8 @@ (COND ((SYMBOLP |x|) (COND - ((EQUAL (SYMBOL-PACKAGE |x|) |bt|) (INTERN (PNAME |x|) |pk|)) + ((EQUAL (SYMBOL-PACKAGE |x|) |bt|) + (INTERN (SYMBOL-NAME |x|) |pk|)) (T |x|))) (T |x|))) (T (CONS (|stripm| (CAR |x|) |pk| |bt|) diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index 905f4426..9acebffc 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -310,6 +310,7 @@ for i in [ _ ["stringEq?","STRING="] , _ ["stringUpcase", "STRING-UPCASE"] , _ ["subSequence", "SUBSEQ"] , _ + ["symbolScope", "SYMBOL-PACKAGE"] , _ ["symbolEq?", "EQ"], _ ["symbolFunction", "SYMBOL-FUNCTION"], _ ["symbolName", "SYMBOL-NAME"], _ diff --git a/src/boot/translator.boot b/src/boot/translator.boot index 151b4f73..6dba8a2f 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -54,7 +54,7 @@ genModuleFinalization(stream) == $currentModuleName = nil => coreError '"current module has no name" init := - ["DEFUN", makeSymbol strconc($currentModuleName,"InitCLispFFI"), nil, + ["DEFUN", makeSymbol strconc($currentModuleName,'"InitCLispFFI"), nil, ["MAPC",["FUNCTION", "FMAKUNBOUND"], ["QUOTE",[second d for d in $foreignsDefsForCLisp]]], :[["EVAL",["QUOTE",d]] for d in $foreignsDefsForCLisp]] @@ -540,7 +540,7 @@ shoeDfu(a,fn)== shoeReport stream== shoeFileLine('"DEFINED and not USED",stream) - a:=[i for i in HKEYS $bootDefined | not GETHASH(i,$bootUsed)] + a:=[i for i in HKEYS $bootDefined | not tableValue($bootUsed,i)] bootOut(SSORT a,stream) shoeFileLine('" ",stream) shoeFileLine('"DEFINED TWICE",stream) @@ -548,10 +548,10 @@ shoeReport stream== shoeFileLine('" ",stream) shoeFileLine('"USED and not DEFINED",stream) a:=[i for i in HKEYS $bootUsed | - not GETHASH(i,$bootDefined)] + not tableValue($bootDefined,i)] for i in SSORT a repeat b := strconc(PNAME i,'" is used in ") - bootOutLines( SSORT GETHASH(i,$bootUsed),stream,b) + bootOutLines( SSORT tableValue($bootUsed,i),stream,b) shoeDefUse(s)== while not bStreamPackageNull s repeat @@ -567,7 +567,7 @@ defuse(e,x)== x is ["EVAL_-WHEN",.,["SETQ",id,exp]]=>[id,exp] x is ["SETQ",id,exp]=>[id,exp] ["TOP-LEVEL", x] - if GETHASH(nee,$bootDefined) + if tableValue($bootDefined,nee) then $bootDefinedTwice:= nee="TOP-LEVEL"=> $bootDefinedTwice @@ -610,7 +610,7 @@ unfluidlist x== [first x,:unfluidlist rest x] defusebuiltin x == - GETHASH(x,$lispWordTable) + tableValue($lispWordTable,x) bootOut (l,outfn)== for i in l repeat shoeFileLine(strconc ('" ",PNAME i),outfn) @@ -662,7 +662,7 @@ shoeXReport stream== c:=SSORT HKEYS $bootUsed for i in c repeat a := strconc(PNAME i,'" is used in ") - bootOutLines( SSORT GETHASH(i,$bootUsed),stream,a) + bootOutLines( SSORT tableValue($bootUsed,i),stream,a) shoeItem (str)== dq:=first str @@ -671,7 +671,7 @@ shoeItem (str)== stripm (x,pk,bt)== atom x => symbol? x => - SYMBOL_-PACKAGE x = bt => makeSymbol(PNAME x,pk) + SYMBOL_-PACKAGE x = bt => makeSymbol(symbolName x,pk) x x [stripm(first x,pk,bt),:stripm(rest x,pk,bt)] |