diff options
Diffstat (limited to 'src/boot')
| -rw-r--r-- | src/boot/ast.boot | 37 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 28 | ||||
| -rw-r--r-- | src/boot/strap/tokens.clisp | 70 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 8 | ||||
| -rw-r--r-- | src/boot/tokens.boot | 83 | ||||
| -rw-r--r-- | src/boot/translator.boot | 5 |
6 files changed, 8 insertions, 223 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot index d02f7a8e..200cd933 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -726,43 +726,10 @@ bfApplication(bfop, bfarg) == then cons(bfop,rest bfarg) else cons(bfop,[bfarg]) - -++ Token renaming. New Boot and Old Boot differs in the set of -++ tokens they rename. When converting code written in Old Boot -++ to New Boot, it is helpful to have some noise about potential -++ divergence in semantics. So, when compiling with --boot=old, -++ we compute the renaming in both Old Boot and New Boot and compare -++ the results. If they differ, we prefer the old meaning, with some -++ warnings. Notice that the task is compounded by the fact the -++ tokens in both language do not always agreee. -++ However, to minimize the flood of false positive, we -++ keep a list of symbols which apparently differ in meanings, but -++ which have been verified to agree. -++ This is a valuable automated tool during the transition period. - --- return the meaning of the x in Old Boot. -bfGetOldBootName x == - a := GET(x, "OLD-BOOT") => first a - x - --- returns true if x has same meaning in both Old Boot and New Boot. -bfSameMeaning x == - GET(x, 'RENAME_-OK) - -- returns the meaning of x in the appropriate Boot dialect. bfReName x== - newName := - a := GET(x,"SHOERENAME") => first a - x - $translatingOldBoot and not bfSameMeaning x => - oldName := bfGetOldBootName x - if newName ~= oldName then - warn [PNAME x, '" as `", PNAME newName, _ - '"_' differs from Old Boot `", PNAME oldName,_ - '"_' at ", diagnosticLocation $stok] - oldName - newName - + a := GET(x,"SHOERENAME") => first a + x bfInfApplication(op,left,right)== EQ(op,"EQUAL") => bfQ(left,right) diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 0d4a44e8..dd410a65 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -1182,34 +1182,10 @@ ((|bfTupleP| |bfarg|) (CONS |bfop| (CDR |bfarg|))) ('T (CONS |bfop| (LIST |bfarg|))))) -(DEFUN |bfGetOldBootName| (|x|) - (PROG (|a|) - (RETURN - (COND ((SETQ |a| (GET |x| 'OLD-BOOT)) (CAR |a|)) ('T |x|))))) - -(DEFUN |bfSameMeaning| (|x|) (GET |x| 'RENAME-OK)) - (DEFUN |bfReName| (|x|) - (PROG (|oldName| |newName| |a|) - (DECLARE (SPECIAL |$stok| |$translatingOldBoot|)) + (PROG (|a|) (RETURN - (PROGN - (SETQ |newName| - (COND - ((SETQ |a| (GET |x| 'SHOERENAME)) (CAR |a|)) - (#0='T |x|))) - (COND - ((AND |$translatingOldBoot| (NOT (|bfSameMeaning| |x|))) - (PROGN - (SETQ |oldName| (|bfGetOldBootName| |x|)) - (COND - ((NOT (EQUAL |newName| |oldName|)) - (|warn| (LIST (PNAME |x|) " as `" (PNAME |newName|) - "' differs from Old Boot `" - (PNAME |oldName|) "' at " - (|diagnosticLocation| |$stok|))))) - |oldName|)) - (#0# |newName|)))))) + (COND ((SETQ |a| (GET |x| 'SHOERENAME)) (CAR |a|)) ('T |x|))))) (DEFUN |bfInfApplication| (|op| |left| |right|) (COND diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 9e45927d..4c982be4 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -241,71 +241,7 @@ (SETQ |bfVar#9| (CDR |bfVar#9|))))) (EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL) - (LET ((|bfVar#10| (LIST (LIST 'PLUS 'PLUS) (LIST '|and| 'AND) - (LIST '|append| 'APPEND) - (LIST '|apply| 'APPLY) (LIST '|atom| 'ATOM) - (LIST '|brace| 'REMDUP) (LIST '|car| 'CAR) - (LIST '|cdr| 'CDR) (LIST '|cons| 'CONS) - (LIST '|copy| 'COPY) (LIST '|croak| 'CROAK) - (LIST '|drop| 'DROP) (LIST '|exit| 'EXIT) - (LIST '|false| 'NIL) (LIST '|first| 'CAR) - (LIST '|genvar| 'GENVAR) - (LIST '|in| '|member|) (LIST '|is| 'IS) - (LIST '|lastNode| 'LASTNODE) - (LIST '|list| 'LIST) (LIST '|mkpf| 'MKPF) - (LIST '|nconc| 'NCONC) (LIST '|nil| 'NIL) - (LIST '|not| 'NOT) - (LIST '|nreverse| 'NREVERSE) - (LIST '|null| 'NULL) (LIST '|or| 'OR) - (LIST '|otherwise| 'T) - (LIST '|removeDuplicates| 'REMDUP) - (LIST '|rest| 'CDR) (LIST '|return| 'RETURN) - (LIST '|reverse| 'REVERSE) - (LIST '|setDifference| 'SETDIFFERENCE) - (LIST '|setIntersection| '|intersection|) - (LIST '|setPart| 'SETELT) - (LIST '|setUnion| '|union|) - (LIST '|size| 'SIZE) - (LIST '|strconc| 'STRCONC) - (LIST '|substitute| 'MSUBST) - (LIST 'SUBST 'MSUBST) (LIST '|take| 'TAKE) - (LIST '|true| 'T) (LIST '|where| 'WHERE) - (LIST 'TIMES 'TIMES) (LIST 'POWER 'EXPT) - (LIST 'SHOENE 'NEQUAL) - (LIST 'MINUS 'SPADDIFFERENCE) - (LIST 'SLASH 'QUOTIENT) (LIST '= 'EQUAL) - (LIST 'SHOEEQ 'EQUAL) (LIST 'ASSOC '|assoc|) - (LIST 'DELETE '|delete|) (LIST 'GET 'GETL) - (LIST 'INTERSECTION '|intersection|) - (LIST 'LAST '|last|) (LIST 'MEMBER '|member|) - (LIST 'RASSOC '|rassoc|) (LIST 'READ 'VMREAD) - (LIST 'READ-LINE '|read-line|) - (LIST 'REDUCE 'SPADREDUCE) - (LIST 'REMOVE '|remove|) - (LIST 'BAR 'SUCHTHAT) (LIST 'T 'T$) - (LIST 'IN '|member|) (LIST 'UNION '|union|))) - (|i| NIL)) - (LOOP - (COND - ((OR (ATOM |bfVar#10|) (PROGN (SETQ |i| (CAR |bfVar#10|)) NIL)) - (RETURN NIL)) - ('T (SETF (GET (CAR |i|) 'OLD-BOOT) (CDR |i|)))) - (SETQ |bfVar#10| (CDR |bfVar#10|))))) - -(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL) - (LET ((|bfVar#11| - (LIST 'LT 'LE 'GT 'GE 'SHOENE 'TIMES 'PLUS 'MINUS - '|function| 'PAIRP)) - (|i| NIL)) - (LOOP - (COND - ((OR (ATOM |bfVar#11|) (PROGN (SETQ |i| (CAR |bfVar#11|)) NIL)) - (RETURN NIL)) - ('T (SETF (GET |i| 'RENAME-OK) T))) - (SETQ |bfVar#11| (CDR |bfVar#11|))))) - -(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL) - (LET ((|bfVar#12| (LIST (LIST '|setName| 0) (LIST '|setLabel| 1) + (LET ((|bfVar#10| (LIST (LIST '|setName| 0) (LIST '|setLabel| 1) (LIST '|setLevel| 2) (LIST '|setType| 3) (LIST '|setVar| 4) (LIST '|setLeaf| 5) (LIST '|setDef| 6) (LIST '|aGeneral| 4) @@ -333,8 +269,8 @@ (|i| NIL)) (LOOP (COND - ((OR (ATOM |bfVar#12|) (PROGN (SETQ |i| (CAR |bfVar#12|)) NIL)) + ((OR (ATOM |bfVar#10|) (PROGN (SETQ |i| (CAR |bfVar#10|)) NIL)) (RETURN NIL)) ('T (SETF (GET (CAR |i|) 'SHOESELFUNCTION) (CADR |i|)))) - (SETQ |bfVar#12| (CDR |bfVar#12|))))) + (SETQ |bfVar#10| (CDR |bfVar#10|))))) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index fe895323..41158639 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -89,10 +89,7 @@ (LIST 'QUOTE (CONS 'OPTIMIZE |$LispOptimizeOptions|))) |stream|)) -(DEFPARAMETER |$translatingOldBoot| NIL) - (DEFUN |AxiomCore|::|%sysInit| () - (DECLARE (SPECIAL |$translatingOldBoot|)) (PROGN (SETQ *LOAD-VERBOSE* NIL) (COND @@ -106,10 +103,7 @@ NIL) (SETF (SYMBOL-VALUE (|bfColonColon| 'COMPILER 'SUPPRESS-COMPILER-NOTES*)) - T))) - (COND - ((EQUAL (CDR (ASSOC (|Option| "boot") (|%systemOptions|))) "old") - (SETQ |$translatingOldBoot| T))))) + T))))) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |setCurrentPackage|)) diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index d03205fe..05e936e6 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -291,89 +291,6 @@ for i in [ _ ] repeat SETF (GET(first i,'SHOERENAME),CDR i) --- For code written in `Old Boot', we would like to warn about --- the difference in renaming. -for i in [ _ - ["PLUS", "PLUS"], _ - ["and", "AND"], _ - ["append", "APPEND"], _ - ["apply", "APPLY"], _ - ["atom", "ATOM"], _ - ["brace", "REMDUP"], _ - ["car", "CAR"], _ - ["cdr", "CDR"], _ - ["cons", "CONS"], _ - ["copy", "COPY"], _ - ["croak", "CROAK"], _ - ["drop", "DROP"], _ - ["exit", "EXIT"], _ - ["false", "NIL"], _ - ["first", "CAR"], _ - ["genvar", "GENVAR"], _ - ["in", "member"], _ - ["is", "IS"], _ - ["lastNode", "LASTNODE"], _ - ["list", "LIST"], _ - ["mkpf", "MKPF"], _ - ["nconc", "NCONC"], _ - ["nil", "NIL"], _ - ["not", "NOT"], _ - ["nreverse", "NREVERSE"], _ - ["null", "NULL"], _ - ["or", "OR"], _ - ["otherwise", "T"], _ - ["removeDuplicates", "REMDUP"], _ - ["rest", "CDR"], _ - ["return", "RETURN"], _ - ["reverse", "REVERSE"], _ - ["setDifference", "SETDIFFERENCE"], _ - ["setIntersection", "intersection"], _ - ["setPart", "SETELT"], _ - ["setUnion", "union"], _ - ["size", "SIZE"], _ - ["strconc", "STRCONC"], _ - ["substitute", "MSUBST"], _ - ["SUBST", "MSUBST"], _ - ["take", "TAKE"], _ - ["true", "T"], _ - ["where", "WHERE"], _ - ["TIMES", "TIMES"], _ - ["POWER", "EXPT"], _ - ["SHOENE", "NEQUAL"], _ - ["MINUS", "SPADDIFFERENCE"], _ - ["SLASH", "QUOTIENT"], _ - ["=", "EQUAL"], _ - ["SHOEEQ", "EQUAL"], _ - ["ASSOC", "assoc"], _ - ["DELETE", "delete"], _ - ["GET", "GETL"], _ - ["INTERSECTION", "intersection"], _ - ["LAST", "last"], _ - ["MEMBER", "member"], _ - ["RASSOC", "rassoc"], _ - ["READ", "VMREAD"], _ - ["READ-LINE", "read-line"], _ - ["REDUCE", "SPADREDUCE"], _ - ["REMOVE", "remove"], _ - ["BAR", "SUCHTHAT"], _ - ["T", "T$"], _ - ["IN", "member"], _ - ["UNION", "union"]_ - ] - repeat SETF (GET(first i,'OLD_-BOOT),CDR i) - --- The following difference in renaming are verified to be OK. -for i in [ _ - "LT", "LE", _ - "GT", "GE", _ - "SHOENE", _ - "TIMES", "PLUS", _ - "MINUS", "function",_ - "PAIRP" - ] - repeat SETF(GET(i, 'RENAME_-OK), true) - - for i in [ _ ["setName", 0] , _ diff --git a/src/boot/translator.boot b/src/boot/translator.boot index bfc91deb..fe02528e 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -64,9 +64,6 @@ genOptimizeOptions stream == REALLYPRETTYPRINT (["PROCLAIM",["QUOTE",["OPTIMIZE",:$LispOptimizeOptions]]],stream) -+++ True if we are translating code written in Old Boot. -$translatingOldBoot := false - AxiomCore::%sysInit() == SETQ(_*LOAD_-VERBOSE_*,false) if %hasFeature KEYWORD::GCL then @@ -76,8 +73,6 @@ AxiomCore::%sysInit() == bfColonColon("COMPILER","SUPPRESS-COMPILER-WARNINGS*"),false) SETF(SYMBOL_-VALUE bfColonColon("COMPILER","SUPPRESS-COMPILER-NOTES*"),true) - if rest ASSOC(Option '"boot", %systemOptions()) = '"old" - then $translatingOldBoot := true ++ Make x, the current package setCurrentPackage: %Thing -> %Thing |