From 80f5cef01abdaee3b8c818ea07f534570e94c6d4 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sun, 14 Oct 2007 03:36:45 +0000 Subject: * ast.boot.pamphlet (bfGetOldBootName): New. (bfSameMeaning): Likewise. (bfReName): Use them. * parser.boot.pamphlet (bpCompare): Tidy. * tokens.boot.pamphlet: Rename NE to SHOENE. Record Old Boot renaming tokens. Likewise for tokens with same meaning. * translator.boot.pamphlet (AxiomCore::%sysInit): New. ($translatingOldBoot): Likewise. --- src/boot/ChangeLog | 11 +++++ src/boot/ast.boot.pamphlet | 40 ++++++++++++++-- src/boot/parser.boot.pamphlet | 4 +- src/boot/tokens.boot.pamphlet | 97 ++++++++++++++++++++++++++++++++++++--- src/boot/translator.boot.pamphlet | 7 +++ 5 files changed, 146 insertions(+), 13 deletions(-) (limited to 'src') diff --git a/src/boot/ChangeLog b/src/boot/ChangeLog index d7fa79ab..a22d37e0 100644 --- a/src/boot/ChangeLog +++ b/src/boot/ChangeLog @@ -1,3 +1,14 @@ +2007-10-13 Gabriel Dos Reis + + * ast.boot.pamphlet (bfGetOldBootName): New. + (bfSameMeaning): Likewise. + (bfReName): Use them. + * parser.boot.pamphlet (bpCompare): Tidy. + * tokens.boot.pamphlet: Rename NE to SHOENE. Record Old Boot + renaming tokens. Likewise for tokens with same meaning. + * translator.boot.pamphlet (AxiomCore::%sysInit): New. + ($translatingOldBoot): Likewise. + 2007-09-11 Gabriel Dos Reis * ast.boot.pamphlet (bfCompDef): Call coreError, not error. diff --git a/src/boot/ast.boot.pamphlet b/src/boot/ast.boot.pamphlet index 25d982f5..761175bc 100644 --- a/src/boot/ast.boot.pamphlet +++ b/src/boot/ast.boot.pamphlet @@ -664,12 +664,42 @@ bfApplication(bfop, bfarg) == then cons(bfop,CDR 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") => car 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== - a:=GET(x,"SHOERENAME") - if a - then car a - else x + newName := + a := GET(x,"SHOERENAME") => car 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, '"_'"] + oldName + newName + bfInfApplication(op,left,right)== EQ(op,"EQUAL") => bfQ(left,right) diff --git a/src/boot/parser.boot.pamphlet b/src/boot/parser.boot.pamphlet index eb68fa1e..47627d4a 100644 --- a/src/boot/parser.boot.pamphlet +++ b/src/boot/parser.boot.pamphlet @@ -703,7 +703,7 @@ bpBracketConstruct(f)== bpBracket f and bpPush bfConstruct bpPop1 () bpCompare()== - bpIs() and (bpInfKey '(SHOEEQ NE LT LE GT GE IN) + bpIs() and (bpInfKey '(SHOEEQ SHOENE LT LE GT GE IN) and (bpIs() or bpTrap()) and bpPush bfInfApplication(bpPop2(),bpPop2(),bpPop1()) or true) @@ -1912,7 +1912,7 @@ bpCaseItem()== (PROG () (RETURN (AND (|bpIs|) - (OR (AND (|bpInfKey| '(SHOEEQ NE LT LE GT GE IN)) + (OR (AND (|bpInfKey| '(SHOEEQ SHOENE LT LE GT GE IN)) (OR (|bpIs|) (|bpTrap|)) (|bpPush| (|bfInfApplication| (|bpPop2|) (|bpPop2|) diff --git a/src/boot/tokens.boot.pamphlet b/src/boot/tokens.boot.pamphlet index 4e429a81..482729a8 100644 --- a/src/boot/tokens.boot.pamphlet +++ b/src/boot/tokens.boot.pamphlet @@ -205,7 +205,7 @@ shoeKeyWords := [ _ ['">=","GE" ], _ ['"=", "SHOEEQ"], _ ['"^", "NOT"], _ - ['"^=","NE" ], _ + ['"^=","SHOENE" ], _ ['"..","SEG" ], _ ['"#", "LENGTH"], _ ['"=>","EXIT" ], _ @@ -318,7 +318,7 @@ for i in [ _ ["GT" ,">"], _ ["LE" ,"<="], _ ["GE" ,">="], _ - ["NE" ,"^="] _ + ["SHOENE" ,"^="] _ ]_ repeat SETF (GET(CAR i,'SHOEINF),CADR i) @@ -402,10 +402,95 @@ for i in [ _ ["LE", "<="], _ ["GE", ">="], _ ["SHOEEQ", "EQUAL"], _ - ["NE", "/="], _ + ["SHOENE", "/="], _ ["T", "T$"] _ ] repeat SETF (GET(CAR 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", "NULL"], _ + ["NOT", "NULL"], _ + ["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"], _ + ["NOT", "NULL"], _ + ["SHOENE", "NEQUAL"], _ + ["MINUS", "SPADDIFFERENCE"], _ + ["SLASH", "QUOTIENT"], _ + ["=", "EQUAL"], _ + ["SHOEEQ", "BOOT-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(CAR i,'OLD_-BOOT),CDR i) + +-- The following difference in renaming are verified to be OK. +for i in [ _ + "LT", "LE", _ + "GT", "GE", _ + "TIMES", "PLUS", _ + "MINUS", "function",_ + "PAIRP" + ] + repeat SETF(GET(i, 'RENAME_-OK), true) + + for i in [ _ ["setName", 0] , _ @@ -470,7 +555,7 @@ for i in [ _ (LIST "**" 'POWER) (LIST "/" 'SLASH) (LIST "+" 'PLUS) (LIST "-" 'MINUS) (LIST "<" 'LT) (LIST ">" 'GT) (LIST "<=" 'LE) (LIST ">=" 'GE) (LIST "=" 'SHOEEQ) - (LIST "^" 'NOT) (LIST "^=" 'NE) (LIST ".." 'SEG) + (LIST "^" 'NOT) (LIST "^=" 'SHOENE) (LIST ".." 'SEG) (LIST "#" 'LENGTH) (LIST "=>" 'EXIT) (LIST ":=" 'BEC) (LIST "==" 'DEF) (LIST "==>" 'MDEF) (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN) (LIST ")" 'CPAREN) (LIST "(|" 'OBRACK) @@ -651,7 +736,7 @@ for i in [ _ (LIST 'IS '|is|) (LIST 'ISNT '|isnt|) (LIST 'AND '|and|) (LIST 'OR '|or|) (LIST 'SLASH '/) (LIST 'POWER '**) (LIST 'MINUS '-) (LIST 'LT '<) (LIST 'GT '>) - (LIST 'LE '<=) (LIST 'GE '>=) (LIST 'NE '^=)) + (LIST 'LE '<=) (LIST 'GE '>=) (LIST 'SHOENE '^=)) NIL)))) (EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL) @@ -709,7 +794,7 @@ for i in [ _ (LIST '|true| 'T) (LIST 'PLUS '+) (LIST 'MINUS '-) (LIST 'TIMES '*) (LIST 'POWER 'EXPT) (LIST 'SLASH '/) (LIST 'LT '<) (LIST 'GT '>) (LIST 'LE '<=) (LIST 'GE '>=) - (LIST 'SHOEEQ 'EQUAL) (LIST 'NE '/=) (LIST 'T 'T$)) + (LIST 'SHOEEQ 'EQUAL) (LIST 'SHOENE '/=) (LIST 'T 'T$)) NIL)))) (EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL) diff --git a/src/boot/translator.boot.pamphlet b/src/boot/translator.boot.pamphlet index d6a9317e..23249648 100644 --- a/src/boot/translator.boot.pamphlet +++ b/src/boot/translator.boot.pamphlet @@ -113,6 +113,13 @@ import '"ast" )package "BOOTTRAN" ++++ True if we are translating code written in Old Boot. +$translatingOldBoot := false + +AxiomCore::%sysInit() == + if cdr ASSOC(Option '"boot", %systemOptions()) = '"old" + then $translatingOldBoot := true + -- Make x, the current package setCurrentPackage x == SETQ(_*PACKAGE_*,x) -- cgit v1.2.3