aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/boot/ChangeLog11
-rw-r--r--src/boot/ast.boot.pamphlet40
-rw-r--r--src/boot/parser.boot.pamphlet4
-rw-r--r--src/boot/tokens.boot.pamphlet97
-rw-r--r--src/boot/translator.boot.pamphlet7
5 files changed, 146 insertions, 13 deletions
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 <gdr@cs.tamu.edu>
+
+ * 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 <gdr@cs.tamu.edu>
* 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)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-09 04:21:53 +0000