From af51c280292fc412e56c22ec2b416184beecee3d Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sun, 30 Mar 2008 14:33:53 +0000 Subject: Fix SF/1849435. * interp/buildom.boot: Rewrite builtin domains to work with old runtime scheme. * interp/nruncomp.boot (NRTencode): Tidy. * interp/nrungo.boot (basicLookup): lookupInTable is part of the old runtime scheme too. (lookupInDomain): Tidy. (lookupInCategories): Simplify. --- src/interp/buildom.boot | 351 ++++++++++++++++++++++++++--------------------- src/interp/nruncomp.boot | 2 +- src/interp/nrungo.boot | 31 ++--- 3 files changed, 207 insertions(+), 177 deletions(-) (limited to 'src/interp') diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index f1ec268a..a78a281b 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -36,6 +36,9 @@ -- be written in ScratchpadII yet. They are not cached because they -- are very cheap to instantiate. -- SMW and SCM July 86 +-- These have been substantially modified to work with the new +-- runtime system. +-- GDR, March 2008. import '"sys-macros" )package "BOOT" @@ -50,13 +53,19 @@ $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. +$FirstParamSlot == + 6 --% Record -- Want to eventually have the elts and setelts. -- Record is a macro in BUILDOM LISP. It takes out the colons. -isRecord type == type is ["Record",:.] +isRecord type == + type is ["Record",:.] RecordInner args == -- this is old and should be removed wherever it occurs @@ -64,63 +73,76 @@ RecordInner args == sayBrightly '"-->> Whoops! RecordInner called from this code." Record0 VEC2LIST args +++ returns the code for the `n'th item recorded in a domain shell, +++ according to the old runtime system. Note that the old runtime +++ scheme is used only for the handful of constructors created +++ in this file. +oldSlotCode: %Short -> %Short +oldSlotCode n == + 2 * ($FirstParamSlot + n) + Record0 args == - dom := newShell 10 - -- JHD added an extra slot to cache EQUAL methods - dom.0 := ["Record", :[["_:", CAR a, devaluate CDR a] for a in args]] - dom.1 := - [function lookupInTable,dom, - [["_=",[[["Boolean"],"_$","_$"],:12]], - ["coerce",[[$OutputForm,"_$"],:14]]]] - dom.2 := NIL - dom.3 := ["RecordCategory",:QCDR dom.0] - dom.4 := - [$commonCategoryDefaults, $commonCategoryAncestors] - dom.5 := [CDR a for a in args] - dom.6 := [function RecordEqual, :dom] - dom.7 := [function RecordPrint, :dom] - dom.8 := [function Undef, :dom] - -- following is cache for equality functions - dom.9 := if (n:= LENGTH args) <= 2 - then [NIL,:NIL] - else newShell n - dom + nargs := #args + dom := newShell(nargs + 10) + -- JHD added an extra slot to cache EQUAL methods + dom.0 := ["Record", :[[":", first a, devaluate rest a] for a in args]] + dom.1 := + ["lookupInTable",dom, + [["=",[[$Boolean,"$","$"],:oldSlotCode nargs]], + ["~=",[[$Boolean,"$","$"],:0]], + ["coerce",[[$OutputForm,"$"],:oldSlotCode(nargs + 1)]]]] + dom.2 := NIL + dom.3 := ["RecordCategory",:QCDR dom.0] + dom.4 := [$commonCategoryDefaults, $commonCategoryAncestors] + dom.5 := nil + for i in $FirstParamSlot.. for a in args repeat dom.i := rest a + dom.($FirstParamSlot + nargs) := [function RecordEqual, :dom] + dom.($FirstParamSlot + nargs + 1) := [function RecordPrint, :dom] + dom.($FirstParamSlot + nargs + 2) := [function Undef, :dom] +-- following is cache for equality functions + dom.($FirstParamSlot + nargs + 3) := if nargs <= 2 + then [NIL,:NIL] + else newShell nargs + dom RecordEqual(x,y,dom) == + nargs := #rest(dom.0) PAIRP x => b:= - SPADCALL(CAR x, CAR y, CAR(dom.9) or - CAR RPLACA(dom.9,findEqualFun(dom.5.0))) - NULL rest(dom.5) => b + SPADCALL(first x, first y, first(dom.(nargs + 9)) or + first RPLACA(dom.(nargs + 9),findEqualFun(dom.$FirstParamSlot))) + nargs = 1 => b b and - SPADCALL(CDR x, CDR y, CDR (dom.9) or - CDR RPLACD(dom.9,findEqualFun(dom.5.1))) + SPADCALL(rest x, rest y, rest (dom.(nargs + 9)) or + rest RPLACD(dom.(nargs + 9),findEqualFun(dom.($FirstParamSlot+1)))) VECP x => - equalfuns := dom.9 - and/[SPADCALL(x.i,y.i,equalfuns.i or (equalfuns.i:=findEqualFun(fdom))) - for i in 0.. for fdom in dom.5] + equalfuns := dom.(nargs + 9) + and/[SPADCALL(x.i,y.i,equalfuns.i or _ + (equalfuns.i:=findEqualFun(dom.($FirstParamSlot + i))))_ + for i in 0..(nargs - 1)] error '"Bug: Silly record representation" -RecordPrint(x,dom) == coerceRe2E(x,dom.3) +RecordPrint(x,dom) == + coerceRe2E(x,dom.3) coerceVal2E(x,m) == objValUnwrap coerceByFunction(objNewWrap(x,m),$OutputForm) findEqualFun(dom) == - compiledLookup("_=",[$Boolean,"$","$"],dom) + compiledLookup("=",[$Boolean,"$","$"],dom) coerceRe2E(x,source) == - n := # CDR source + n := # rest source n = 1 => ["construct", - ["_=", source.1.1, coerceVal2E(CAR x,source.1.2)] ] + ["=", source.1.1, coerceVal2E(first x,source.1.2)] ] n = 2 => ["construct", - ["_=", source.1.1, coerceVal2E(CAR x,source.1.2)], _ - ["_=", source.2.1, coerceVal2E(CDR x,source.2.2)] ] + ["=", source.1.1, coerceVal2E(first x,source.1.2)], _ + ["=", source.2.1, coerceVal2E(rest x,source.2.2)] ] VECP x => ['construct, - :[["_=",tag,coerceVal2E(x.i, fdom)] + :[["=",tag,coerceVal2E(x.i, fdom)] for i in 0.. for [.,tag,fdom] in rest source]] error '"Bug: ridiculous record representation" @@ -129,22 +151,24 @@ coerceRe2E(x,source) == -- Want to eventually have the coerce to and from branch types. Union(:args) == - dom := newShell 9 - dom.0 := ["Union", :[(if a is ["_:",tag,domval] then ["_:",tag,devaluate domval] - else devaluate a) for a in args]] - dom.1 := - [function lookupInTable,dom, - [["_=",[[["Boolean"],"_$","_$"],:12]], - ["coerce",[[$OutputForm,"_$"],:14]]]] - dom.2 := NIL - dom.3 := ["UnionCategory",:QCDR dom.0] - dom.4 := - [$commonCategoryDefaults, $commonCategoryAncestors] - dom.5 := args - dom.6 := [function UnionEqual, :dom] - dom.7 := [function UnionPrint, :dom] - dom.8 := [function Undef, :dom] - dom + nargs := #args + dom := newShell (nargs + 9) + dom.0 := ["Union", :[(if a is [":",tag,domval] then [":",tag,devaluate domval] + else devaluate a) for a in args]] + dom.1 := + ["lookupInTable",dom, + [["=",[[$Boolean,"$","$"],:oldSlotCode nargs]], + ["~=",[[$Boolean,"$","$"],:0]], + ["coerce",[[$OutputForm,"$"],:oldSlotCode (nargs+1)]]]] + dom.2 := NIL + dom.3 := ["UnionCategory",:QCDR dom.0] + dom.4 := [$commonCategoryDefaults, $commonCategoryAncestors] + dom.5 := nil + for i in $FirstParamSlot.. for a in args repeat dom.i := a + dom.($FirstParamSlot + nargs) := [function UnionEqual, :dom] + dom.($FirstParamSlot + nargs + 1) := [function UnionPrint, :dom] + dom.($FirstParamSlot + nargs + 2) := [function Undef, :dom] + dom UnionEqual(x, y, dom) == ["Union",:branches] := dom.0 @@ -181,58 +205,66 @@ coerceUn2E(x,source) == -- Want to eventually have elt: ($, args) -> target Mapping(:args) == - dom := newShell 9 - dom.0 := ["Mapping", :[devaluate a for a in args]] - dom.1 := - [function lookupInTable,dom, - [["_=",[[["Boolean"],"_$","_$"],:12]], - ["coerce",[[$OutputForm,"_$"],:14]]]] - dom.2 := NIL - dom.3 := - '(SetCategory) - dom.4 := - [$commonCategoryDefaults, $commonCategoryAncestors] - dom.5 := args - dom.6 := [function MappingEqual, :dom] - dom.7 := [function MappingPrint, :dom] - dom.8 := [function Undef, :dom] - dom + nargs := #args + dom := newShell(nargs + 9) + dom.0 := ["Mapping", :[devaluate a for a in args]] + dom.1 := + ["lookupInTable",dom, + [["=",[[$Boolean,"$","$"],:oldSlotCode nargs]], + ["~=",[[$Boolean,"$","$"],:0]], + ["coerce",[[$OutputForm,"$"],:oldSlotCode(nargs + 1)]]]] + 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 + dom.($FirstParamSlot + nargs) := [function MappingEqual, :dom] + dom.($FirstParamSlot + nargs + 1) := [function MappingPrint, :dom] + dom.($FirstParamSlot + nargs + 2) := [function Undef, :dom] + dom MappingEqual(x, y, dom) == EQ(x,y) MappingPrint(x, dom) == coerceMap2E(x) coerceMap2E(x) == -- nrlib domain - ARRAYP CDR x => ["theMap", BPINAME CAR x, - if $testingSystem then 0 else REMAINDER(HASHEQ CDR x, 1000)] + ARRAYP rest x => ["theMap", BPINAME first x, + if $testingSystem then 0 else REMAINDER(HASHEQ rest x, 1000)] -- aldor - ["theMap", BPINAME CAR x ] + ["theMap", BPINAME first x ] --% Enumeration Enumeration(:"args") == - dom := newShell 9 - -- JHD added an extra slot to cache EQUAL methods - dom.0 := ["Enumeration", :args] - dom.1 := - [function lookupInTable,dom, - [["_=",[[["Boolean"],"_$","_$"],:12]], - ["coerce",[[$OutputForm,"_$"],:14], [["_$", $Symbol], :16]] - ]] - dom.2 := NIL - dom.3 := ["EnumerationCategory",:QCDR dom.0] - dom.4 := - [$commonCategoryDefaults, $commonCategoryAncestors] - dom.5 := args - dom.6 := [function EnumEqual, :dom] - dom.7 := [function EnumPrint, :dom] - dom.8 := [function createEnum, :dom] - dom - -EnumEqual(e1,e2,dom) == e1=e2 -EnumPrint(enum, dom) == dom.5.enum + nargs := #nargs + dom := newShell(nargs + 9) + -- JHD added an extra slot to cache EQUAL methods + dom.0 := ["Enumeration", :args] + dom.1 := + ["lookupInTable",dom, + [["=",[[$Boolean,"$","$"],:oldSlotCode nargs]], + ["~=",[[$Boolean,"$","$"],:0]], + ["coerce",[[$OutputForm,"$"],:oldSlotCode(nargs+1)], + [["$", $Symbol], :oldSlotCode(nargs+2)]] + ]] + dom.2 := NIL + dom.3 := ["EnumerationCategory",:QCDR dom.0] + dom.4 := [$commonCategoryDefaults, $commonCategoryAncestors] + dom.5 := nil + for i in $FirstParamSlot.. for a in args repeat dom.i := a + dom.($FirstParamSlot + nargs) := [function EnumEqual, :dom] + dom.($FirstParamSlot + nargs + 1) := [function createEnum, :dom] + dom.($FirstParamSlot + nargs + 2) := [function EnumPrint, :dom] + dom + +EnumEqual(e1,e2,dom) == + e1=e2 + +EnumPrint(enum, dom) == + (rest(dom.0)).enum + createEnum(sym, dom) == - args := dom.5 + args := rest(dom.0) val := -1 for v in args for i in 0.. repeat sym=v => return(val:=i) @@ -260,56 +292,53 @@ constructorCategory (title is [op,:.]) == --mkMappingFunList(nam,mapForm,e) == [[],e] mkMappingFunList(nam,mapForm,e) == + nargs := #rest mapForm dc := GENSYM() sigFunAlist:= - [["_=",[["Boolean"],nam ,nam],["ELT",dc,6]], - ["coerce",[$OutputForm,nam],["ELT",dc,7]]] + [["=",[$Boolean,nam ,nam], ["ELT",dc,$FirstParamSlot + nargs]], + ["~=",[$Boolean,nam,nam],["ELT",dc,0]], + ["coerce",[$OutputForm,nam], ["ELT",dc,$FirstParamSlot + nargs + 1]]] [substitute(nam,dc,substituteDollarIfRepHack sigFunAlist),e] mkRecordFunList(nam,["Record",:Alist],e) == len:= #Alist - --- for (.,a,.) in Alist do --- if getmode(a,e) then MOAN("Symbol: ",a, --- " must not be both a variable and literal") --- e:= put(a,"isLiteral","true",e) dc := GENSYM() sigFunAlist:= - --:((a,(A,nam),("XLAM",("$1","$2"),("RECORDELT","$1",i,len))) - -- for i in 0..,(.,a,A) in Alist), - [["construct",[nam,:[A for [.,a,A] in Alist]],"mkRecord"], - ["_=",[["Boolean"],nam ,nam],["ELT",dc,6]], - ["coerce",[$OutputForm,nam],["ELT",dc,7]],: - [["elt",[A,nam,PNAME a],["XLAM",["$1","$2"],["RECORDELT","$1",i,len]]] - for i in 0.. for [.,a,A] in Alist],: - [["setelt",[A,nam,PNAME a,A],["XLAM",["$1","$2","$3"], - ["SETRECORDELT","$1",i, len,"$3"]]] - for i in 0.. for [.,a,A] in Alist],: - [["copy",[nam,nam],["XLAM",["$1"],["RECORDCOPY", - "$1",len]]]]] + ["=",[$Boolean,nam ,nam],["ELT",dc,$FirstParamSlot + len]], + ["~=",[$Boolean,nam,nam],["ELT",dc,0]], + ["coerce",[$OutputForm,nam],["ELT",dc,$FirstParamSlot+len+1]],: + [["elt",[A,nam,PNAME a],["XLAM",["$1","$2"],["RECORDELT","$1",i,len]]] + for i in 0.. for [.,a,A] in Alist],: + [["setelt",[A,nam,PNAME a,A],["XLAM",["$1","$2","$3"], + ["SETRECORDELT","$1",i, len,"$3"]]] + for i in 0.. for [.,a,A] in Alist],: + [["copy",[nam,nam],["XLAM",["$1"],["RECORDCOPY", + "$1",len]]]]] [substitute(nam,dc,substituteDollarIfRepHack sigFunAlist),e] mkNewUnionFunList(name,form is ["Union",:listOfEntries],e) == + nargs := #listOfEntries dc := name m := dollarIfRepHack name --2. create coercions from subtypes to subUnion cList:= - [["_=",[["Boolean"],name ,name],["ELT",dc,6]], - ["coerce",[$OutputForm,name],["ELT",dc,7]],: - ("append"/ - [[["construct",[name,type],["XLAM",["#1"],["CONS",i,"#1"]]], - ["elt",[type,name,tag],cdownFun], - ["case",['(Boolean),name,tag], - ["XLAM",["#1"],["QEQCAR","#1",i]]]] - for [.,tag,type] in listOfEntries for i in 0..])] where - cdownFun() == - gg:=GENSYM() - $InteractiveMode => - ["XLAM",["#1"],["PROG1",["QCDR","#1"], - ["check_-union",["QEQCAR","#1",i],type,"#1"]]] - ["XLAM",["#1"],["PROG2",["LET",gg,"#1"],["QCDR",gg], - ["check_-union",["QEQCAR",gg,i],type,gg]]] + [["=",[$Boolean,name ,name],["ELT",dc,$FirstParamSlot+nargs]], + ["~=",[$Boolean,name,name],["ELT",dc,0]], + ["coerce",[$OutputForm,name],["ELT",dc,$FirstParamSlot+nargs+1]],: + ("append"/ + [[["construct",[name,type],["XLAM",["#1"],["CONS",i,"#1"]]], + ["elt",[type,name,tag],cdownFun], + ["case",['(Boolean),name,tag], + ["XLAM",["#1"],["QEQCAR","#1",i]]]] + for [.,tag,type] in listOfEntries for i in 0..])] where + cdownFun() == + gg:=GENSYM() + $InteractiveMode => + ["XLAM",["#1"],["PROG1",["QCDR","#1"], + ["check-union",["QEQCAR","#1",i],type,"#1"]]] + ["XLAM",["#1"],["PROG2",["LET",gg,"#1"],["QCDR",gg], + ["check-union",["QEQCAR",gg,i],type,gg]]] [cList,e] mkEnumerationFunList(nam,["Enumeration",:SL],e) == @@ -317,50 +346,52 @@ mkEnumerationFunList(nam,["Enumeration",:SL],e) == dc := nam cList := [nil, - ["_=",[["Boolean"],nam ,nam],["ELT",dc,6]], - ["_^_=",[["Boolean"],nam ,nam],["ELT",dc,7]], - ["coerce",[nam, ["Symbol"]], ["ELT", dc, 8]], - ["coerce",[["OutputForm"],nam],["ELT",dc, 9]]] + ["=",[$Boolean,nam ,nam],["ELT",dc,$FirstParamSlot+len]], + ["~=",[$Boolean,nam ,nam],["ELT",dc,0]], + ["coerce",[nam, ["Symbol"]], ["ELT", dc,$FirstParamSlot+len+1]], + ["coerce",[["OutputForm"],nam],["ELT",dc,$FirstParamSlot+len+2]]] [substitute(nam, dc, cList),e] mkUnionFunList(op,form is ["Union",:listOfEntries],e) == first listOfEntries is [":",.,.] => mkNewUnionFunList(op,form,e) -- following call to order is a bug, but needs massive recomp to fix listOfEntries:= orderUnionEntries listOfEntries + nargs := #listOfEntries --1. create representations of subtypes predList:= mkPredList listOfEntries g:=GENSYM() --2. create coercions from subtypes to subUnion cList:= - [["_=",[["Boolean"],g ,g],["ELT",op,6]], - ["coerce",[$OutputForm,g],["ELT",op,7]],: - ("append"/ - [[["autoCoerce",[g,t],upFun], - ["coerce",[t,g],cdownFun], - ["autoCoerce",[t,g],downFun], --this should be removed eventually - ["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"]] - ["XLAM",["#1"],"#1"] - cdownFun() == - gg:=GENSYM() - if p is ["EQCAR",x,n] then - ref:=["QCDR",gg] - q:= ["QEQCAR", gg, n] - else - ref:=gg - q:= substitute(gg,"#1",p) - ["XLAM",["#1"],["PROG2",["LET",gg,"#1"],ref, - ["check_-union",q,t,gg]]] - downFun() == - p is ["EQCAR",x,.] => - ["XLAM",["#1"],["QCDR","#1"]] - ["XLAM",["#1"],"#1"] - typeFun() == - p is ["EQCAR",x,n] => - ["XLAM",["#1"],["QEQCAR",x,n]] - ["XLAM",["#1"],p] + [["=",[$Boolean,g ,g],["ELT",op,$FirstParamSlot + nargs]], + ["~=",[$Boolean,g,g],["ELT",op,0]], + ["coerce",[$OutputForm,g],["ELT",op,$FirstParamSlot+nargs+1]],: + ("append"/ + [[["autoCoerce",[g,t],upFun], + ["coerce",[t,g],cdownFun], + ["autoCoerce",[t,g],downFun], --this should be removed eventually + ["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"]] + ["XLAM",["#1"],"#1"] + cdownFun() == + gg:=GENSYM() + if p is ["EQCAR",x,n] then + ref:=["QCDR",gg] + q:= ["QEQCAR", gg, n] + else + ref:=gg + q:= substitute(gg,"#1",p) + ["XLAM",["#1"],["PROG2",["LET",gg,"#1"],ref, + ["check-union",q,t,gg]]] + downFun() == + p is ["EQCAR",x,.] => + ["XLAM",["#1"],["QCDR","#1"]] + ["XLAM",["#1"],"#1"] + typeFun() == + p is ["EQCAR",x,n] => + ["XLAM",["#1"],["QEQCAR",x,n]] + ["XLAM",["#1"],p] cList:= substitute(dollarIfRepHack op,g,cList) [cList,e] diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 0136f78c..457fa052 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -113,7 +113,7 @@ NRTreplaceAllLocalReferences(form) == NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) == --converts a domain form to a lazy domain form; everything other than --the operation name should be assigned a slot - null firstTime and (k:= NRTassocIndex x) => k + not firstTime and (k:= NRTassocIndex x) => k VECP x => systemErrorHere '"NRTencode" PAIRP x => QCAR x='Record or x is ['Union,['_:,a,b],:.] => diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot index f9b1f17f..8647f6f9 100644 --- a/src/interp/nrungo.boot +++ b/src/interp/nrungo.boot @@ -1,6 +1,6 @@ --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2008, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -15,7 +15,7 @@ -- the documentation and/or other materials provided with the -- distribution. -- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the +-- - Neither the name of The Numerical Algorithms Group Ltd. nor the -- names of its contributors may be used to endorse or promote products -- derived from this software without specific prior written permission. -- @@ -55,7 +55,9 @@ compiledLookup(op,sig,dollar) == --------------------> NEW DEFINITION (see interop.boot.pamphlet) basicLookup(op,sig,domain,dollar) == - domain.1 is ['lookupInDomain,:.] => lookupInDomainVector(op,sig,domain,dollar) + item := domain.1 + CONSP item and first item in '(lookupInDomain lookupInTable) => + lookupInDomainVector(op,sig,domain,dollar) ----------new world code follows------------ u := lookupInDomainAndDefaults(op,sig,domain,dollar,false) => u lookupInDomainAndDefaults(op,sig,domain,dollar,true) @@ -183,7 +185,7 @@ lookupInDomain(op,sig,addFormDomain,dollar,index) == addFormCell := addFormDomain.index => INTEGERP KAR addFormCell => or/[lookupInDomain(op,sig,addFormDomain,dollar,i) for i in addFormCell] - if null VECP addFormCell then addFormCell := eval addFormCell + if not VECP addFormCell then addFormCell := eval addFormCell lookupInDomainVector(op,sig,addFormCell,dollar) nil @@ -208,19 +210,16 @@ lookupInDomainAndDefaults(op,sig,domain,dollar,useDefaults) == --======================================================= lookupInCategories(op,sig,dom,dollar) == catformList := dom.4.0 - varList := ['$,:$FormalMapVariableList] - valueList := [dom,:[dom.(5+i) for i in 1..(# rest dom.0)]] - valueList := [MKQ val for val in valueList] + varList := ["$",:$FormalMapVariableList] nsig := MSUBST(dom.0,dollar.0,sig) + -- the following lines don't need to check for predicates because + -- this code (the old runtime scheme) is used only for + -- builtin constructors -- their predicates are always true. r := or/[lookupInDomainVector(op,nsig, - eval EQSUBSTLIST(valueList,varList,catform),dollar) - for catform in catformList | pred] where pred() == - (table := HGET($Slot1DataBase,first catform)) and - (u := LASSQ(op,table)) --compare without checking predicates - and (v := or/[rest x for x in u | #sig = #x.0]) - -- following lines commented out because compareSig needs domain - -- and (v := or/[rest x for x in u | - -- compareSig(sig,x.0,dollar.0, catform)]) + eval EQSUBSTLIST(valueList,varList,catform),dollar) + for catform in catformList | not null catform] where + valueList() == + [MKQ dom,:[MKQ dom.(5+i) for i in 1..(#rest catform)]] r or lookupDisplay(op,sig,'"category defaults",'"-- not found") --======================================================= -- cgit v1.2.3