* interp/compiler.boot (getSuccessEnvironment): Don't specialize

	on `has'.
	(getInverseEnvironment): Likewise.
	* algebra/equation2.spad.pamphlet (factorAndSplit$Equation): Fix
	misuses of `has'.
	* interp/functor.boot (mkTypeForm): Rename from mkDomainConstructor.

5 files changed, 26 insertions, 31 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index daccd105..0acd88b9 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,14 @@
 2009-01-10  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/compiler.boot (getSuccessEnvironment): Don't specialize
+	on `has'.
+	(getInverseEnvironment): Likewise.
+	* algebra/equation2.spad.pamphlet (factorAndSplit$Equation): Fix
+	misuses of `has'.
+	* interp/functor.boot (mkTypeForm): Rename from mkDomainConstructor.
+
+2009-01-10  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	Fix SF/2491986
 	* interp/i-syscmd.boot (displayValue): Fix thinko.
 	* testsuite/interpreter/sf-2491986.input (a): New.
diff --git a/src/algebra/equation2.spad.pamphlet b/src/algebra/equation2.spad.pamphlet
index 169df9ed..e0d3bd30 100644
--- a/src/algebra/equation2.spad.pamphlet
+++ b/src/algebra/equation2.spad.pamphlet
@@ -213,7 +213,7 @@ Equation(S: Type): public == private where
           (S has factor : S -> Factored S) =>
             eq0 := rightZero eq
             [equation(rcf.factor,0) for rcf in factors factor lhs eq0]
-          (S has Polynomial Integer) =>
+          (S is Polynomial Integer) =>
             eq0 := rightZero eq
             MF ==> MultivariateFactorize(Symbol, IndexedExponents Symbol, _
                Integer, Polynomial Integer)
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 72baf917..6cf3cc84 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1138,9 +1138,9 @@ compHasFormat (pred is ["has",olda,b]) ==
   b is ["ATTRIBUTE",c] => ["HasAttribute",a,["QUOTE",c]]
   b is ["SIGNATURE",op,sig] =>
      ["HasSignature",a,
-       mkList [MKQ op,mkList [mkDomainConstructor type for type in sig]]]
-  isDomainForm(b,$EmptyEnvironment) => ["EQUAL",a,b]
-  ["HasCategory",a,mkDomainConstructor b]
+       mkList [MKQ op,mkList [mkTypeForm type for type in sig]]]
+  isCategoryForm(b,$e) => ["HasCategory",a,mkTypeForm b]
+  stackAndThrow('"Second argument to %1b must be a category, or a signature or an attribute",["has"])
 
 --% IF
 
@@ -1215,12 +1215,6 @@ compPredicate(p,E) ==
   [p',m,getSuccessEnvironment(p,E),getInverseEnvironment(p,E)]
 
 getSuccessEnvironment(a,e) ==
-
-  -- the next four lines try to ensure that explicit special-case tests
-  --  prevent implicit ones from being generated
-  a is ["has",x,m] =>
-    IDENTP x and isDomainForm(m,$EmptyEnvironment) => put(x,"specialCase",m,e)
-    e
   a is ["is",id,m] =>
     IDENTP id and isDomainForm(m,$EmptyEnvironment) =>
          e:=put(id,"specialCase",m,e)
@@ -1234,14 +1228,6 @@ getSuccessEnvironment(a,e) ==
   e
 
 getInverseEnvironment(a,E) ==
-  atom a => E
-  [op,:argl]:= a
--- the next five lines try to ensure that explicit special-case tests
--- prevent implicit ones from being generated
-  op="has" =>
-    [x,m]:= argl
-    IDENTP x and isDomainForm(m,$EmptyEnvironment) => put(x,"specialCase",m,E)
-    E
   a is ["case",x,m] and IDENTP x =>
            --the next two lines are necessary to get 3-branched Unions to work
            -- old-style unions, that is
diff --git a/src/interp/define.boot b/src/interp/define.boot
index e3dc8934..a4c31697 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -870,7 +870,7 @@ genDomainView(viewName,originalName,c,viewSelector) ==
     c is ['SubsetCategory,c',.] => c'
     c
   $e:= augModemapsFromCategory(originalName,viewName,nil,c,$e)
-  cd:= ["%LET",viewName,[viewSelector,originalName,mkDomainConstructor code]]
+  cd:= ["%LET",viewName,[viewSelector,originalName,mkTypeForm code]]
   if null member(cd,$getDomainCode) then
           $getDomainCode:= [cd,:$getDomainCode]
   viewName
@@ -881,7 +881,7 @@ genDomainOps(viewName,dom,cat) ==
   oplist:= substNames(dom,viewName,dom,oplist)
   cd:=
     ["%LET",viewName,['mkOpVec,dom,['LIST,:
-      [['LIST,MKQ op,['LIST,:[mkDomainConstructor mode for mode in sig]]]
+      [['LIST,MKQ op,['LIST,:[mkTypeForm mode for mode in sig]]]
         for [op,sig] in siglist]]]]
   $getDomainCode:= [cd,:$getDomainCode]
   for [opsig,cond,:.] in oplist for i in 0.. repeat
