* 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.

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)