From 9fbb89443e0c88ee5e76d95a3eea2ac5ea9916b6 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Tue, 19 Feb 2008 00:35:15 +0000
Subject: 	* 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.

---
 src/interp/i-spec2.boot | 18 +++++-------------
 1 file changed, 5 insertions(+), 13 deletions(-)

(limited to 'src/interp/i-spec2.boot')

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 ==
-- 
cgit v1.2.3