@@ -1417,7 +1417,7 @@ uncons x ==
 bootStrapError(functorForm,sourceFile) ==
   ['COND, _
     ['$bootStrapMode, _
-        ['VECTOR,mkDomainConstructor functorForm,nil,nil,nil,nil,nil]],
+        ['VECTOR,mkTypeForm functorForm,nil,nil,nil,nil,nil]],
     [''T, ['systemError,['LIST,''%b,MKQ CAR functorForm,''%d,'"from", _
       ''%b,MKQ namestring sourceFile,''%d,'"needs to be compiled"]]]]
 
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 5d2409f5..f2cab9ca 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.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
@@ -311,10 +311,10 @@ cons5(p,l) ==
 setVector0(catNames,definition) ==
           --returns code to set element 0 of the vector
           --to the definition of the category
-  definition:= mkDomainConstructor definition
+  definition:= mkTypeForm definition
 -- If we call addMutableArg this early, then recurise calls to this domain
 -- (e.g. while testing predicates) will generate new domains => trouble
---definition:= addMutableArg mkDomainConstructor definition
+--definition:= addMutableArg mkTypeForm definition
   for u in catNames repeat
     definition:= ["setShellEntry",u,0,definition]
   definition
@@ -387,7 +387,7 @@ setVector3(name,instantiator) ==
       --element 3 is data structure representing category
       --returns a single LISP statement
   instantiator is ['DomainSubstitutionMacro,.,body] => setVector3(name,body)
-  ["setShellEntry",name,3,mkDomainConstructor instantiator]
+  ["setShellEntry",name,3,mkTypeForm instantiator]
  
 mkDomainFormer x ==
   if x is ['DomainSubstitutionMacro,parms,body] then
@@ -398,23 +398,23 @@ mkDomainFormer x ==
   x is ['Join,:.] => ['eval,['QUOTE,x]]
   x
  
-mkDomainConstructor x ==
+mkTypeForm x ==
   atom x => mkDevaluate x
   x is ['Join] => nil
   x is ['LIST] => nil
   x is ['CATEGORY,:.] => MKQ x
   x is ['mkCategory,:.] => MKQ x
   x is ['_:,selector,dom] =>
-    ['LIST,MKQ '_:,MKQ selector,mkDomainConstructor dom]
+    ['LIST,MKQ '_:,MKQ selector,mkTypeForm dom]
   x is ['Record,:argl] =>
-    ['LIST,MKQ 'Record,:[mkDomainConstructor y for y in argl]]
+    ['LIST,MKQ 'Record,:[mkTypeForm y for y in argl]]
   x is ['Join,:argl] =>
-    ['LIST,MKQ 'Join,:[mkDomainConstructor y for y in argl]]
+    ['LIST,MKQ 'Join,:[mkTypeForm y for y in argl]]
   x is ['call,:argl] => ['MKQ, optCall x]
         --The previous line added JHD/BMT 20/3/84
         --Necessary for proper compilation of DPOLY SPAD
   x is [op] => MKQ x
-  x is [op,:argl] => ['LIST,MKQ op,:[mkDomainConstructor a for a in argl]]
+  x is [op,:argl] => ['LIST,MKQ op,:[mkTypeForm a for a in argl]]
  
 setVector4(catNames,catsig,conditions) ==
   if $HackSlot4 then
@@ -437,7 +437,7 @@ setVector4Onecat(name,instantiator,info) ==
   data:=
        --CAR name.4 contains all the names except itself
        --hence we need to add this on, by the above CONS
-    ['CONS,['CONS,mkDomainConstructor instantiator,['CAR,['ELT,name,4]]],
+    ['CONS,['CONS,mkTypeForm instantiator,['CAR,['ELT,name,4]]],
       name]
   data:= ['SETQ,'TrueDomain,['CONS,data,'TrueDomain]]
   TruthP info => data