aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2010-06-03 19:30:55 +0000
committerdos-reis <gdr@axiomatics.org>2010-06-03 19:30:55 +0000
commitb043245231dca601a9a11ae6ddf4e89cc97c3d6c (patch)
tree181018fb7d75ccc6a75371183d427d2de2a51b9e /src/interp
parent745f748d953fa9121b383b02a74970d4baa3473a (diff)
downloadopen-axiom-b043245231dca601a9a11ae6ddf4e89cc97c3d6c.tar.gz
* interp/buildom.boot: Cleanup.
* interp/c-util.boot ($SetCategory): New constant. * interp/compiler.boot: Use it. * interp/functor.boot: Likewise.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/buildom.boot34
-rw-r--r--src/interp/c-util.boot4
-rw-r--r--src/interp/compiler.boot2
-rw-r--r--src/interp/functor.boot4
4 files changed, 24 insertions, 20 deletions
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index 1d819628..d9fb9e15 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -53,7 +53,7 @@ $commonCategoryAncestors ==
++ Default category packages for Record, Union, Mapping and
++ Enumeration domains.
$commonCategoryDefaults ==
- ['(SetCategory_& $), '(BasicType_& $), NIL]
+ ['(SetCategory_& $), '(BasicType_& $), nil]
++ The slot number in a domain shell that holds the first parameter to
++ a domain constructor.
@@ -92,8 +92,8 @@ Record(:args) ==
["~=",[[$Boolean,"$","$"],:0]],
["hash",[[$SingleInteger,"$"],:0]],
["coerce",[[$OutputForm,"$"],:oldSlotCode(nargs + 1)]]]]
- dom.2 := NIL
- dom.3 := ["RecordCategory",:QCDR dom.0]
+ dom.2 := nil
+ dom.3 := ["RecordCategory",:rest dom.0]
dom.4 := [$commonCategoryDefaults, $commonCategoryAncestors]
dom.5 := nil
for i in $FirstParamSlot.. for a in args repeat dom.i := third a
@@ -102,7 +102,7 @@ Record(:args) ==
dom.($FirstParamSlot + nargs + 2) := [function Undef, :dom]
-- following is cache for equality functions
dom.($FirstParamSlot + nargs + 3) := if nargs <= 2
- then [NIL,:NIL]
+ then [nil,:nil]
else newShell nargs
-- remember this instantiation for future re-use.
haddProp($ConstructorCache,"Record",srcArgs,[1,:dom])
@@ -167,8 +167,8 @@ Union(:args) ==
["~=",[[$Boolean,"$","$"],:0]],
["hash", [[$SingleInteger,"$"],:0]],
["coerce",[[$OutputForm,"$"],:oldSlotCode (nargs+1)]]]]
- dom.2 := NIL
- dom.3 := ["UnionCategory",:QCDR dom.0]
+ dom.2 := nil
+ dom.3 := ["UnionCategory",:rest dom.0]
dom.4 := [$commonCategoryDefaults, $commonCategoryAncestors]
dom.5 := nil
for i in $FirstParamSlot.. for a in args repeat dom.i := a
@@ -223,8 +223,8 @@ Mapping(:args) ==
["~=",[[$Boolean,"$","$"],:0]],
["hash", [[$SingleInteger,"$"],:0]],
["coerce",[[$OutputForm,"$"],:oldSlotCode(nargs + 1)]]]]
- dom.2 := NIL
- dom.3 := '(SetCategory)
+ dom.2 := nil
+ dom.3 := $SetCategory
dom.4 := [$commonCategoryDefaults, $commonCategoryAncestors]
dom.5 := nil
for i in $FirstParamSlot.. for a in args repeat dom.i := a
@@ -261,8 +261,8 @@ Enumeration(:"args") ==
["coerce",[[$OutputForm,"$"],:oldSlotCode(nargs+1)],
[["$", $Symbol], :oldSlotCode(nargs+2)]]
]]
- dom.2 := NIL
- dom.3 := ["EnumerationCategory",:QCDR dom.0]
+ dom.2 := nil
+ dom.3 := ["EnumerationCategory",:rest dom.0]
dom.4 := [$commonCategoryDefaults, $commonCategoryAncestors]
dom.5 := nil
for i in $FirstParamSlot.. for a in args repeat dom.i := a
@@ -300,7 +300,7 @@ constructorCategory (title is [op,:.]) ==
[funlist,.]:= FUNCALL(constructorFunction,"$",title,$CategoryFrame)
oplist:= [[[a,b],true,c] for [a,b,c] in funlist]
cat:=
- JoinInner([eval ["SetCategory"],mkCategory("domain",oplist,nil,nil,nil)],
+ JoinInner([eval $SetCategory,mkCategory("domain",oplist,nil,nil,nil)],
$EmptyEnvironment)
cat.(0):= title
cat
@@ -346,7 +346,7 @@ mkNewUnionFunList(name,form is ["Union",:listOfEntries],e) ==
["hash",[$SingleInteger,name],["ELT",dc,0]],
["coerce",[$OutputForm,name],["ELT",dc,$FirstParamSlot+nargs+1]],:
("append"/
- [[["construct",[name,type],["XLAM",["#1"],["CONS",i,"#1"]]],
+ [[["construct",[name,type],["XLAM",["#1"],["%makepair",i,"#1"]]],
["elt",[type,name,tag],cdownFun],
["case",[$Boolean,name,tag],
["XLAM",["#1"],["QEQCAR","#1",i]]]]
@@ -354,9 +354,9 @@ mkNewUnionFunList(name,form is ["Union",:listOfEntries],e) ==
cdownFun() ==
gg:=gensym()
$InteractiveMode =>
- ["XLAM",["#1"],["PROG1",["QCDR","#1"],
+ ["XLAM",["#1"],["PROG1",["%tail","#1"],
["check-union",["QEQCAR","#1",i],type,"#1"]]]
- ["XLAM",["#1"],["PROG2",["%LET",gg,"#1"],["QCDR",gg],
+ ["XLAM",["#1"],["PROG2",["%LET",gg,"#1"],["%tail",gg],
["check-union",["QEQCAR",gg,i],type,gg]]]
[cList,e]
@@ -390,12 +390,12 @@ mkUnionFunList(op,form is ["Union",:listOfEntries],e) ==
["case",[$Boolean,g,t],typeFun]]
for p in predList for t in listOfEntries])] where
upFun() ==
- p is ["EQCAR",x,n] => ["XLAM",["#1"],["CONS",n,"#1"]]
+ p is ["EQCAR",x,n] => ["XLAM",["#1"],["%makepair",n,"#1"]]
["XLAM",["#1"],"#1"]
cdownFun() ==
gg:=gensym()
if p is ["EQCAR",x,n] then
- ref:=["QCDR",gg]
+ ref:=["%tail",gg]
q:= ["QEQCAR", gg, n]
else
ref:=gg
@@ -404,7 +404,7 @@ mkUnionFunList(op,form is ["Union",:listOfEntries],e) ==
["check-union",q,t,gg]]]
downFun() ==
p is ["EQCAR",x,.] =>
- ["XLAM",["#1"],["QCDR","#1"]]
+ ["XLAM",["#1"],["%tail","#1"]]
["XLAM",["#1"],"#1"]
typeFun() ==
p is ["EQCAR",x,n] =>
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 3304a391..1e0f57ff 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -48,6 +48,10 @@ module c_-util where
getInverseEnvironment: (%Form,%Env) -> %Env
+--%
+$SetCategory ==
+ '(SetCategory)
+
--%
++ Token to indicate that a function body should be ignored.
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 0fd20551..c6410bb7 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1849,7 +1849,7 @@ compCat(form is [functorName,:argl],m,e) ==
diagnoseUnknownType(form,e)
[funList,e]:= FUNCALL(fn,form,form,e)
catForm:=
- ["Join",'(SetCategory),["CATEGORY","domain",:
+ ["Join",$SetCategory,["CATEGORY","domain",:
[["SIGNATURE",op,sig] for [op,sig,.] in funList | op~="="]]]
--RDJ: for coercion purposes, it necessary to know it's a Set; I'm not
--sure if it uses any of the other signatures(see extendsCategoryForm)
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index f49dce21..b18b7ce6 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -197,10 +197,10 @@ compCategories u ==
error ['"compCategories: need an atom in operator position", first u]
first u = "Record" =>
-- There is no modemap property for these guys so do it by hand.
- [first u, :[[":", a.1, compCategories1(a.2,'(SetCategory))] for a in rest u]]
+ [first u, :[[":", a.1, compCategories1(a.2,$SetCategory)] for a in rest u]]
first u = "Union" or first u = "Mapping" =>
-- There is no modemap property for these guys so do it by hand.
- [first u, :[compCategories1(a,'(SetCategory)) for a in rest u]]
+ [first u, :[compCategories1(a,$SetCategory) for a in rest u]]
u is ['SubDomain,D,.] => compCategories D
v:=get(first u,'modemap,$e)
atom v =>