more cleanup

4 files changed, 73 insertions, 75 deletions

diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index c6b6b4dc..2c1a810d 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -262,6 +262,7 @@ for i in [ _
   ["codePoint", "CHAR-CODE"], _
   ["cons?",      "CONSP"]  , _
   ["copy",        "COPY"]  , _
+  ["copyTree", "COPY-TREE"] , _
   ["croak",      "CROAK"]  , _
   ["digit?",    "DIGIT-CHAR-P"]  , _
   ["drop",        "DROP"]  , _
diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot
index 882007b7..b8560f59 100644
--- a/src/interp/i-object.boot
+++ b/src/interp/i-object.boot
@@ -67,7 +67,7 @@ $useIntegerSubdomain := true
 
 -- These are the new structure functions.
 
-objNew(val, mode) == [mode,:val]             -- new names as of 10/14/93
+objNew(val, mode) == [mode,:val]           -- new names as of 10/14/93
 objNewWrap(val, mode) == [mode,:wrap val]
 objNewCode(val, mode) == ["CONS", MKQ mode,val ]
 objSetVal(obj,val) == obj.rest := val
@@ -93,10 +93,11 @@ wrap x ==
   isWrapped x => x
   ["WRAPPED",:x]
  
-isWrapped x == x is ['WRAPPED,:.] or integer? x or FLOATP x or string? x
+isWrapped x ==
+  x is ['WRAPPED,:.] or integer? x or float? x or string? x
  
 unwrap x ==
-  integer? x or FLOATP x or string? x => x
+  integer? x or float? x or string? x => x
   x is ["WRAPPED",:y] => y
   x
  
@@ -114,7 +115,7 @@ getValueNormalForm obj ==
   val := objVal obj
   atom val => val
   [op,:argl] := val
-  op = "WRAPPED" => MKQ argl
+  op is "WRAPPED" => MKQ argl
   IDENTP op and isConstructorName op => 
     isConceptualCategory objMode obj => instantiationNormalForm(op,argl)
     MKQ val
@@ -163,7 +164,8 @@ $immediateDataSymbol ==
 
 ++ If x is a literal of the basic types (Integer String DoubleFloat) then
 ++ this function returns its type, and nil otherwise.
-getBasicMode x ==  getBasicMode0(x,$useIntegerSubdomain)
+macro getBasicMode x ==
+  getBasicMode0(x,$useIntegerSubdomain)
 
 ++ Subroutine of getBasicMode.
 getBasicMode0(x,useIntegerSubdomain) ==
@@ -219,19 +221,20 @@ getBasicObject x ==
 mkAtreeNode x ==
   -- maker of attrib tree node
   v := newShell 5
-  v.0 := x
+  vectorRef(v,0) := x
   v
 
 ++ remove mode, value, and misc. info from attrib tree
 emptyAtree expr ==
   vector? expr =>
-    $immediateDataSymbol = expr.0 => nil
-    expr.1:= nil
-    expr.2:= nil
-    expr.3:= nil
+    symbolEq?($immediateDataSymbol,vectorRef(expr,0)) => nil
+    vectorRef(expr,1) := nil
+    vectorRef(expr,2) := nil
+    vectorRef(expr,3) := nil
     -- kill proplist too?
   atom expr => nil
-  for e in expr repeat emptyAtree e
+  for e in expr repeat
+    emptyAtree e
 
 
 ++ returns true if x is a leaf VAT object.
@@ -250,13 +253,13 @@ getMode x ==
 putMode(x,y) ==
   x is [op,:.] => putMode(op,y)
   not vector? x => keyedSystemError("S2II0001",[x])
-  x.1 := y
+  vectorRef(x,1) := y
 
 ++ returns an interpreter object that represents the value of node x.
 ++ Note that an interpreter object is a pair of mode and value.
 ++ Also used by the algebra interface to the interperter.
 getValue x ==
-  vector? x => x.2
+  vector? x => vectorRef(x,2)
   atom x =>
     t := getBasicObject x => t
     keyedSystemError("S2II0001",[x])
@@ -266,7 +269,7 @@ getValue x ==
 putValue(x,y) ==
   x is [op,:.] => putValue(op,y)
   not vector? x => keyedSystemError("S2II0001",[x])
-  x.2 := y
+  vectorRef(x,2) := y
 
 ++ same as putValue(vec, val), except that vec is returned instead of val.
 putValueValue(vec,val) ==
@@ -276,7 +279,7 @@ putValueValue(vec,val) ==
 ++ Returns the node class of x, if possible; otherwise nil.
 ++ Also used by the algebra interface to the interpreter.
 getUnnameIfCan x ==
-  vector? x => x.0
+  vector? x => vectorRef(x,0)
   x is [op,:.] => getUnnameIfCan op
   atom x => x
   nil
@@ -288,7 +291,7 @@ getUnname x ==
 
 ++ Subroutine of getUnname.
 getUnname1 x ==
-  vector? x => x.0
+  vector? x => vectorRef(x,0)
   cons? x => keyedSystemError("S2II0001",[x])
   x
 
@@ -310,14 +313,14 @@ getModeSet x ==
 putModeSet(x,y) ==
   x is [op,:.] => putModeSet(op,y)
   not vector? x => keyedSystemError("S2II0001",[x])
-  x.3 := y
+  vectorRef(x,3) := y
   y
 
 getModeOrFirstModeSetIfThere x ==
   x is [op,:.] => getModeOrFirstModeSetIfThere op
   vector? x =>
-    m := x.1 => m
-    val := x.2 => objMode val
+    m := vectorRef(x,1) => m
+    val := vectorRef(x,2) => objMode val
     y := x.aModeSet =>
       (y = [$EmptyMode]) and ((m := getMode x) is ['Mapping,:.]) => m
       first y
@@ -326,18 +329,18 @@ getModeOrFirstModeSetIfThere x ==
   nil
 
 getModeSetUseSubdomain x ==
-  x and cons? x => getModeSetUseSubdomain first x
-  vector?(x) =>
+  cons? x => getModeSetUseSubdomain first x
+  vector? x =>
     -- don't play subdomain games with retracted args
     getAtree(x,'retracted) => getModeSet x
     y := x.aModeSet =>
       (y = [$EmptyMode]) and ((m := getMode x) is ['Mapping,:.]) =>
         [m]
       val := getValue x
-      (x.0 = $immediateDataSymbol) and (y = [$Integer]) =>
+      (vectorRef(x,0) = $immediateDataSymbol) and (y = [$Integer]) =>
         val := objValUnwrap val
         m := getBasicMode0(val,true)
-        x.2 := objNewWrap(val,m)
+        vectorRef(x,2) := objNewWrap(val,m)
         x.aModeSet := [m]
         [m]
       null val => y
@@ -373,8 +376,8 @@ putAtree(x,prop,val) ==
     x
   not vector? x => x     -- just ignore it
   n := QLASSQ(prop,'((mode . 1) (value . 2) (modeSet . 3)))
-    => x.n := val
-  x.4 := insertShortAlist(prop,val,x.4)
+    => vectorRef(x,n) := val
+  vectorRef(x,4) := insertShortAlist(prop,val,x.4)
   x
 
 getAtree(x,prop) ==
@@ -384,9 +387,9 @@ getAtree(x,prop) ==
     vector? op => getAtree(op,prop)
     nil
   not vector? x => nil     -- just ignore it
-  n:= QLASSQ(prop,'((mode . 1) (value . 2) (modeSet . 3)))
-    => x.n
-  QLASSQ(prop,x.4)
+  n := QLASSQ(prop,'((mode . 1) (value . 2) (modeSet . 3)))
+    => vectorRef(x,n)
+  QLASSQ(prop,vectorRef(x,4))
 
 putTarget(x, targ) ==
   -- want to put nil modes perhaps to clear old target
@@ -409,31 +412,35 @@ getSrcPos(x) ==
 
 ++ sets the source location information for VAT node x.
 putSrcPos(x, file, src, line, col) ==
-  putAtree(x, 'srcAndPos, srcPos_New(file, src, line, col))
+  putAtree(x, 'srcAndPos, srcPosNew(file, src, line, col))
 
 srcPosNew(file, src, line, col) == 
-  LIST2VEC [file, src, line, col]
+  vector [file, src, line, col]
 
 ++ returns the name of source file for source location `sp'.
 srcPosFile(sp) ==
-  if sp then sp.0 else nil
+  sp ~= nil => vectorRef(sp,0)
+  nil
 
 ++ returns the input source string for source location `sp'.
 srcPosSource(sp) ==
-  if sp then sp.1 else nil
+  sp ~= nil => vectorRef(sp,1)
+  nil
 
 ++ returns the line number for source location `sp'.
 srcPosLine(sp) ==
-  if sp then sp.2 else nil
+  sp ~= nil => vectorRef(sp,2)
+  nil
 
 ++ returns the column number for source location `sp'.
 srcPosColumn(sp) ==
-  if sp then sp.3 else nil
+  sp ~= nil => vectorRef(sp,3)
+  nil
 
 srcPosDisplay(sp) ==
   null sp => nil
   s := strconc('"_"", srcPosFile sp, '"_", line ",
-      STRINGIMAGE srcPosLine sp, '": ")
+      toString srcPosLine sp, '": ")
   sayBrightly [s, srcPosSource sp]
   col  := srcPosColumn sp
   dots :=
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 51682508..b4105dbd 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -117,24 +117,22 @@ NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) ==
   not firstTime and (k:= NRTassocIndex x) => k
   vector? x => systemErrorHere '"NRTencode"
   cons? x =>
-    op := first x
-    op = "Record" or x is ['Union,['_:,a,b],:.] =>
-      [op,:[['_:,a,encode(b,c,false)]
-        for [.,a,b] in rest x for [.,=a,c] in rest compForm]]
+    op := x.op
+    op is ":" => [op,second x,encode(third x,third compForm,false)]
     (x' := isQuasiquote x) =>
       quasiquote encode(x',isQuasiquote compForm,false)
-    IDENTP op and (constructor? op or op in '(Union Mapping)) =>
-      [op,:[encode(y,z,false) for y in rest x for z in rest compForm]]
+    op is "Enumeration" => x
+    IDENTP op and (constructor? op or builtinConstructor? op) =>
+      [op,:[encode(y,z,false) for y in x.args for z in compForm.args]]
     -- enumeration constants are like field names, they do not need
     -- to be encoded.
-    op = "Enumeration" => x
-    ["NRTEVAL",NRTreplaceAllLocalReferences COPY_-TREE simplifyVMForm compForm]
+    ["NRTEVAL",NRTreplaceAllLocalReferences copyTree simplifyVMForm compForm]
   symbolMember?(x,$formalArgList) =>
     v := $FormalMapVariableList.(POSN1(x,$formalArgList))
     firstTime => ["local",v]
     v
-  x = "$" => x
-  x = "$$" => x
+  x is "$" => x
+  x is "$$" => x
   ['QUOTE,x]
 
 --------------FUNCTIONS CALLED DURING CAPSULE FUNCTION COMPILATION-------------
@@ -143,7 +141,7 @@ listOfBoundVars form ==
   form is '$ => []
   IDENTP form and (u:=get(form,'value,$e)) =>
     u:=u.expr
-    KAR u in '(Union Record) => listOfBoundVars u
+    builtinConstructor? KAR u => listOfBoundVars u
     [form]
   atom form => []
   first form is 'QUOTE => []
@@ -292,29 +290,25 @@ NRTassignCapsuleFunctionSlot(op,sig) ==
 ++ This would prevent putting spurious items in $NRTdeltaList
 NRTinnerGetLocalIndex x ==
   atom x => x
-  -- following test should skip Unions, Records, Mapping
-  op := first x
-  op in '(Union Record Mapping Enumeration _[_|_|_]) => NRTgetLocalIndex x
-  constructor? op => NRTgetLocalIndex x
+  op := x.op
+  IDENTP op and (constructor? op or builtinConstructor? op) =>
+    NRTgetLocalIndex x
+  op is "[||]" => NRTgetLocalIndex x
   NRTaddInner x
 
 
 NRTaddInner x ==
 --called by genDeltaEntry and others that affect $NRTdeltaList
-  PROGN
+  do
     atom x => nil
-    x is ['Record,:l] =>
-      for [.,.,y] in l repeat NRTinnerGetLocalIndex y
-    first x in '(Union Mapping _[_|_|_]) =>
-      for y in rest x repeat
-         y is [":",.,z] => NRTinnerGetLocalIndex z
-         NRTinnerGetLocalIndex y
+    x is [":",y,z] => [x.op,y,NRTinnerGetLocalIndex z]
     x is ['SubDomain,y,:.] => NRTinnerGetLocalIndex y
+    builtinConstructor? x.op or x.op is "[||]" =>
+      for y in x.args repeat
+        NRTinnerGetLocalIndex y
     getConstructorSignature first x is [.,:ml] =>
-      for y in rest x for m in ml | y isnt '$ repeat
+      for y in x.args for m in ml | y isnt '$ repeat
         isCategoryForm(m,$CategoryFrame) => NRTinnerGetLocalIndex y
-    x is ["Enumeration",:.] =>
-      for y in rest x repeat NRTinnerGetLocalIndex y
     keyedSystemError("S2NR0003",[x])
   x
 
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index b4fba7f9..a470cdbb 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -107,12 +107,7 @@ evalSlotDomain(u,dollar) ==
     y
   u is ['NRTEVAL,y] => eval y
   u is ['QUOTE,y] => y
-  u is ['Record,:argl] =>
-     apply('Record,[[":",tag,evalSlotDomain(dom,dollar)]
-                                 for [.,tag,dom] in argl])
-  u is ['Union,:argl] and first argl is ['_:,.,.] =>
-     apply('Union,[['_:,tag,evalSlotDomain(dom,dollar)]
-                                 for [.,tag,dom] in argl])
+  u is [":",tag,dom] => [":",tag,evalSlotDomain(dom,dollar)]
   u is ["Enumeration",:.] => eval u
   cons? u =>
     -- The domain form may value arguments, get VM form first.
@@ -557,14 +552,15 @@ newExpandLocalType(lazyt,dollar,domain) ==
   newExpandLocalTypeForm(lazyt,dollar,domain)             --new style
  
 newExpandLocalTypeForm([functorName,:argl],dollar,domain) ==
-  functorName in '(Record Union) and first argl is [":",:.] =>
-    [functorName,:[['_:,tag,newExpandLocalTypeArgs(dom,dollar,domain,true)]
-                                 for [.,tag,dom] in argl]]
-  functorName in '(Union Mapping _[_|_|_] Enumeration) =>
-          [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]]
+  functorName is ":" =>
+    [":",first argl,newExpandLocalTypeArgs(second argl,dollar,domain,true)]
+  functorName is "[||]" =>
+    [functorName,newExpandLocalTypeArgs(first argl,dollar,domain,true)]
   functorName is "QUOTE"  => [functorName,:argl]
-  coSig := getDualSignatureFromDB functorName
-  null coSig => error ["bad functorName", functorName]
+  builtinConstructor? functorName =>
+    [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]]
+  coSig := getDualSignatureFromDB functorName or
+     error ["unknown constructor name", functorName]
   [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,flag)
         for a in argl for flag in rest coSig]]
  
@@ -632,9 +628,9 @@ resolveNiladicConstructors form ==
 -- in spad code.  Please do not break this!  An example is the use of
 -- Interval (an Aldor domain) by SIGNEF in limitps.spad.  MCD.
 newHasTest(domform,catOrAtt) ==
-  domform is [dom,:.] and dom in '(Union Record Mapping Enumeration) =>
-    ofCategory(domform, catOrAtt)
   catOrAtt is '(Type) => true
+  cons? domform and builtinFunctorName? domform.op =>
+    ofCategory(domform,catOrAtt)
   asharpConstructorFromDB opOf domform => fn(domform,catOrAtt) where
   -- atom (infovec := getInfovec opOf domform) => fn(domform,catOrAtt) where
     fn(a,b) ==