* algebra/variable.spad.pamphlet (AnonymousFunction): Add new

	functions `parameters' and `body'.
	* algebra/domain.spad.pamphlet: Rename from algebra/domain.spad.
	(Category): New category.
	* algebra/Makefile.pamphlet (axiom_algebra_layer_0): Include
	CATEGORY.o. 
	(DOMAIN.NRLIB/code.$(FASLEXT)): Remove rule.
	* interp/trace.boot (transTraceItem): Use $LangSupportTypes.
	* interp/sys-constants.boot ($None): New.
	($Type): Likewise.
	($LangSupportTypes): Likewise.
	* interp/parse.boot (parseHas): Use $LangSupportTypes.
	(parseHasRhs): Likewise.
	* interp/i-spec2.boot (upLETtype): Use conceptualType.
	(uptypeOf): Likewise.
	(upwhere): Likewise.
	(typeOfType): Remove.
	* interp/i-spec1.boot (isDomainValuedVariable): Variables with
	type Category and Type are domain valued too.
	* interp/i-output.boot (output): Special case only Mode and Type.
	* interp/i-funsel.boot (selectMms): Don't ignore modemaps with
	category parameters.
	* interp/i-coerce.boot (canCoerce1): Test for Category instead of
	SubDomain Domain.
	(canCoerceFrom0): Use $None and $Any.
	(absolutelyCannotCoerce): Use $None.
	(coerceInteractive): Use $LangSupportTypes.
	(coerceInt1): Use $Any.
	* interp/i-analy.boot (conceptualType): New.
	(bottomUpType): Use it.
	* interp/clammed.boot (isValidType): Use $LangSupportTypes.
	* interp/g-cndata.boot (isNameOfType): Likewise.
	* interp/category.boot (Category): Remove hacky definition.
	* interp/buildom.boot ($noCategoryDomains): Domain now has a
	Lisplib. 

13 files changed, 48 insertions, 34 deletions

diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index cacced1b..5ec40d08 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -40,7 +40,7 @@
 import '"sys-macros"
 )package "BOOT"
 
-$noCategoryDomains == '(Domain Mode SubDomain)
+$noCategoryDomains == '(Mode SubDomain)
 $nonLisplibDomains == APPEND($Primitives,$noCategoryDomains)
 
 ++ Category ancestors for Record, Union, Mapping, and Enumeration domains.
diff --git a/src/interp/category.boot b/src/interp/category.boot
index 304b943f..5ba5fb2a 100644
--- a/src/interp/category.boot
+++ b/src/interp/category.boot
@@ -1,5 +1,7 @@
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
+-- Copyright (C) 2007-2008, 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
@@ -35,8 +37,6 @@ import '"g-util"
  
 -- Functions for building categories
  
-Category() == nil --sorry to say, this hack is needed by isCategoryType
- 
 CategoryPrint(D,$e) ==
   SAY "--------------------------------------"
   SAY "Name (and arguments) of category:"
diff --git a/src/interp/clammed.boot b/src/interp/clammed.boot
index f46f653f..6f874dbe 100644
--- a/src/interp/clammed.boot
+++ b/src/interp/clammed.boot
@@ -77,7 +77,7 @@ isValidType form ==
   -- are not valid.
   STRINGP form => true
   IDENTP  form => false
