2009-01-03 Gabriel Dos Reis <gdr@cs.tamu.edu>

	* Makefile.pamphlet (AXIOM_SRC_TARGETS): Add all-databases.

src/ChangeLog
2009-01-03  Gabriel Dos Reis  <gdr@cs.tamu.edu>

	* lisp/core.lisp.in (|%algebraSystemIsComplete|): New.
	(|%basicSystemIsComplete|): Use it.
	* interp/wi1.boot (setqSingle): Use maximalSuperType.
	(coerceSubset): Simplify.
	(compCoerce1): Tidy.
	* interp/i-resolv.boot (resolveTCat): Use superType.
	* interp/lisplib.boot (findConstructorSlotNumber): Use isSubset.
	(sigsMatch): Likewise.
	(findDomainSlotNumber): Likewise.
	* interp/define.boot (compSubDomain1): Reject for complex subdomain
	predicate.  Support paramterized subdomains.
	* interp/daase.lisp (interpOpen): Read superdomain slot.
	(getdatabase): Remove adhoc hardcoded superdomain info.
	Return superdomain info stored in database.
	(localnrlib): Read superdomain info.
	(write-interpdb): Write superdomain info.
	(database): Add superdomain slot.
	* interp/g-util.boot (superType): New.
	(maximalSuperType): Rework.  Support parameterized subdomains.
	(noteSubDomainInfo): New.
	(isSubDomain): Rework.
	* interp/c-util.boot (isSubset): Rework.
	* interp/g-opt.boot (optEQ): Remove.
	* interp/g-cndata.boot (getImmediateSuperDomain): Remove.
	(maximalSuperType): Move to g-util.boot.
	* interp/types.boot (%Constructor): New type specifier.
	(%Instantiation): Likewise.
	* interp/compiler.boot (primitiveType): Don't return $NegativeInteger.
	(maxSuperType): Remove.
	(hasType): Use maximalSuperType.
	(satisfies): New.
	(coerceSubset): Use it.  Simplify.
	* interp/wi2.boot (smallIntegerStep): Use maximalSuperType.
	* interp/sys-constants.boot ($AtVariables): New.
	($NegativeInteger): Remove.
	($NonPositiveInteger): Likewise.
	($CategoryNames): Category is not a category.	
	* interp/property.lisp: Remove Subsets property settings.
	* interp/i-coerce.boot (coerceSubDomain): Simplify.
	(coerceImmediateSubDomain): Remove.
	(getSubDomainPredicate): Simplify.
	* interp/category.boot (SourceLevelSubset): Use isSubDomain.
	(MachineLevelSubset): Likewise.
	* interp/modemap.boot (mergeModemap): Likewise.
	(isSuperDomain): Remove.
	(augModemapsFromDomain): Support parameterized subdomains.
	* interp/i-util.boot (isSubDomain): Move to g-util.boot.
	* Makefile.pamphlet (all-databases): New target.
	* interp/Makefile.pamphlet ($(AXIOMSYS)): Push
	:open-axiom-algebra-system onto *FEATURES*.
	* etc/Makefile.in (all-databases): New target.

36 files changed, 252 insertions, 230 deletions

diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 4804f25b..55cea06a 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -216,7 +216,7 @@ ${AXIOMSYS}: database.date \
 	$(BOOTSYS) -- \
 		--system="$(AXIOM)/" \
 		--sysalg="$(axiom_targetdir)/algebra/" \
-		--prologue="(pushnew :open-axiom-basic-system *features*)" \
+		--prologue="(pushnew :open-axiom-algebra-system *features*)" \
 		--make --output=$@ --main="BOOT::|systemMain|" \
 		--load-directory=. $(OBJS) makeint.$(LNKEXT)
 	@ echo 6a $@ created
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index 7ba5f03b..3455bfe9 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -379,7 +379,7 @@ ${AXIOMSYS}: database.date \
 	$(BOOTSYS) -- \
 		--system="$(AXIOM)/" \
 		--sysalg="$(axiom_targetdir)/algebra/" \
-		--prologue="(pushnew :open-axiom-basic-system *features*)" \
+		--prologue="(pushnew :open-axiom-algebra-system *features*)" \
 		--make --output=$@ --main="BOOT::|systemMain|" \
 		--load-directory=. $(OBJS) makeint.$(LNKEXT)
 	@ echo 6a $@ created
diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot
index c99b359b..ce5958d2 100644
--- a/src/interp/c-doc.boot
+++ b/src/interp/c-doc.boot
@@ -833,8 +833,8 @@ hasNoVowels x ==
   and/[not isVowel(x.i) for i in 0..max]
 
 isVowel c ==
