aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/buildom.boot2
-rw-r--r--src/interp/category.boot4
-rw-r--r--src/interp/clammed.boot2
-rw-r--r--src/interp/g-cndata.boot2
-rw-r--r--src/interp/i-analy.boot17
-rw-r--r--src/interp/i-coerce.boot12
-rw-r--r--src/interp/i-funsel.boot3
-rw-r--r--src/interp/i-output.boot2
-rw-r--r--src/interp/i-spec1.boot3
-rw-r--r--src/interp/i-spec2.boot18
-rw-r--r--src/interp/parse.boot4
-rw-r--r--src/interp/sys-constants.boot11
-rw-r--r--src/interp/trace.boot2
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-08 00:12:50 +0000