-  form in '((Mode) (Domain) (SubDomain (Domain))) => true
+  form in $LangSupportTypes => true
   form is ['Record,:selectors] =>
     and/[isValidType type for [:.,type] in selectors]
   form is ['Enumeration,:args] =>
diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot
index d6a4ce66..2b1a05c3 100644
--- a/src/interp/g-cndata.boot
+++ b/src/interp/g-cndata.boot
@@ -172,7 +172,7 @@ isNameOfType x ==
   $doNotAddEmptyModeIfTrue:local:= true
   (val := get(x,'value,$InteractiveFrame)) and
     (domain := objMode val) and
-      domain in '((Mode) (Domain) (SubDomain (Domain))) => true
+      domain in $LangSupportTypes => true
   y := opOf unabbrev x
   constructor? y
  
diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot
index f984ac11..fc3d621f 100644
--- a/src/interp/i-analy.boot
+++ b/src/interp/i-analy.boot
@@ -615,11 +615,20 @@ sayIntelligentMessageAboutOpAvailability(opName, nArgs) ==
     sayKeyedMsg("S2IB0008f", [opName, nArgs, nAllExposedMmsWithNameAndArgs, nAllMmsWithNameAndArgs - nAllExposedMmsWithNameAndArgs])
   nil
 
+
+++ Returns the `conceptual' type of `type', e.g., the type type in
+++ the abstract semantics, not necessarily the one from implementation
+++ point of view.
+conceptualType: %Thing -> %List
+conceptualType type ==
+  isPartialMode type => $Mode
+  type in $LangSupportTypes => $Type
+  categoryForm?(type) => $Category
+  $Domain
+
+
 bottomUpType(t, type) ==
-  mode :=
-    if isPartialMode type then '(Mode)
-    else if categoryForm?(type) then '(SubDomain (Domain))
-         else '(Domain)
+  mode := conceptualType type
   val:= objNew(type,mode)
   putValue(t,val)
   -- have to fix the following
diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot
index dbb97309..273dcb15 100644
--- a/src/interp/i-coerce.boot
+++ b/src/interp/i-coerce.boot
@@ -415,8 +415,8 @@ canCoerce1(t1,t2) ==
   -- general test for coercion
   -- the result is NIL if it fails
   t1 = t2 => true
-  absolutelyCanCoerceByCheating(t1,t2) or t1 = '(None) or t2 = '(Any) or
-    t1 in '((Mode)  (Domain) (SubDomain (Domain))) =>
+  absolutelyCanCoerceByCheating(t1,t2) or t1 = $None or t2 = $Any or
+    t1 in '((Mode) (Category)) =>
       t2 = $OutputForm => true
       NIL
     -- next is for tagged union selectors for the time being
@@ -468,7 +468,7 @@ canCoerceFrom0(t1,t2) ==
 -- equivalent types
   startTimingProcess 'querycoerce
   q :=
-    isEqualOrSubDomain(t1,t2) or t1 = '(None) or t2 = '(Any) or
+    isEqualOrSubDomain(t1,t2) or t1 = $None or t2 = $Any or
       if t2 = $OutputForm then (s1 := t1; s2 := t2)
       else (s1:= equiType(t1); s2:= equiType(t2))
 
@@ -691,7 +691,7 @@ absolutelyCannotCoerce(t1,t2) ==
   -- response of true means "definitely cannot coerce"
   -- this is largely an efficiency hack
   ATOM(t1) or ATOM(t2) => NIL
-  t2 = '(None) => true
+  t2 = $None => true
   n1   := CAR t1
   n2   := CAR t2
   QFI  := [$QuotientField, $Integer]
@@ -751,7 +751,7 @@ coerceInteractive(triple,t2) ==
   t2 = '$NoValueMode => objNew(val,t2)
   if t2 is ['SubDomain,x,.] then t2:= x
   -- JHD added category Aug 1996 for BasicMath
-  t1 in '((Category) (Mode) (Domain) (SubDomain (Domain))) =>
+  t1 in $LangSupportTypes =>
     t2 = $OutputForm => objNew(val,t2)
     NIL
   t1 = '$NoValueMode =>
@@ -832,7 +832,7 @@ coerceInt1(triple,t2) ==
     NIL
 
   t2 = $Void => objNew(voidValue(),$Void)
-  t2 = $Any => objNewWrap([t1,:unwrap val],'(Any))
+  t2 = $Any => objNewWrap([t1,:unwrap val],$Any)
 
   t1 = $Any and t2 ^= $OutputForm and ([t1',:val'] := unwrap val) and
     (ans := coerceInt(objNewWrap(val',t1'),t2)) => ans
diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot
index 378ce268..e037061a 100644
--- a/src/interp/i-funsel.boot
+++ b/src/interp/i-funsel.boot
@@ -1,5 +1,7 @@
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
+-- Copyright (C) 2007-2008, 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
@@ -89,7 +91,6 @@ selectMms(op,args,$declaredMode) ==
 
   types1 := getOpArgTypes(n,args)
   numArgs := #args
-  member('(SubDomain (Domain)),types1) => NIL
   member($EmptyMode,types1) => NIL
 
   tar := getTarget op
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index 52073696..ce11e725 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -1383,7 +1383,7 @@ output(expr,domain) ==
     if $formulaFormat then formulaFormat expr
     if $texFormat     then texFormat expr
     if $algebraFormat then mathprintWithNumber expr
-  categoryForm? domain or domain in '((Mode) (Domain) (SubDomain (Domain))) =>
+  categoryForm? domain or domain in '((Mode) (Type)) =>
     if $algebraFormat then
       mathprintWithNumber outputDomainConstructor expr
     if $texFormat     then
diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot
index 00e391bb..2cbd7722 100644
--- a/src/interp/i-spec1.boot
+++ b/src/interp/i-spec1.boot
@@ -1212,7 +1212,8 @@ isDomainValuedVariable form ==
     get(form,'value,$InteractiveFrame) or _
     (PAIRP($env) and get(form,'value,$env)) or _
     (PAIRP($e) and get(form,'value,$e)))) and
-      objMode(val) in '((Domain) (SubDomain (Domain))) =>
+      objMode(val) in '((Domain) (Category) (Type)) =>
+        -- ??? shall we accept all of $LangSupportTypes?
         objValUnwrap(val)
   nil
 
diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot
index b8dfdf42..54603e03 100644
--- a/src/interp/i-spec2.boot
+++ b/src/interp/i-spec2.boot
@@ -1,5 +1,7 @@
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
+-- Copyright (C) 2007-2008, 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
@@ -738,10 +740,7 @@ upLETtype(op,lhs,type) ==
   opName:= getUnname lhs
   (not $genValue) and "or"/[CONTAINED(var,type) for var in $localVars] =>
     compFailure ['"   Cannot compile type assignment to",:bright opName]
-  mode :=
-    if isPartialMode type then '(Mode)
-    else if categoryForm?(type) then '(SubDomain (Domain))
-         else '(Domain)
+  mode := conceptualType type
   val:= objNew(type,mode)
   if isLocalVar(opName) then put(opName,'value,val,$env)
   else putHist(opName,'value,val,$e)
@@ -1098,19 +1097,12 @@ uptypeOf form ==
   form isnt [op, arg] => NIL
   if VECP arg then transferPropsToNode(getUnname arg,arg)
   if m := isType(arg) then
-    m :=
-      categoryForm?(m) => '(SubDomain (Domain))
-      isPartialMode m  => '(Mode)
-      '(Domain)
+    m := conceptualType m
   else if not (m := getMode arg) then [m] := bottomUp arg
-  t := typeOfType m
+  t := conceptualType m        -- ??? shall we reveal more impl. details?
   putValue(op, objNew(m,t))
   putModeSet(op,[t])
 
-typeOfType type ==
-  type in '((Mode) (Domain)) => '(SubDomain (Domain))
-  '(Domain)
-
 --% Handler for where
 
 upwhere t ==
diff --git a/src/interp/parse.boot b/src/interp/parse.boot
index 52d29596..49aee33f 100644
--- a/src/interp/parse.boot
+++ b/src/interp/parse.boot
@@ -234,7 +234,7 @@ parseHas [x,y] ==
   if $InteractiveMode then
     x:=
       get(x,'value,$CategoryFrame) is [D,m,.]
-        and m in '((Mode) (Domain) (SubDomain (Domain))) => D
+        and m in $LangSupportTypes => D
       parseType x
   mkand [["has",x,u] for u in fn y] where
     mkand x ==
@@ -256,7 +256,7 @@ parseHas [x,y] ==
  
 parseHasRhs u ==   --$InteractiveMode = true
   get(u,'value,$CategoryFrame) is [D,m,.]
-    and m in '((Mode) (Domain) (SubDomain (Domain))) => m
+    and m in $LangSupportTypes => m
   y := abbreviation? u =>
     loadIfNecessary y => [unabbrevAndLoad y]
     [["ATTRIBUTE",u]]
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index 5a9196ec..a644e2b6 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -291,6 +291,10 @@ $Void ==
 $Any ==
   '(Any)
 
+++ The None domain constructor form.
+$None ==
+  '(None)
+
 ++ The Syntax domain constructor form
 $Syntax ==
   '(Syntax)
@@ -417,6 +421,10 @@ $Primitives ==
 $Category ==
   '(Category)
 
+++ The Type category constructor form.
+$Type ==
+  '(Type)
+
 ++ Domain constructor form
 ++ FIXME: Find where this is used in the system.
 $Domain ==
@@ -463,6 +471,9 @@ $DomainNames ==
     Vector _
     Enumeration)
 
+++ List of language support constructor forms.
+$LangSupportTypes ==
+  '((Mode) (Domain) (Type) (Category))
 
 ++
 $NonMentionableDomainNames ==
diff --git a/src/interp/trace.boot b/src/interp/trace.boot
index 6289d4ef..e6ee0e90 100644
--- a/src/interp/trace.boot
+++ b/src/interp/trace.boot
@@ -299,7 +299,7 @@ transTraceItem x ==
   $doNotAddEmptyModeIfTrue: local:=true
   atom x =>
     (value:=get(x,"value",$InteractiveFrame)) and
-      (objMode value in '((Mode) (Domain) (SubDomain (Domain)))) =>
+      (objMode value in $LangSupportTypes) =>
         x := objVal value
         (y:= domainToGenvar x) => y
         x