-  EQ(c,char 'a) or EQ(c,char 'e) or EQ(c,char 'i) or EQ(c,char 'o) or EQ(c,char 'u) or
-    EQ(c,char 'A) or EQ(c,char 'E) or EQ(c,char 'I) or EQ(c,char 'O) or EQ(c,char 'U)
+  c=char 'a or c=char 'e or c=char 'i or c=char 'o or c=char 'u or
+    c=char 'A or c=char 'E or c=char 'I or c=char 'O or c=char 'U
 
 
 checkAddBackSlashes s ==
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 3bcf12c2..7aba9153 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -496,11 +496,26 @@ makeLiteral(x,e) ==
  
 isSomeDomainVariable s ==
   IDENTP s and #(x:= PNAME s)>2 and x.(0)="#" and x.(1)="#"
- 
+
+++ Return non-nil is the domain form `x' is a `subset' of domain
+++ form `y' in the environment `e'.  The relation of subdomain
+++ is understood as equivalent to the fact that all values of
+++ the domain designated by `x' are also values of the domain
+++ designated by `y'.  Examples include declaration of domain `x'
+++ as satisfying  SubsetCategory(SomeCategory, y).  Or, when
+++ x is defined as SubDomain(y,pred).  In that case, the predicate
+++ is returned and its parameter is `#1'.
 isSubset(x,y,e) ==
-  ($useRepresentationHack and x="$" and y="Rep") or x=y or
-    LASSOC(opOf x,get(opOf y,"Subsets",e) or GETL(opOf y,"Subsets")) or
-      LASSOC(opOf x,get(opOf y,"SubDomain",e)) or opOf(y)="Type"
+  x = y => true
+  -- Every domain or catgory is a subset of Type.
+  y = $Type => true
+  -- When using the old style definition, the current domain
+  -- is considered a subset of its representation domain
+  x = "$" and y = "Rep" => $useRepresentationHack
+  -- Or, if x has the Subsets property set by SubsetCategory.
+  pred := LASSOC(opOf x,get(opOf y,"Subsets",e)) => pred
+  -- Or, they are related by subdomain chain.
+  isDomainForm(x,e) and isSubDomain(x,y)
  
 isDomainInScope(domain,e) ==
   domainList:= getDomainsInScope e
diff --git a/src/interp/category.boot b/src/interp/category.boot
index 91a79604..15fe1efe 100644
--- a/src/interp/category.boot
+++ b/src/interp/category.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -297,10 +297,10 @@ SigListOpSubsume([[name1,sig1,:.],:.],list) ==
   --does m subsume another operator in the list?
         --see "operator subsumption" in SYSTEM SCRIPT
         --if it does, returns the subsumed member
-  lsig1:=LENGTH sig1
+  lsig1 := #sig1
   ans:=[]
   for (n:=[[name2,sig2,:.],:.]) in list repeat
-    name1=name2 and EQ(lsig1,LENGTH sig2) and SourceLevelSubsume(sig1,sig2) =>
+    name1=name2 and lsig1 = #sig2 and SourceLevelSubsume(sig1,sig2) =>
       ans:=[n,:ans]
   return ans
  
@@ -320,9 +320,7 @@ SourceLevelSubset(a,b) ==
   $noSubsumption=true => false
   b is ["Union",:blist] and member(a,blist) => true
   BOUNDP '$noSubsets and $noSubsets => false
-  atom b and assoc(a,GETL(b,"Subsets")) => true
-  a is [a1] and b is [b1] and assoc(a1,GETL(b1,"Subsets")) => true
-  nil
+  not null isSubDomain(a,b)
  
 MachineLevelSubsume([name1,[out1,:in1],:flag1],[name2,[out2,:in2],:flag2]) ==
   -- Checks for machine-level subsumption in the sense of SYSTEM SCRIPT
@@ -338,10 +336,8 @@ MachineLevelSubset(a,b) ==
   b is ["Union",:blist] and member(a,blist) and
     (and/[STRINGP x for x in blist | x^=a]) => true
            --all other branches must be distinct objects
-  atom b and assoc(a,GETL(b,"Subsets")) => true
-  a is [a1] and b is [b1] and assoc(a1,GETL(b1,"Subsets")) => true
+  not null isSubDomain(a,b)
              --we assume all subsets are true at the machine level
-  nil
  
 --% Ancestor chasing code
  
diff --git a/src/interp/clam.boot b/src/interp/clam.boot
index 863b255c..a0414464 100644
--- a/src/interp/clam.boot
+++ b/src/interp/clam.boot
@@ -611,7 +611,7 @@ hputNewProp(ht,op,argList,val) ==
 listTruncate(l,n) ==
   u:= l
   n:= QSSUB1 n
-  while NEQ(n,0) and null atom u repeat
+  while n ^= 0 and null atom u repeat
     n:= QSSUB1 n
     u:= QCDR u
   if null atom u then
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 6885ba74..bc56663c 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -407,7 +407,7 @@ primitiveType x ==
   INTEGERP x =>
     x=0 => $NonNegativeInteger
     x>0 => $PositiveInteger
-    true => $NegativeInteger
+    $Integer
   FLOATP x => $DoubleFloat
   nil
 
@@ -458,10 +458,6 @@ mkUnion(a,b) ==
   b is ["Union",:l] => ["Union",:union([a],l)]
   ["Union",a,b]
 
-maxSuperType(m,e) ==
-  typ:= get(m,"SuperDomain",e) => maxSuperType(typ,e)
-  m
-
 hasType(x,e) ==
   fn get(x,"condition",e) where
     fn x ==
@@ -822,7 +818,7 @@ setqSingle(id,val,m,E) ==
     eval or return nil where
       eval() ==
         T:= comp(val,m'',E) => T
-        not get(id,"mode",E) and m'' ^= (maxm'':=maxSuperType(m'',E)) and
+        not get(id,"mode",E) and m'' ^= (maxm'':=maximalSuperType m'') and
            (T:=comp(val,maxm'',E)) => T
         (T:= comp(val,$EmptyMode,E)) and getmode(T.mode,E) =>
           assignError(val,T.mode,id,m'')
@@ -1458,17 +1454,18 @@ coerceEasy(T,m) ==
   T.mode=$EmptyMode or modeEqualSubst(T.mode,m,T.env) =>
     [T.expr,m,T.env]
 
+satisfies(val,pred) ==
+  pred=false or pred=true => pred
+  eval ["LET",[["#1",val]],pred]
 
 coerceSubset: (%Triple,%Mode) -> %Maybe %Triple
 coerceSubset([x,m,e],m') ==
   isSubset(m,m',e) => [x,m',e]
-  m is ['SubDomain,=m',:.] => [x,m',e]
-  (pred:= LASSOC(opOf m',get(opOf m,'SubDomain,e))) and INTEGERP x and
-     -- obviously this is temporary
-    eval substitute(x,"#1",pred) => [x,m',e]
-  (pred:= isSubset(m',maxSuperType(m,e),e)) and INTEGERP x -- again temporary
-    and eval substitute(x,"*",pred) =>
-      [x,m',e]
+  isDomainForm(m,e) and isSubDomain(m,m') => [x,m',e]
+  INTEGERP x =>
+    -- obviously this is temporary
+    satisfies(x,isSubDomain(m',maximalSuperType m)) => [x,m',e]
+    nil
   nil
 
 coerceHard: (%Triple,%Mode) -> %Maybe %Triple
@@ -1554,10 +1551,10 @@ compCoerce1(x,m',e) ==
   T:=[T.expr,m1,T.env]
   T':= coerce(T,m') => T'
   T':= coerceByModemap(T,m') => T'
-  pred:=isSubset(m',T.mode,e) =>
-    gg:=GENSYM()
-    pred:= substitute(gg,"*",pred)
-    code:= ['PROG1,["%LET",gg,T.expr], ['check_-subtype,pred,MKQ m',gg]]
+  pred := isSubset(m',T.mode,e) =>
+    gg := GENSYM()
+    pred := substitute(gg,"#1",pred)
+    code := ['PROG1,["%LET",gg,T.expr], ['check_-subtype,pred,MKQ m',gg]]
     [code,m',T.env]
 
 coerceByModemap([x,m,e],m') ==
diff --git a/src/interp/cparse.boot b/src/interp/cparse.boot
index 7f2c2971..c3b11c5b 100644
--- a/src/interp/cparse.boot
+++ b/src/interp/cparse.boot
@@ -264,7 +264,7 @@ npLeftAssoc(operations,parser)==
     else false
 
 npInfixOp()==
-  EQ(CAAR $stok,"key") and
+  CAAR $stok = "key" and
     GETL($ttok,"INFGENERIC") and npPushId()
 
 npInfixOperator()== npInfixOp() or
@@ -279,7 +279,7 @@ npInfixOperator()== npInfixOp() or
         npRestore a
         false
 
-npInfKey s==  EQ(CAAR $stok,"key") and  MEMQ($ttok,s) and npPushId()
+npInfKey s==  CAAR $stok="key" and  MEMQ($ttok,s) and npPushId()
 
 npDDInfKey s==
     npInfKey s or
@@ -334,20 +334,20 @@ npWConditional f==
 
 -- peek for keyword s, no advance of token stream
 
-npEqPeek s ==  EQ(CAAR $stok,"key") and EQ(s,$ttok)
+npEqPeek s ==  CAAR $stok="key" and EQ(s,$ttok)
 
 -- test for keyword s, if found advance token stream
 
 npEqKey s ==
-    EQ(CAAR $stok,"key") and EQ(s,$ttok) and npNext()
+    CAAR $stok="key" and EQ(s,$ttok) and npNext()
 
 $npTokToNames:= ["~","#","[]","{}", "[||]","{||}"]
 
 npId() ==
-        EQ(CAAR $stok,"id") =>
+        CAAR $stok="id" =>
                npPush $stok
                npNext()
-        EQ(CAAR $stok,"key") and MEMQ($ttok,$npTokToNames)=>
+        CAAR $stok="key" and MEMQ($ttok,$npTokToNames)=>
                npPush tokConstruct("id",$ttok,tokPosn $stok)
                npNext()
         false
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 9355c2a1..551925ee 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2008, Gabriel Dos Reis.
+;; Copyright (C) 2007-2009, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -226,6 +226,7 @@
  parents                    ; browse.
  users                      ; browse.
  dependents                 ; browse.
+ superdomain                ; interp.
  spare                      ; superstition
  ) ; database structure
 
@@ -557,11 +558,12 @@
 ;         constructormodemap for domains and packages so it is stored
 ;         as NIL for them. it is valid for categories.
 ;    niladic             -- t or nil directly
-;    unused
+;    abbrev              -- kept directly
 ;    cosig               -- kept directly
 ;    constructorkind     -- kept directly
 ;    defaultdomain       -- a short list, for %i
 ;    ancestors           -- used to compute new category updates
+;    superdomain         -- valid for domain, NIL for category and package.
 ;  )
 (defun interpOpen ()
   "open the interpreter database and hash the keys"
@@ -590,7 +592,10 @@
 	(setf (get (eighth item) 'abbreviationfor) (first item)) ;invert
 	(setf (database-cosig dbstruct) (ninth item))
 	(setf (database-constructorkind dbstruct) (tenth item))
-	(setf (database-ancestors dbstruct) (nth 11 item))))
+	(setf (database-ancestors dbstruct) (nth 11 item))
+	(setf (database-superdomain dbstruct) (nth 12 item))
+	))
+    
     (format t "~&")))
 
 ; this is an initialization function for the constructor database
@@ -828,11 +833,9 @@
 	    (constructor?
 	     (|fatalError| "GETDATABASE called with CONSTRUCTOR?"))
 	    (superdomain ; only 2 superdomains in the world
-	     (case constructor
-		   (|NonNegativeInteger|
-		    (setq data '((|Integer|) (IF (< |#1| 0) |false| |true|))))
-		   (|PositiveInteger|
-		    (setq data '((|NonNegativeInteger|) (< 0 |#1|))))))
+	     (setq stream *interp-stream*)
+	     (when (setq struct (get constructor 'database))
+	       (setq data (database-superdomain struct))))
 	    (constructor
 	     (when (setq data (get constructor 'abbreviationfor))))
 	    (defaultdomain
@@ -881,7 +884,11 @@
 	(when *miss*
 	  (format t "getdatabase miss: ~20a ~a~%" key constructor))
 	(file-position stream data)
-	(setq data (unsqueeze (read stream)))
+	;; Don't attempt to uncompress codes -- they are not compressed.
+	(setq data (read stream))
+	(unless (eq key 'superdomain)
+	  (setq data (unsqueeze data)))
+	;;(setq data (unsqueeze (read stream)))
 	(case key ; cache the result of the database read
 	      (operation           
 	       (setf (gethash constructor *operation-hash*) data))
@@ -919,6 +926,8 @@
 	       (setf (database-documentation struct) data))
 	      (parents   
 	       (setf (database-parents struct) data))
+	      (superdomain
+	       (setf (database-superdomain struct) data))
 	      (users     
 	       (setf (database-users struct) data))
 	      (dependents
@@ -1197,6 +1206,14 @@
 			   (fetchdata alist in "predicates"))
 		     (setf (database-niladic dbstruct)
 			   (when (fetchdata alist in "NILADIC") t))
+		     (let ((super (fetchdata alist in "evalOnLoad2")))
+		       (setf (database-superdomain dbstruct)
+			     (when super 
+			       (setq super (cddr super))
+			       ;; unquote the domain and predicate.
+			       (rplaca super (second (first super)))
+			       (rplacd super (cdr (second super)))
+			       super)))
 		     (addoperations key oldmaps)
 		     (unless make-database?
 		       (if (eq kind '|category|)
@@ -1408,7 +1425,7 @@
  (declare (special *ancestors-hash*))
  (let (opalistpos modemapspos cmodemappos master masterpos obj *print-pretty*
         concategory categorypos kind niladic cosig abbrev defaultdomain
-        ancestors ancestorspos out)
+        ancestors ancestorspos superpos out)
   (print "building interp.daase")
   (setq out (open "interp.build" :direction :output))
   (princ "                              " out)
@@ -1452,9 +1469,18 @@
 	  (print ancestors out)
 	  (finish-output out))
       (setq ancestorspos nil))
+    (setq superpos
+	  ;; We do NOT want to compress codes, as we may not be 
+	  ;; able to uncompress them to their original form.
+	  (let ((super (database-superdomain struct)))
+	    (when super
+	      (prog1 (file-position out)
+		(print super out)
+		(finish-output out)))))
+    
     (push (list constructor opalistpos cmodemappos modemapspos
 		obj categorypos niladic abbrev cosig kind defaultdomain
-		ancestorspos) master)))
+		ancestorspos superpos) master)))
   (finish-output out)
   (setq masterpos (file-position out))
   (print (|squeezeAll| master) out)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 4492e042..a026ed33 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -1441,16 +1441,18 @@ compSubDomain1(domainForm,predicate,m,e) ==
     compCompilerPredicate(predicate,e) or
       stackSemanticError(["predicate: ",predicate,
         " cannot be interpreted with #1: ",domainForm],nil)
-  prefixPredicate:= lispize u.expr
+  pred := lispize u.expr
+  -- For now, reject predicates that directly reference domains
+  CONTAINED("$",pred) => 
+    stackAndThrow('"predicate %1pb is not simple enough",[predicate])
+  -- Abstract over references to parameters of enclosing functor.
+  pred := eqSubst($AtVariables,rest $form, pred)
   $lisplibSuperDomain:=
     [domainForm,predicate]
-  evalAndRwriteLispForm('evalOnLoad2,
-    ['SETQ,'$CategoryFrame,['put,op':= ['QUOTE,$op],'
-     (QUOTE SuperDomain),dF':= ['QUOTE,domainForm],['put,dF','(QUOTE SubDomain),[
-       'CONS,['QUOTE,[$op,:prefixPredicate]],['DELASC,op',['get,dF','
-         (QUOTE SubDomain),'$CategoryFrame]]],'$CategoryFrame]]])
+  evalAndRwriteLispForm('evalOnLoad2, ["noteSubDomainInfo", quoteForm $op, 
+      quoteForm domainForm, quoteForm pred])
   [domainForm,m,e]
- 
+
 compCapsuleInner(itemList,m,e) ==
   e:= addInformation(m,e)
            --puts a new 'special' property of $Information
diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot
index c0af28c2..58783619 100644
--- a/src/interp/g-cndata.boot
+++ b/src/interp/g-cndata.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -94,13 +94,6 @@ categoryForm? c ==
   getConstructorKindFromDB op = "category" => true
   false
 
-getImmediateSuperDomain(d) ==
-  IFCAR getSuperDomainFromDB opOf d
-
-maximalSuperType d ==
-  d' := getSuperDomainFromDB opOf d => maximalSuperType first d'
-  d
-
 -- probably will switch over to 'libName soon
 getLisplibName(c) == getConstructorAbbreviation(c)
  
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index f19a4d69..49c0229a 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -372,13 +372,6 @@ optLESSP u ==
     ['GREATERP,b,a]
   u
  
-optEQ u ==
-  u is ['EQ,l,r] =>
-    NUMBERP l and NUMBERP r => ['QUOTE,EQ(l,r)]
-    -- That undoes some weird work in Boolean to do with the definition of true
-    u
-  u
-
 $simpleVMoperators == 
   '(CONS CAR CDR LENGTH SIZE EQUAL EQL EQ NOT NULL OR AND
     SPADfirst QVELT _+ _- _* _< _=
@@ -451,7 +444,6 @@ lispize x == first optimize [x]
  
 for x in '( (call         optCall) _
            (SEQ          optSEQ)_
-           (EQ optEQ)_
            (MINUS        optMINUS)_
            (QSMINUS      optQSMINUS)_
            (_-           opt_-)_
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 39302d6b..6f2961d8 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -41,6 +41,7 @@ module g_-util where
   getTypeOfSyntax: %Form -> %Mode
   pairList: (%List,%List) -> %List
   mkList: %List -> %List
+  isSubDomain: (%Mode,%Mode) -> %Form
 
 ++
 $interpOnly := false
@@ -62,6 +63,62 @@ isSharpVarWithNum x ==
     ok := DIGITP d => c := 10*c + DIG2FIX d
   if ok then c else nil
 
+
+--% Sub-domains information handlers
+
+++ If `dom' is a subdomain, return its immediate super-domain.  
+superType: %Mode -> %Maybe %Mode
+superType dom ==
+  dom isnt [ctor,:args] => nil
+  [super,.] := getSuperDomainFromDB ctor or return nil
+  sublisFormal(args,super,$AtVariables)
+
+++ Return the root of the reflexive transitive closure of
+++ the super-domain chain for the domain designated by the domain 
+++ form `d'.
+maximalSuperType: %Mode -> %Mode
+maximalSuperType d ==
+  atom d => d
+  d' := superType d => maximalSuperType d'
+  d
+
+++ Note that the functor `sub' instantiates to domains that
+++ are subdomains of `super' instances restricted by the 
+++ predicate `pred'.
+noteSubDomainInfo: (%Symbol,%Instantiation,%Form) -> %Thing
+noteSubDomainInfo(sub,super,pred) ==
+  MAKEPROP(sub,"%SuperDomain",[super,pred])
+
+++ Returns non-nil if `d1' is a sub-domain of `d2'.  This is the
+++ case when `d1' is transitively given by an instance of SubDomain
+++    d1 == SubDomain(d2,pred)
+++ The transitive closure of the predicate form is returned, where 
+++ the predicate parameter is `#1'.
+isSubDomain(d1,d2) ==
+  atom d1 or atom d2 => false
+
+  -- 1.  Easy, if by syntax constructs.
+  d1 is ["SubDomain",=d2,pred] => pred
+
+  -- 2.  Just say no, if there is no hope.
+  [sup,pred] := getSuperDomainFromDB first d1 or return false
+
+  -- 3.  We may be onto something.
+  -- `sup' and `pred' are in most general form.  Instantiate.
+  first sup = first d2 => 
+    -- sanity check.  `d2' should be an instance of `sup'.
+    sublisFormal(rest d1,sup,$AtVariables) ^= d2 =>
+      stackAndThrow('"unexpected instantiation mismatch",nil)
+    sublisFormal(rest d1,pred,$AtVariables)
+
+  -- 4.  Otherwise, lookup in the super-domain chain.
+  pred' := isSubDomain(sup,d2) => MKPF([pred',pred],"AND")
+
+  -- 5.  Lot of smoke, no fire.
+  false
+
+--%
+
 mkList u ==
   u => ["LIST",:u]
   nil
@@ -512,7 +569,7 @@ mergeInPlace(f,g,p,q) ==
    r
 
 mergeSort(f,g,p,n) ==
-   if EQ(n,2) and FUNCALL(f,FUNCALL(g,QCADR p),FUNCALL(g,QCAR p)) then
+   if n=2 and FUNCALL(f,FUNCALL(g,QCADR p),FUNCALL(g,QCAR p)) then
       t := p
       p := QCDR p
       QRPLACD(p,t)
diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot
index 91ff077e..35c0ae0f 100644
--- a/src/interp/i-analy.boot
+++ b/src/interp/i-analy.boot
@@ -503,7 +503,7 @@ bottomUpForm3(t,op,opName,argl,argModeSetList) ==
   bottomUpForm2(t,op,opName,argl,argModeSetList)
 
 bottomUpForm2(t,op,opName,argl,argModeSetList) ==
-  not atom t and EQ(opName,"%%") => bottomUpPercent t
+  not atom t and opName="%%" => bottomUpPercent t
   opVal := getValue op
 
   -- for things with objects in operator position, be careful before
@@ -749,7 +749,7 @@ bottomUpFormRetract(t,op,opName,argl,amsl) ==
     if PAIRP(m) and CAR(m) = $EmptyMode then return NIL
     object:= retract getValue x
     a:= [x,:a]
-    EQ(object,'failed) =>
+    object="failed" =>
         putAtree(x,'retracted,nil)
         ms := [m, :ms]
     b:= true
@@ -771,7 +771,7 @@ bottomUpFormRetract(t,op,opName,argl,amsl) ==
 
 retractAtree atr ==
     object:= retract getValue atr
-    EQ(object,'failed) =>
+    object="failed" =>
         putAtree(atr,'retracted,nil)
         nil
     putAtree(atr,'retracted,true)
diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot
index 1ca27f51..75b88d46 100644
--- a/src/interp/i-coerce.boot
+++ b/src/interp/i-coerce.boot
@@ -441,12 +441,12 @@ canCoerce1(t1,t2) ==
     nt1 := CAR t1
     nt2 := CAR t2
 
-    EQ(nt1,'Mapping) => EQ(nt2,'Any)
-    EQ(nt2,'Mapping) =>
-      EQ(nt1,'Variable) or EQ(nt1,'FunctionCalled) =>
+    nt1="Mapping" => nt2="Any"
+    nt2="Mapping" =>
+      nt1="Variable" or nt1="FunctionCalled" =>
         canCoerceExplicit2Mapping(t1,t2)
       NIL
-    EQ(nt1,'Union) or EQ(nt2,'Union) => canCoerceUnion(t1,t2)
+    nt1="Union" or nt2="Union" => canCoerceUnion(t1,t2)
 
     -- efficiency hack
     t1 is ['Segment, s1] and t2 is ['UniversalSegment, s2] and
@@ -929,32 +929,15 @@ coerceInt1(triple,t2) ==
 coerceSubDomain(val, tSuper, tSub) ==
   -- Try to coerce from a sub domain to a super domain
   val = '_$fromCoerceable_$ => nil
-  super := getSuperDomainFromDB first tSub
-  superDomain := first super
-  superDomain = tSuper =>
-    coerceImmediateSubDomain(val, tSuper, tSub, CADR super)
-  coerceSubDomain(val, tSuper, superDomain) =>
-    coerceImmediateSubDomain(val, superDomain, tSub, CADR super)
-  nil
-
-coerceImmediateSubDomain(val, tSuper, tSub, pred) ==
-  predfn := getSubDomainPredicate(tSuper, tSub, pred)
-  FUNCALL(predfn, val, nil) => objNew(val, tSub)
+  pred := isSubDomain(tSub,tSuper) =>
+    predFun := getSubDomainPredicate(tSuper,tSub,pred)
+    FUNCALL(predFun,val) => objNew(val,tSub)
   nil
 
 getSubDomainPredicate(tSuper, tSub, pred) ==
-  $env: local := $InteractiveFrame
   predfn := HGET($superHash, CONS(tSuper, tSub)) => predfn
-  name := GENSYM()
-  decl := ['_:, name, ['Mapping, $Boolean, tSuper]]
-  interpret(decl, nil)
   arg := GENSYM()
-  pred' := substitute(arg, "#1", pred)
-  defn := ['DEF, [name, arg], '(NIL NIL), '(NIL NIL), removeZeroOne pred']
-  interpret(defn, nil)
-  op := mkAtree name
-  transferPropsToNode(name, op)
-  predfn := CADAR selectLocalMms(op, name, [tSuper],$Boolean)
+  predfn := COMPILE(nil,["LAMBDA",[arg],substitute(arg,"#1", pred)])
   HPUT($superHash, CONS(tSuper, tSub), predfn)
   predfn
 
diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot
index daededbc..a4f279b6 100644
--- a/src/interp/i-funsel.boot
+++ b/src/interp/i-funsel.boot
@@ -663,13 +663,13 @@ hitListOfTarget(t) ==
 
   t = '(Polynomial (Pi)) => 90000
 
-  EQ(CAR t, 'Polynomial) => 300
-  EQ(CAR t, 'List) => 400
-  EQ(CAR t,'Matrix) => 910
-  EQ(CAR t,'UniversalSegment) => 501
-  EQ(CAR t,'RationalFunction) => 900
-  EQ(CAR t,'Union) => 999
-  EQ(CAR t,'Expression) => 1600
+  CAR t ='Polynomial => 300
+  CAR t = 'List => 400
+  CAR t = 'Matrix => 910
+  CAR t = 'UniversalSegment => 501
+  CAR t = 'RationalFunction => 900
+  CAR t = 'Union => 999
+  CAR t = 'Expression => 1600
   500
 
 getFunctionFromDomain(op,dc,args) ==
@@ -856,16 +856,16 @@ findFunctionInDomain1(omm,op,tar,args1,args2,SL) ==
   if CONTAINED('_#, sig) or CONTAINED('construct,sig) then
     sig := [replaceSharpCalls t for t in sig]
   matchMmCond cond and matchMmSig(mm,tar,args1,args2) and
-    EQ(y,'Subsumed) and
+    y="Subsumed" and
       -- hmmmm: do Union check in following because (as in DP)
       -- Unions are subsumed by total modemaps which are in the
       -- mm list in findFunctionInDomain.
       y := 'ELT      -- if subsumed fails try it again
       not $SubDom and CAR sig isnt ['Union,:.] and slot is [tar,:args] and
         (f := findFunctionInDomain(op,dc,tar,args,args,NIL,NIL)) => f
-    EQ(y,'ELT) => [[CONS(dc,sig),osig,nreverse $RTC]]
-    EQ(y,'CONST) => [[CONS(dc,sig),osig,nreverse $RTC]]
-    EQ(y,'ASCONST) => [[CONS(dc,sig),osig,nreverse $RTC]]
+    y='ELT => [[CONS(dc,sig),osig,nreverse $RTC]]
+    y='CONST => [[CONS(dc,sig),osig,nreverse $RTC]]
+    y='ASCONST => [[CONS(dc,sig),osig,nreverse $RTC]]
     y is ['XLAM,:.] => [[CONS(dc,sig),y,nreverse $RTC]]
     sayKeyedMsg("S2IF0006",[y])
     NIL
@@ -1112,7 +1112,7 @@ selectMmsGen(op,tar,args1,args2) ==
         NIL
       [c,t,:a] := sig
       if a then matchTypes(a,args1,args2)
-      not EQ($Subst,'failed) =>
+      $Subst ^= 'failed =>
         mmS := nconc(evalMm(op,tar,sig,mmC),mmS)
     mmS
 
@@ -1145,7 +1145,7 @@ evalMm(op,tar,sig,mmC) ==
   mS:= NIL
   for st in evalMmStack mmC repeat
     SL:= evalMmCond(op,sig,st)
-    not EQ(SL,'failed) =>
+    SL ^= 'failed =>
       SL := fixUpTypeArgs SL
       sig:= [subCopy(deepSubCopy(x,SL),$Subst) for x in sig]
       not containsVars sig =>
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index 15dd641d..e804fb2d 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -1676,7 +1676,7 @@ printBasic x ==
   PRIN1(x,$algebraOutputStream)
 
 charybdis(u,start,linelength) ==
-  EQ(keyp u,'EQUATNUM) and ^(CDDR u) =>
+  keyp u='EQUATNUM and ^(CDDR u) =>
     charybdis(['PAREN,u.1],start,linelength)
   charyTop(u,start,linelength)
 
@@ -1692,7 +1692,7 @@ charyTop(u,start,linelength) ==
     (w := WIDTH(b)) > linelength-start => charyTop(a,start,linelength)
     charyTop(b,half(linelength-start-w),linelength)
   v := charyTopWidth u
-  EQ(keyp u,'ELSE) => charyElse(u,v,start,linelength)
+  keyp u='ELSE => charyElse(u,v,start,linelength)
   WIDTH(v) > linelength => charyTrouble(u,v,start,linelength)
   d := APP(v,start,0,nil)
   n := superspan v
@@ -1737,16 +1737,16 @@ charyTrouble1(u,v,start,linelength) ==
   atom u => outputString(start,linelength,atom2String u)
   EQ(x:= keyp u,'_-) => charyMinus(u,v,start,linelength)
   MEMQ(x,'(_+ _* AGGLST)) => charySplit(u,v,start,linelength)
-  EQ(x,'EQUATNUM) => charyEquatnum(u,v,start,linelength)
+  x='EQUATNUM => charyEquatnum(u,v,start,linelength)
   d := GETL(x,'INFIXOP) => charyBinary(d,u,v,start,linelength)
   x = 'OVER  =>
     charyBinary(GETL("/",'INFIXOP),u,v,start,linelength)
-  EQ(3,LENGTH u) and GETL(x,'Led) =>
+  3=#u and GETL(x,'Led) =>
     d:= PNAME first GETL(x,'Led)
     charyBinary(d,u,v,start,linelength)
-  EQ(x,'CONCAT) =>
+  x='CONCAT =>
     concatTrouble(rest v,d,start,linelength,nil)
-  EQ(x,'CONCATB) =>
+  x='CONCATB =>
     (rest v) is [loop, 'repeat, body] =>
       charyTop(['CONCATB,loop,'repeat],start,linelength)
       charyTop(body,start+2,linelength-2)
@@ -1756,21 +1756,21 @@ charyTrouble1(u,v,start,linelength) ==
         charyTop(body,start+2,linelength-2)
     concatTrouble(rest v,d,start,linelength,true)
   GETL(x,'INFIXOP) => charySplit(u,v,start,linelength)
-  EQ(x,'PAREN) and
+  x='PAREN and
     (EQ(keyp u.1,'AGGLST) and (v:= ",") or EQ(keyp u.1,'AGGSET) and
       (v:= ";")) => bracketagglist(rest u.1,start,linelength,v,"_(","_)")
-  EQ(x,'PAREN) and EQ(keyp u.1,'CONCATB) =>
+  x='PAREN and EQ(keyp u.1,'CONCATB) =>
     bracketagglist(rest u.1,start,linelength," ","_(","_)")
-  EQ(x,'BRACKET) and (EQ(keyp u.1,'AGGLST) and (v:= ",")) =>
+  x='BRACKET and (EQ(keyp u.1,'AGGLST) and (v:= ",")) =>
     bracketagglist(rest u.1,start,linelength,v,
                    specialChar 'lbrk, specialChar 'rbrk)
-  EQ(x,'BRACE) and (EQ(keyp u.1,'AGGLST) and (v:= ",")) =>
+  x='BRACE and (EQ(keyp u.1,'AGGLST) and (v:= ",")) =>
     bracketagglist(rest u.1,start,linelength,v,
                    specialChar 'lbrc, specialChar 'rbrc)
-  EQ(x,'EXT) => longext(u,start,linelength)
-  EQ(x,'MATRIX) => MATUNWND()
-  EQ(x,'ELSE) => charyElse(u,v,start,linelength)
-  EQ(x,'SC) => charySemiColon(u,v,start,linelength)
+  x='EXT => longext(u,start,linelength)
+  x='MATRIX => MATUNWND()
+  x='ELSE => charyElse(u,v,start,linelength)
+  x='SC => charySemiColon(u,v,start,linelength)
   charybdis(x,start,linelength)
   if rest u then charybdis(['ELSE,:rest u],start,linelength)
   -- changed from charybdis(...) by JHD 2 Aug 89, since rest u might be null
@@ -1964,7 +1964,7 @@ appext(u,x,y,d) ==
   temp := 1 + WIDTH agg(2,u) +  WIDTH agg(3,u)
   n := MAX(WIDTH CADR u, WIDTH agg(4,u), temp)
   if EQCAR(first(z := agg(5,u)), 'EXT) and
-   (EQ(n,3) or (n > 3 and ^(atom z)) ) then
+   (n=3 or (n > 3 and ^(atom z)) ) then
      n := 1 + n
   d := APP(z, x + n, y, d)
 
@@ -2040,7 +2040,7 @@ extwidth(u) ==
            1 + WIDTH agg(2, u) + WIDTH agg(3, u) )
   nil or
          (EQCAR(first(z := agg(5, u)), 'EXT) and _
-          (EQ(n, 3) or ((n > 3) and null atom z) )  =>
+          (n=3 or ((n > 3) and null atom z) )  =>
           n := 1 + n)
   true => n + WIDTH agg(5, u)
 
@@ -2332,7 +2332,7 @@ bracketagglist(u, start, linelength, tchr, open, close) ==
              ((s := s + WIDTH first x + 1) >= linelength) => return(s)
              null rest x => return(s := -1)
     nil or
-       EQ(s, -1) => (nextu := nil)
+       s = -1 => (nextu := nil)
        EQ(lastx, u) => ((nextu := rest u); RPLACD(u, nil) )
        true => ((nextu := lastx); RPLACD(PREDECESSOR(lastx, u), nil))
     for x in tails u repeat
diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot
index 658ddcec..75aca0e1 100644
--- a/src/interp/i-resolv.boot
+++ b/src/interp/i-resolv.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -374,8 +374,7 @@ resolveTCat(t,c) ==
 
   c = '(Ring) and t is ['FactoredForm,t0] => ['FactoredRing,t0]
 
-  (t is [t0]) and (sd := getImmediateSuperDomain(t0)) and sd ^= t0 =>
-    resolveTCat(sd,c)
+  sd := superType t => resolveTCat(sd,c)
 
   SIZE(td := deconstructT t) ^= 2=> NIL
   SIZE(tc := deconstructT c) ^= 2 => NIL
diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot
index a4abcc75..eb635d72 100644
--- a/src/interp/i-spec2.boot
+++ b/src/interp/i-spec2.boot
@@ -94,7 +94,7 @@ upDollar t ==
   t2 := t
   (not $genValue) and "or"/[CONTAINED(var,D) for var in $localVars] =>
     keyedMsgCompFailure("S2IS0032",NIL)
-  EQ(D,"Lisp") => upLispCall(op,form)
+  D="Lisp" => upLispCall(op,form)
   if VECP D and (SIZE(D) > 0) then D := D.0
   t := evaluateType unabbrev D
   categoryForm? t =>
@@ -315,7 +315,7 @@ interpIF(op,cond,a,b) ==
   val:= getValue cond
   val:= coerceInteractive(val,$Boolean) =>
     objValUnwrap(val) => upIFgenValue(op,a)
-    EQ(b,"%noBranch") => setValueToVoid op
+    b="%noBranch" => setValueToVoid op
     upIFgenValue(op,b)
   throwKeyedMsg("S2IS0031",NIL)
 
@@ -653,7 +653,7 @@ upLETWithFormOnLhs(op,lhs,rhs) ==
 seteltable(lhs is [f,:argl],rhs) ==
   -- produces the setelt form for trees such as "l.2:= 3"
   null (g := getUnnameIfCan f) => NIL
-  EQ(g,"elt") => altSeteltable [:argl, rhs]
+  g="elt" => altSeteltable [:argl, rhs]
   get(g,'value,$e) is [expr,:.] and isMapExpr expr => NIL
   transferPropsToNode(g,f)
   getValue(lhs) or getMode(lhs) =>
diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot
index 73fe7ce2..b1ce6575 100644
--- a/src/interp/i-util.boot
+++ b/src/interp/i-util.boot
@@ -1,5 +1,7 @@
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
+-- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
 -- modification, are permitted provided that the following conditions are
@@ -101,16 +103,6 @@ LZeros n ==
  
 -- subrToName x == BPINAME x
 
--- formerly in clammed.boot
-
-isSubDomain(d1,d2) ==
-  -- d1 and d2 are different domains
-  subDomainList := '(Integer NonNegativeInteger PositiveInteger)
-  ATOM d1 or ATOM d2 => nil
-  l := MEMQ(CAR d2, subDomainList) =>
-    MEMQ(CAR d1, CDR l)
-  nil
-
 $variableNumberAlist := nil
 
 variableNumber(x) ==
diff --git a/src/interp/interop.boot b/src/interp/interop.boot
index 58b46b42..fde42557 100644
--- a/src/interp/interop.boot
+++ b/src/interp/interop.boot
@@ -360,7 +360,7 @@ basicLookupCheckDefaults(op,sig,domain,dollar) ==
 $hasCatOpHash := hashString '"%%"
 opIsHasCat op ==
   hashCode? op => EQL(op, $hasCatOpHash)
-  EQ(op, "%%")
+  op = "%%"
 
 -- has cat questions lookup up twice if false
 -- replace with following ?
@@ -439,7 +439,7 @@ hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
         nil
       slot := domain.loc
       null atom slot =>
-        EQ(QCAR slot,'newGoGet) => someMatch:=true
+        QCAR slot = 'newGoGet => someMatch:=true
                    --treat as if operation were not there
         --if EQ(QCAR slot,'newGoGet) then
         --  UNWIND_-PROTECT --break infinite recursion
@@ -561,7 +561,7 @@ newHasAttribute(domain,attrib) ==
         or/[x for x in domain.2 | attrib = hashType(first x, hashPercent)]
      LASSOC(attrib,domain.2)
   predIndex =>
-    EQ(predIndex,0) => true
+    predIndex = 0 => true
     predvec := domain.3
     testBitVector(predvec,predIndex)
   false
@@ -575,7 +575,7 @@ newHasCategory(domain,catform) ==
   #catvec > 0 and INTEGERP KDR catvec.0 =>              --old style
     predIndex := lazyMatchAssocV1(catform,catvec,domain)
     null predIndex => false
-    EQ(predIndex,0) => true
+    predIndex = 0 => true
     predvec := QVELT(domain,3)
     testBitVector(predvec,predIndex)
   lazyMatchAssocV(catform,auxvec,catvec,domain)         --new style
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 74d05485..9fd15b53 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -573,7 +573,7 @@ findConstructorSlotNumber(domainForm,domain,op,sig) ==
     "and"/[compare for a in sig for b in sig1]] where compare() ==
       a=b => true
       FIXP b => a=constructorArglist.b
-      isSuperDomain(bustUnion b,bustUnion a,$CategoryFrame)
+      isSubset(bustUnion a,bustUnion b,$CategoryFrame)
   tail is [.,["ELT",.,n]] => n
   systemErrorHere ["findConstructorSlotNumber",domainForm]
  
@@ -599,7 +599,7 @@ sigsMatch(sig,sig1,domainForm) ==
     partsMatch:=
       (item:= CAR sig)=(item1:= CAR sig1) => true --ok, go to next iteration
       FIXP item1 => item = domainForm.item1       --item1=n means nth arg
-      isSuperDomain(bustUnion item,bustUnion item1,$CategoryFrame)
+      isSubset(bustUnion item1,bustUnion item,$CategoryFrame)
     null partsMatch => return nil
     sig:= rest sig; sig1 := rest sig1
   sig or sig1 => nil
@@ -608,7 +608,7 @@ sigsMatch(sig,sig1,domainForm) ==
 findDomainSlotNumber(domain,op,sig) == --using slot 1 of the domain
   nsig:=#sig
   tail:= or/[r for [[op1,sig1],:r] in domain.1 | op=op1 and nsig=#sig1 and
-    "and"/[a=b or isSuperDomain(bustUnion b,bustUnion a,$CategoryFrame)
+    "and"/[a=b or isSubset(bustUnion a,bustUnion b,$CategoryFrame)
       for a in sig for b in sig1]]
   tail is [.,["ELT",.,n]] => n
   systemErrorHere '"findDomainSlotNumber"
diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot
index d836c3ed..9f0b5be0 100644
--- a/src/interp/modemap.boot
+++ b/src/interp/modemap.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -47,10 +47,10 @@ $forceAdd := false
  
 addDomain(domain,e) ==
   atom domain =>
-    EQ(domain,"$EmptyMode") => e
-    EQ(domain,"$NoValueMode") => e
+    domain="$EmptyMode" => e
+    domain="$NoValueMode" => e
     not IDENTP domain or 2<#(s:= STRINGIMAGE domain) and
-      EQ(char "#",s.(0)) and EQ(char "#",s.(1)) => e
+      char "#" = s.0 and char "#" = s.1 => e
     MEMQ(domain,getDomainsInScope e) => e
     isLiteral(domain,e) => e
     addNewDomain(domain,e)
@@ -190,7 +190,7 @@ mkNewModemapList(mc,sig,pred,fn,curModemapList,e,filenameOrNil) ==
  
 mergeModemap(entry is [[mc,:sig],[pred,:.],:.],modemapList,e) ==
   for (mmtail:= [[[mc',:sig'],[pred',:.],:.],:.]) in tails modemapList repeat
-    mc=mc' or isSuperDomain(mc',mc,e) =>
+    mc=mc' or isSubset(mc,mc',e) =>
       newmm:= nil
       mm:= modemapList
       while (not EQ(mm,mmtail)) repeat (newmm:= [first mm,:newmm]; mm:= rest mm)
@@ -211,19 +211,13 @@ mergeModemap(entry is [[mc,:sig],[pred,:.],:.],modemapList,e) ==
 -- In ptic., SubResGcd in SparseUnivariatePolynomial is miscompiled
 --mergeModemap(entry:=((mc,:sig),:.),modemapList,e) ==
 --    for (mmtail:= (((mc',:sig'),:.),:.)) in tails modemapList do
---       mc=mc' or isSuperDomain(mc',mc,e)  =>
+--       mc=mc' or isSubset(mc,mc',e)  =>
 --         RPLACD(mmtail,(first mmtail,: rest mmtail))
 --         RPLACA(mmtail,entry)
 --         entry := nil
 --         return modemapList
 --     if entry then (:modemapList,entry) else modemapList
  
-isSuperDomain(domainForm,domainForm',e) ==
-  isSubset(domainForm',domainForm,e) => true
-  --regard $ as a subdomain of Rep, only if using old style Rep
-  domainForm='Rep and domainForm'="$" => $useRepresentationHack
-  LASSOC(opOf domainForm',get(domainForm,"SubDomain",e))
- 
 --substituteForRep(entry is [[mc,:sig],:.],curModemapList) ==
 --  --change 'Rep to "$" unless the resulting signature is already in $
 --  member(entry':= substitute("$",'Rep,entry),curModemapList) =>
@@ -232,14 +226,13 @@ isSuperDomain(domainForm,domainForm',e) ==
  
 addNewDomain(domain,e) ==
   augModemapsFromDomain(domain,domain,e)
- 
+
 augModemapsFromDomain(name,functorForm,e) ==
   member(KAR name or name,$DummyFunctorNames) => e
   name=$Category or isCategoryForm(name,e) => e
   member(name,curDomainsInScope:= getDomainsInScope e) => e
-  if u:= getSuperDomainFromDB opOf functorForm then
-    e:= addNewDomain(first u,e)
-    --need code to handle parameterized SuperDomains
+  if super := superType functorForm then
+    e := addNewDomain(super,e)
   if innerDom:= listOrVectorElementMode name then e:= addDomain(innerDom,e)
   if name is ["Union",:dl] then for d in stripUnionTags dl
                          repeat e:= addDomain(d,e)
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index dcb5ecbe..49713af5 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -784,7 +784,7 @@ NRTputInHead bod ==
 NRTputInTail x ==
   for y in tails x repeat
     atom (u := first y) =>
-      EQ(u,'$) or LASSOC(u,$devaluateList) => nil
+      u='$ or LASSOC(u,$devaluateList) => nil
       k:= NRTassocIndex u =>
         atom u => RPLACA(y,[$elt,'_$,k])
         -- u atomic means that the slot will always contain a vector
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index fa3f742c..5ac53649 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -202,7 +202,7 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) ==
         nil
       slot := domain.loc
       null atom slot =>
-        EQ(QCAR slot,'newGoGet) => someMatch:=true
+        QCAR slot='newGoGet => someMatch:=true
                    --treat as if operation were not there
         --if EQ(QCAR slot,'newGoGet) then
         --  UNWIND_-PROTECT --break infinite recursion
diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot
index d2d5d9a5..944606f1 100644
--- a/src/interp/nrungo.boot
+++ b/src/interp/nrungo.boot
@@ -288,7 +288,7 @@ compareSigEqual(s,t,dollar,domain) ==
   EQUAL(s,t) => true
   ATOM t =>
     u :=
-      EQ(t,'$) => dollar
+      t='$ => dollar
       isSharpVar t =>
         VECP domain => ELT(rest domain.0,POSN1(t,$FormalMapVariableList))
         ELT(rest domain,POSN1(t,$FormalMapVariableList))
@@ -297,7 +297,7 @@ compareSigEqual(s,t,dollar,domain) ==
     s = '$ => compareSigEqual(dollar,u,dollar,domain)
     u => compareSigEqual(s,u,dollar,domain)
     EQUAL(s,u)
-  EQ(s,'$) => compareSigEqual(dollar,t,dollar,domain)
+  s='$ => compareSigEqual(dollar,t,dollar,domain)
   ATOM s => nil
   #s ^= #t => nil
   match := true
diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot
index d3fd3de2..39b52bc8 100644
--- a/src/interp/nrunopt.boot
+++ b/src/interp/nrunopt.boot
@@ -306,7 +306,7 @@ transHasCode x ==
   atom x => x
   op := QCAR x
   MEMQ(op,'(HasCategory HasAttribute)) => x
-  EQ(op,'has) => compHasFormat x
+  op='has => compHasFormat x
   [transHasCode y for y in x]
  
 mungeAddGensyms(u,gal) ==
diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot
index 80bac6d4..7a5ae403 100644
--- a/src/interp/postpar.boot
+++ b/src/interp/postpar.boot
@@ -181,7 +181,7 @@ postAtom: %Atom -> %ParseForm
 postAtom x ==
   x=0 => $Zero
   x=1 => $One
-  EQ(x,'T) => "T$" -- rename T in spad code to T$
+  x='T => "T$" -- rename T in spad code to T$
   IDENTP x and niladicConstructorFromDB x => [x]
   x="," => "%Comma"
   x = "^" => "**"  -- always use `**' internally for exponentiation
diff --git a/src/interp/property.lisp b/src/interp/property.lisp
index ebf97157..62e93bf3 100644
--- a/src/interp/property.lisp
+++ b/src/interp/property.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2008, Gabriel Dos Reis.
+;; Copyright (C) 2007-2009, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -140,23 +140,6 @@
   (|PrimitiveSymbol| . (IDENTP |#1|))
   )) (MAKEPROP (CAR X) '|BasicPredicate| (CDR X)))
 
-(MAKEPROP '|Integer| '|Subsets|
-  '((|PositiveInteger| . (|>| * 0))
-    (|NonNegativeInteger| . (|>=| * 0))
-    (|NegativeInteger| . (|<| * 0))
-    (|NonPositiveInteger| . (|<=| * 0))
-    (|NonZeroInteger| . (^= * 0))
-    (|SingleInteger| . (SMINTP *))
-    ))
-
-(MAKEPROP '|NonNegativeInteger| '|Subsets| '(
-  (|PositiveInteger| . (|>| * 0))
-  ))
-
-(MAKEPROP '|NonPositiveInteger| '|Subsets| '(
-  (|NegativeInteger| . (|<| * 0))
-  ))
-
 (FLAG '(|Union| |Record| |Enumration| |Mapping| |Enumeration|) 'FUNCTOR)
 
 (FLAG '(* + AND OR PROGN) 'NARY)
diff --git a/src/interp/ptrees.boot b/src/interp/ptrees.boot
index 3f867a1d..e8ff9ee6 100644
--- a/src/interp/ptrees.boot
+++ b/src/interp/ptrees.boot
@@ -126,8 +126,8 @@ pfInfApplication(op,left,right)==
        pfWrong(pfDocument ['"infop as argument to infop"],pfListOf [])
    pfCheckInfop right =>
        pfWrong(pfDocument ['"infop as argument to infop"],pfListOf [])
-   EQ(pfIdSymbol op,"and")=> pfAnd (left,right)
-   EQ(pfIdSymbol op, "or")=> pfOr (left,right)
+   pfIdSymbol op = "and" => pfAnd (left,right)
+   pfIdSymbol op = "or" => pfOr (left,right)
    pfApplication(op,pfTuple pfListOf [left,right])
 
 pfCheckInfop form== false
diff --git a/src/interp/scan.boot b/src/interp/scan.boot
index 674fe05e..eff296bf 100644
--- a/src/interp/scan.boot
+++ b/src/interp/scan.boot
@@ -448,7 +448,7 @@ scanPunct()==
                scanKeyTr sss
 
 scanKeyTr w==
-       if EQ(keyword w,"DOT")
+       if keyword w = "DOT"
        then if $floatok
             then scanPossFloat(w)
             else lfkey w
diff --git a/src/interp/serror.boot b/src/interp/serror.boot
index 1b3ead5c..59318cbd 100644
--- a/src/interp/serror.boot
+++ b/src/interp/serror.boot
@@ -61,7 +61,7 @@ syIgnoredFromTo(pos1, pos2) ==
 npTrapForm: %Thing -> %Thing
 npTrapForm(x)==
    a:=pfSourceStok x
-   EQ(a,'NoToken)=>
+   a='NoToken =>
          syGeneralErrorHere()
          THROW("TRAPPOINT","TRAPPED")
    ncSoftError(tokPosn a, 'S2CY0002, [])
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index fc1543e8..e3372db5 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -293,6 +293,10 @@ $TriangleVariableList ==
     t_#31 t_#32 t_#33 t_#34 t_#35 t_#36 t_#37 t_#38 t_#39 t_#40
     t_#41 t_#42 t_#43 t_#44 t_#45 t_#46 t_#47 t_#48 t_#49 t_#50)
 
+
+$AtVariables ==
+  [INTERN strconc('"@",WRITE_-TO_-STRING i) for i in 1..50]
+
 ++ List of basic predicates the system has a built-in optimization
 ++ support for.
 $BasicPredicates ==
@@ -371,18 +375,10 @@ $Integer ==
   '(Integer)
 
 
-++ The NegativeInteger domain constructor form
-$NegativeInteger ==
-  '(NegativeInteger)
-
 ++ The NonNegativeInteger domain constructor form
 $NonNegativeInteger ==
   '(NonNegativeInteger)
 
-++ The NonPositiveInteger domain constructor form
-$NonPositiveInteger ==
-  '(NonPositiveInteger)
-
 ++ The PositiveInteger domain constructor form
 $PositiveInteger ==
   '(PositiveInteger)
@@ -510,8 +506,7 @@ $StringCategory ==
 ++ List of category constructors that do not have entries in the 
 ++ constructor database. So, they are mostly recognized by their names.
 $CategoryNames ==
-  '(Category _
-    CATEGORY _
+  '(CATEGORY _
     RecordCategory _
     Join _
     EnumerationCategory _
diff --git a/src/interp/types.boot b/src/interp/types.boot
index 219b8d18..505fbc30 100644
--- a/src/interp/types.boot
+++ b/src/interp/types.boot
@@ -1,4 +1,4 @@
--- Copyright (C) 2007-2008 Gabriel Dos Reis
+-- Copyright (C) 2007-2009 Gabriel Dos Reis
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -124,7 +124,9 @@ namespace BOOT
 %Maybe a <=> null or a
 
 --% Data structures for the compiler
+%Constructor <=> %Symbol                       -- constructor
 %Form <=> %Number or %Symbol or %String or cons -- input syntax form
+%Instantiation <=> cons(%Constructor,%Form)    -- constructor instance
 %Env <=> %List                                 -- compiling env
 %Mode <=> %Symbol or %String or %List          -- type of forms
 %Code <=> %Form                                -- generated code
diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot
index 65ad705c..54f9f744 100644
--- a/src/interp/wi1.boot
+++ b/src/interp/wi1.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -564,7 +564,7 @@ setqSingle(id,val,m,E) ==
     (trialT and coerce(trialT,m'')) or eval or return nil where
       eval() ==
         T:= comp(val,m'',E) => T
-        not get(id,"mode",E) and m'' ^= (maxm'':=maxSuperType(m'',E)) and
+        not get(id,"mode",E) and m'' ^= (maxm'':=maximalSuperType m'') and
            (T:=comp(val,maxm'',E)) => T
         (T:= comp(val,$EmptyMode,E)) and getmode(T.mode,E) =>
           assignError(val,T.mode,id,m'')
@@ -837,14 +837,11 @@ coerceSubset(T := [x,m,e],m') ==
     m' = (r := get(x,'range,e)) or isSubset(r,m',e) => [x,r,e]
     nil
 --  pp [m, m']
-  isSubset(m,m',e) or m="Rep" and m'="$" => [x,m',e]
-  m is ['SubDomain,=m',:.] => [x,m',e]
-  (pred:= LASSOC(opOf m',get(opOf m,'SubDomain,e))) and INTEGERP x and
+  isSubset(m,m',e) => [x,m',e]
+  -- if m is a type variable, we can't know.
+  (pred:= isSubset(m',m,e)) and INTEGERP x and
      -- obviously this is temporary
     eval substitute(x,"#1",pred) => [x,m',e]
-  (pred:= isSubset(m',maxSuperType(m,e),e)) and INTEGERP x -- again temporary
-    and eval substitute(x,"*",pred) =>
-      [x,m',e]
   nil
 
 coerceRep(T,m) ==
@@ -925,7 +922,7 @@ compCoerce1(x,m',e) ==
   T':= coerceByModemap(T,m') => T'
   pred:=isSubset(m',T.mode,e) =>
     gg:=GENSYM()
-    pred:= substitute(gg,"*",pred)
+    pred:= substitute(gg,"#1",pred)
     code:= ['PROG1,["%LET",gg,T.expr], ['check_-subtype,pred,MKQ m',gg]]
     [code,m',T.env]
 
diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot
index 613a2ebf..a7c951ca 100644
--- a/src/interp/wi2.boot
+++ b/src/interp/wi2.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -905,7 +905,7 @@ smallIntegerStep(it,index,start,inc,optFinal,e) ==
     -----> assume that optFinal is $SmallInteger
     T := comp(final,$EmptyMode,inc'.env) or return nil
     final' := T
-    maxSuperType(T.mode,e) ^= $Integer => return nil
+    maximalSuperType T.mode ^= $Integer => return nil
     givenRange := T.mode
   indexmode:= $SmallInteger
   [.,.,e]:= compMakeDeclaration([":",index,indexmode],$EmptyMode,