diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 7 | ||||
| -rw-r--r-- | src/interp/buildom.boot | 34 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 4 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 2 | ||||
| -rw-r--r-- | src/interp/functor.boot | 4 |
5 files changed, 31 insertions, 20 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index c4ed009e..81094634 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2010-06-03 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/buildom.boot: Cleanup. + * interp/c-util.boot ($SetCategory): New constant. + * interp/compiler.boot: Use it. + * interp/functor.boot: Likewise. + 2010-06-02 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/c-util.boot (usedSymbol?): New. 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 => |