diff options
author | dos-reis <gdr@axiomatics.org> | 2011-04-26 14:46:51 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-04-26 14:46:51 +0000 |
commit | 2ccdfe6c9be93b3e0ba28f28305de03db7eb4ad6 (patch) | |
tree | 15954806c292f502a3368d8e9b1c5ae769aac010 | |
parent | e2e6e0d0acb2655634e475f214958e612dddb7c1 (diff) | |
download | open-axiom-2ccdfe6c9be93b3e0ba28f28305de03db7eb4ad6.tar.gz |
cleanup
-rw-r--r-- | src/interp/cattable.boot | 33 | ||||
-rw-r--r-- | src/interp/i-funsel.boot | 460 | ||||
-rw-r--r-- | src/interp/interop.boot | 54 |
3 files changed, 270 insertions, 277 deletions
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index e79677ba..c2270850 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -37,12 +37,12 @@ import g_-util namespace BOOT hasCat(domainOrCatName,catName) == - catName="Type" -- every domain is a Type + catName is "Type" -- every domain is a Type or constructorHasCategoryFromDB [domainOrCatName,:catName] showCategoryTable con == [[b,:val] for (key :=[a,:b]) in HKEYS _*HASCATEGORY_-HASH_* - | a = con and (val := HGET(_*HASCATEGORY_-HASH_*,key))] + | symbolEq?(a,con) and (val := HGET(_*HASCATEGORY_-HASH_*,key))] displayCategoryTable(:options) == conList := IFCAR options @@ -59,7 +59,7 @@ genCategoryTable() == genTempCategoryTable() domainList:= [con for con in allConstructors() - | getConstructorKindFromDB con = "domain"] + | getConstructorKindFromDB con is "domain"] domainTable:= [addDomainToTable(con,getConstrCat catl) for con in domainList | catl := getConstructorCategoryFromDB con] -- $nonLisplibDomains, $noCategoryDomains are set in BUILDOM BOOT @@ -95,7 +95,7 @@ simpHasPred(pred,:options) == main where simp pred simp pred == pred is [op,:r] => - op = "has" => simpHas(pred,first r,second r) + op is "has" => simpHas(pred,first r,second r) op is 'HasCategory => simp ["has",first r,simpDevaluate second r] op is 'HasSignature => [op,sig] := simpDevaluate second r @@ -143,8 +143,8 @@ simpHasSignature(pred,conform,op,sig) == --eval w/o loading simpHasAttribute(pred,conform,attr) == --eval w/o loading IDENTP conform => pred - conname := opOf conform - getConstructorKindFromDB conname = "category" => + conname := conform.op + getConstructorKindFromDB conname is "category" => simpCatHasAttribute(conform,attr) asharpConstructorName? conname => p := LASSOC(attr,getConstructorAttributesFromDB conname) => @@ -153,7 +153,7 @@ simpHasAttribute(pred,conform,attr) == --eval w/o loading k := LASSOC(attr,infovec.2) or return nil --if not listed then false k = 0 => true $domain => kTestPred k --from koOps - predvec := $predvec or sublisFormal(rest conform, + predvec := $predvec or sublisFormal(conform.args, getConstructorPredicatesFromDB conname) simpHasPred predvec.(k - 1) @@ -195,7 +195,7 @@ genTempCategoryTable() == -- "IF pred THEN ofCategory(key,form)" -- where form can involve #1, #2, ... the parameters of key for con in allConstructors() repeat - getConstructorKindFromDB con = "category" => + getConstructorKindFromDB con is "category" => addToCategoryTable con for id in HKEYS _*ANCESTORS_-HASH_* repeat item := HGET(_*ANCESTORS_-HASH_*, id) @@ -372,7 +372,7 @@ getConstructorExports(conform,:options) == categoryParts(conform, categoryParts(conform,category,:options) == main where main() == - cons? := IFCAR options --means to include constructors as well + addCtor? := IFCAR options --means to include constructors as well $attrlist: local := nil $oplist : local := nil $conslist: local := nil @@ -381,8 +381,9 @@ categoryParts(conform,category,:options) == main where $attrlist := listSort(function GLESSEQP,$attrlist) $oplist := listSort(function GLESSEQP,$oplist) res := [$attrlist,:$oplist] - if cons? then res := [listSort(function GLESSEQP,$conslist),:res] - if getConstructorKindFromDB conname = "category" then + if addCtor? then + res := [listSort(function GLESSEQP,$conslist),:res] + if getConstructorKindFromDB conname is "category" then tvl := TAKE(#rest conform,$TriangleVariableList) res := SUBLISLIS($FormalMapVariableList,tvl,res) res @@ -401,7 +402,7 @@ categoryParts(conform,category,:options) == main where build(s1,quickAnd(pred,pred1)) s2 => build(s2,quickAnd(pred,['NOT,pred1])) null item => 'ok - item = "%noBranch" => 'ok + item is "%noBranch" => 'ok item is ['PROGN,:r] => for x in r repeat build(x,pred) systemError '"build error" exportsOf(target) == @@ -496,11 +497,3 @@ clearTempCategoryTable(catNames) == symbolMember?(first catForm,catNames) => nil extensions:= [extension,:extensions] HPUT(_*ANCESTORS_-HASH_*,key,extensions) - - - - - - - - diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index ae8d799a..512b0a77 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -74,7 +74,7 @@ selectMms(op,args,$declaredMode) == imp := val => getValueNormalForm val n - [[['local,:ta], imp , NIL]] + [[['local,:ta], imp , nil]] ((isSharpVarWithNum(n) and opMode) or (val and opMode)) and opMode is ['Variable,f] => @@ -88,7 +88,7 @@ selectMms(op,args,$declaredMode) == types1 := getOpArgTypes(n,args) numArgs := #args - member($EmptyMode,types1) => NIL + member($EmptyMode,types1) => nil tar := getTarget op dc := getAtree(op,'dollar) @@ -98,29 +98,29 @@ selectMms(op,args,$declaredMode) == putTarget(tree,['Mapping,tar,:types1]) bottomUp tree val := getValue tree - [[['local,:rest objMode val], getValueNormalForm val, NIL]] + [[['local,:rest objMode val], getValueNormalForm val, nil]] - if (n = 'map) and (first types1 = $AnonymousFunction) + if (n is 'map) and (first types1 = $AnonymousFunction) then tree := mkAtree objValUnwrap getValue first args ut := tar => underDomainOf tar - NIL + nil ua := [underDomainOf x for x in rest types1] - member(NIL,ua) => NIL + member(nil,ua) => nil putTarget(tree,['Mapping,ut,:ua]) bottomUp tree val := getValue tree types1 := [objMode val,:rest types1] args.first := tree - if numArgs = 1 and (n = "numer" or n = "denom") and + if numArgs = 1 and (n is "numer" or n is "denom") and isEqualOrSubDomain(first types1,$Integer) and null dc then dc := ['Fraction, $Integer] putAtree(op, 'dollar, dc) - if $reportBottomUpFlag then sayFunctionSelection(n,types1,tar,dc,NIL) + if $reportBottomUpFlag then sayFunctionSelection(n,types1,tar,dc,nil) identType := 'Variable for x in types1 while not $declaredMode repeat @@ -130,7 +130,7 @@ selectMms(op,args,$declaredMode) == mmS:= dc => selectDollarMms(dc,n,types1,types2) - if n = "/" and tar = $Integer then + if n is "/" and tar = $Integer then tar := $RationalNumber putTarget(op,tar) @@ -152,33 +152,33 @@ selectMms(op,args,$declaredMode) == selectMms2(op,tar,args1,args2,$Coerce) == -- decides whether to find functions from a domain or package -- or by general modemap evaluation - or/[string? arg for arg in args1] => NIL - if tar = $EmptyMode then tar := NIL + or/[string? arg for arg in args1] => nil + if tar = $EmptyMode then tar := nil nargs := #args1 - mmS := NIL + mmS := nil mmS := -- special case map for the time being - $Coerce and (op = 'map) and (2 = nargs) and + $Coerce and (op is 'map) and (2 = nargs) and (first(args1) is ['Variable,fun]) => - null (ud := underDomainOf second args1) => NIL + null (ud := underDomainOf second args1) => nil if tar then ut := underDomainOf(tar) else ut := nil - null (mapMms := selectMms1(fun,ut,[ud],[NIL],true)) => NIL + null (mapMms := selectMms1(fun,ut,[ud],[nil],true)) => nil mapMm := CDAAR mapMms selectMms1(op,tar,[['Mapping,:mapMm],second args1], - [NIL,second args2],$Coerce) + [nil,second args2],$Coerce) - $Coerce and (op = 'map) and (2 = nargs) and + $Coerce and (op is 'map) and (2 = nargs) and (first(args1) is ['FunctionCalled,fun]) => - null (ud := underDomainOf second args1) => NIL + null (ud := underDomainOf second args1) => nil if tar then ut := underDomainOf(tar) else ut := nil funNode := mkAtreeNode fun transferPropsToNode(fun,funNode) - null (mapMms := selectLocalMms(funNode,fun,[ud],NIL)) => NIL + null (mapMms := selectLocalMms(funNode,fun,[ud],nil)) => nil mapMm := CDAAR mapMms selectMms1(op,tar,[['Mapping,:mapMm],second args1], - [NIL,second args2],$Coerce) + [nil,second args2],$Coerce) -- get the argument domains and the target a := nil @@ -204,7 +204,7 @@ selectMms2(op,tar,args1,args2,$Coerce) == a := reverse! removeDuplicates a for x in a repeat null x => 'iterate - x = '(RationalRadicals) => a' := [$RationalNumber,:a'] + x is '(RationalRadicals) => a' := [$RationalNumber,:a'] x is ['Union,:l] => -- check if we have a tagged union l and first l is [":",:.] => @@ -226,7 +226,7 @@ selectMms2(op,tar,args1,args2,$Coerce) == x:= first a a:= rest a atom x => 'iterate - mmS := append(mmS, findFunctionInDomain(op,x,tar,args1,args2,NIL,NIL)) + mmS := append(mmS, findFunctionInDomain(op,x,tar,args1,args2,nil,nil)) -- step 2. if we didn't get one, trying coercing (if we are -- suppose to) @@ -238,7 +238,7 @@ selectMms2(op,tar,args1,args2,$Coerce) == a:= rest a atom x => 'iterate mmS := append(mmS, - findFunctionInDomain(op,x,tar,args1,args2,$Coerce,NIL)) + findFunctionInDomain(op,x,tar,args1,args2,$Coerce,nil)) mmS or selectMmsGen(op,tar,args1,args2) mmS and orderMms(op, mmS,args1,args2,tar) @@ -253,16 +253,16 @@ defaultTarget(opNode,op,nargs,args) == target := nil nargs = 0 => - op = 'nil => + op is "nil" => putTarget(opNode, target := '(List (None))) target - op = 'true or op = 'false => + op is "true" or op is "false" => putTarget(opNode, target := $Boolean) target - op = 'pi => + op is 'pi => putTarget(opNode, target := ['Pi]) target - op = 'infinity => + op is 'infinity => putTarget(opNode, target := ['OnePointCompletion, $Integer]) target op in '(plusInfinity minusInfinity) => @@ -275,17 +275,17 @@ defaultTarget(opNode,op,nargs,args) == a1f := first a1 nargs = 1 => - op = 'kernel => + op is 'kernel => putTarget(opNode, target := ['Kernel, ['Expression, $Integer]]) target - op = 'list => + op is 'list => putTarget(opNode, target := ['List, a1]) target target a2 := second args - nargs >= 2 and op = "draw" and a1 is ['FunctionCalled,sym] and a2 is ['Segment,.] => + nargs >= 2 and op is "draw" and a1 is ['FunctionCalled,sym] and a2 is ['Segment,.] => -- this clears up some confusion over 2D and 3D graphics @@ -293,11 +293,11 @@ defaultTarget(opNode,op,nargs,args) == transferPropsToNode(sym,symNode) nargs >= 3 and third args is ['Segment,.] => - selectLocalMms(symNode,sym,[$DoubleFloat, $DoubleFloat],NIL) + selectLocalMms(symNode,sym,[$DoubleFloat, $DoubleFloat],nil) putTarget(opNode, target := '(ThreeDimensionalViewport)) target - (mms := selectLocalMms(symNode,sym,[$DoubleFloat],NIL)) => + (mms := selectLocalMms(symNode,sym,[$DoubleFloat],nil)) => [.,targ,:.] := CAAR mms targ = $DoubleFloat => putTarget(opNode, target := '(TwoDimensionalViewport)) @@ -309,26 +309,26 @@ defaultTarget(opNode,op,nargs,args) == target - nargs >= 2 and op = "makeObject" and a1 is ['FunctionCalled,sym] and a2 is ['Segment,.] => + nargs >= 2 and op is "makeObject" and a1 is ['FunctionCalled,sym] and a2 is ['Segment,.] => -- we won't actually bother to put a target on makeObject -- this is just to figure out what the first arg is symNode := mkAtreeNode sym transferPropsToNode(sym,symNode) nargs >= 3 and third args is ['Segment,.] => - selectLocalMms(symNode,sym,[$DoubleFloat, $DoubleFloat],NIL) + selectLocalMms(symNode,sym,[$DoubleFloat, $DoubleFloat],nil) target - selectLocalMms(symNode,sym,[$DoubleFloat],NIL) + selectLocalMms(symNode,sym,[$DoubleFloat],nil) target nargs = 2 => - op = "elt" => + op is "elt" => a1 = $BasicOperator and a2 is ['List, ['OrderedVariableList, .]] => ['Expression, $Integer] target - op = "eval" => + op is "eval" => a1 is ['Expression,b1] and a2 is ['Equation, ['Polynomial,b2]] => target := canCoerce(b2, a1) => a1 @@ -353,7 +353,7 @@ defaultTarget(opNode,op,nargs,args) == else target := nil target - op = "**" or op = "^" => + op is "**" or op is "^" => a2 = $Integer => if (target := resolveTCat(a1,$Field)) then putTarget(opNode,target) @@ -396,7 +396,7 @@ defaultTarget(opNode,op,nargs,args) == target target - op = "/" => + op is "/" => isEqualOrSubDomain(a1, $Integer) and isEqualOrSubDomain(a2, $Integer) => putTarget(opNode, target := $RationalNumber) target @@ -427,7 +427,7 @@ defaultTarget(opNode,op,nargs,args) == a3 := third args nargs = 3 => - op = "eval" => + op is "eval" => a3 is ['List, a3e] => target := resolveTT(a1, a3e) if not (target = $Any) then putTarget(opNode,target) @@ -466,14 +466,14 @@ altTypeOf(type,val,$declaredMode) == a type = $PositiveInteger => $Integer type = $NonNegativeInteger => $Integer - type = '(List (PositiveInteger)) => '(List (Integer)) - NIL + type is '(List (PositiveInteger)) => '(List (Integer)) + nil getOpArgTypes(opname, args) == l := getOpArgTypes1(opname, args) [f(a,opname) for a in l] where f(x,op) == - x is ['FunctionCalled,g] and op ~= 'name => + x is ['FunctionCalled,g] and op isnt 'name => m := get(g,'mode,$e) => m is ['Mapping,:.] => m x @@ -481,22 +481,22 @@ getOpArgTypes(opname, args) == x getOpArgTypes1(opname, args) == - null args => NIL + null args => nil -- special cases first - opname = 'coef and args is [b,n] => + opname is 'coef and args is [b,n] => [first getModeSet b, first getModeSetUseSubdomain n] - opname = 'monom and args is [d,c] => + opname is 'monom and args is [d,c] => [first getModeSetUseSubdomain d,first getModeSet c] - opname = 'monom and args is [v,d,c] => + opname is 'monom and args is [v,d,c] => [first getModeSet v,first getModeSetUseSubdomain d,first getModeSet c] - (opname = 'cons) and (2 = #args) and (second(args) = 'nil) => + (opname is 'cons) and (2 = #args) and (second(args) is "nil") => ms := [first getModeSet x for x in args] - if second(ms) = '(List (None)) then + if second(ms) is '(List (None)) then ms := [first ms,['List,first ms]] ms nargs := #args v := argCouldBelongToSubdomain(opname,nargs) - mss := NIL + mss := nil for i in 0..(nargs-1) for x in args repeat ms := v.i = 0 => first getModeSet x @@ -508,7 +508,7 @@ argCouldBelongToSubdomain(op, nargs) == -- this returns a vector containing 0 or ^0 for each argument. -- if ^0, this indicates that there exists a modemap for the -- op that needs a subdomain in that position - nargs = 0 => NIL + nargs = 0 => nil v := GETZEROVEC nargs isMap(op) => v mms := getModemapsFromDatabase(op,nargs) @@ -523,24 +523,24 @@ argCouldBelongToSubdomain(op, nargs) == v CONTAINEDisDomain(symbol,cond) == --- looks for [isSubDomain,symbol,[domain]] in cond: returning T or NIL +-- looks for [isSubDomain,symbol,[domain]] in cond: returning T or nil -- with domain being one of PositiveInteger and NonNegativeInteger atom cond => false cond.op in '(AND OR and or %and %or) => or/[CONTAINEDisDomain(symbol, u) for u in cond.args] - cond.op = 'isDomain => + cond.op is 'isDomain => sameObject?(symbol,second cond) and cons?(dom:=third cond) and dom in '(PositiveInteger NonNegativeInteger) false selectDollarMms(dc,name,types1,types2) == -- finds functions for name in domain dc - isPartialMode dc => throwKeyedMsg("S2IF0001",NIL) - mmS := findFunctionInDomain(name,dc,NIL,types1,types2,'T,'T) => - orderMms(name, mmS,types1,types2,NIL) + isPartialMode dc => throwKeyedMsg("S2IF0001",nil) + mmS := findFunctionInDomain(name,dc,nil,types1,types2,'T,'T) => + orderMms(name, mmS,types1,types2,nil) if $reportBottomUpFlag then sayMSG ["%b",'" function not found in ",prefix2String dc,"%d","%l"] - NIL + nil selectLocalMms(op,name,types,tar) == -- partial rewrite, looks now for exact local modemap @@ -567,12 +567,12 @@ selectLocalMms(op,name,types,tar) == getLocalMms(name,types,tar) == -- looks for exact or subsumed local modemap in $e - mmS := NIL + mmS := nil for (mm:=[dcSig,:.]) in get(name,'localModemap,$e) repeat -- check format and destructure - dcSig isnt [dc,result,:args] => NIL + dcSig isnt [dc,result,:args] => nil -- make number of args is correct - #types ~= #args => NIL + #types ~= #args => nil -- check for equal or subsumed arguments subsume := (not $useIntegerSubdomain) or (tar = result) or get(name,'recursive,$e) @@ -584,8 +584,8 @@ getLocalMms(name,types,tar) == else x = y not acceptableArgs => -- interpreted maps are ok - dc = 'interpOnly and not($Coerce)=> mmS := [mm,:mmS] - NIL + dc is 'interpOnly and not($Coerce)=> mmS := [mm,:mmS] + nil mmS := [mm,:mmS] reverse! mmS @@ -606,7 +606,7 @@ mmCost0(name, sig,cond,tar,args1,args2) == -- try to favor homogeneous multiplication ---if name = "*" and 2 = #sigArgs and first sigArgs ~= second sigArgs then n := n + 1 +--if name is "*" and 2 = #sigArgs and first sigArgs ~= second sigArgs then n := n + 1 -- because of obscure problem in evalMm, sometimes we will have extra -- modemaps with the wrong number of arguments if we want to the one @@ -619,7 +619,7 @@ mmCost0(name, sig,cond,tar,args1,args2) == topcon := first deconstructT x1 topcon2 := first deconstructT x3 topcon = topcon2 => 3 - first topcon2 = 'Mapping => 2 + first topcon2 is 'Mapping => 2 4 else if sigArgs then n := n + 100000000000 @@ -631,8 +631,8 @@ orderMms(name, mmS,args1,args2,tar) == -- it counts the number of necessary coercions of the argument types -- if this isn't enough, it compares the target types mmS and null rest mmS => mmS - mS:= NIL - N:= NIL + mS:= nil + N:= nil for mm in MSORT mmS repeat [sig,.,cond]:= mm b:= 'T @@ -660,26 +660,26 @@ hitListOfTarget(t) == t = '(Polynomial (Pi)) => 90000 - first t ='Polynomial => 300 - first t = 'List => 400 - first t = 'Matrix => 910 - first t = 'UniversalSegment => 501 - first t = 'RationalFunction => 900 - first t = 'Union => 999 - first t = 'Expression => 1600 + t.op is 'Polynomial => 300 + t.op is 'List => 400 + t.op is 'Matrix => 910 + t.op is 'UniversalSegment => 501 + t.op is 'RationalFunction => 900 + t.op is 'Union => 999 + t.op is 'Expression => 1600 500 getFunctionFromDomain(op,dc,args) == -- finds the function op with argument types args in dc -- complains, if no function or ambiguous - $reportBottomUpFlag:local:= NIL - member(first dc,$nonLisplibDomains) => - throwKeyedMsg("S2IF0002",[first dc]) - not constructor? first dc => - throwKeyedMsg("S2IF0003",[first dc]) - p:= findFunctionInDomain(op,dc,NIL,args,args,NIL,NIL) => + $reportBottomUpFlag:local:= nil + member(dc.op,$nonLisplibDomains) => + throwKeyedMsg("S2IF0002",[dc.op]) + not constructor? dc.op => + throwKeyedMsg("S2IF0003",[dc.op]) + p:= findFunctionInDomain(op,dc,nil,args,args,nil,nil) => --+ - --sig := [NIL,:args] + --sig := [nil,:args] domain := evalDomain dc for mm in reverse! p until b repeat [[.,:osig],nsig,:.] := mm @@ -692,8 +692,8 @@ isOpInDomain(opName,dom,nargs) == -- the given number of arguments mmList := ASSQ(opName,getConstructorOperationsFromDB dom.op) mmList := subCopy(mmList,constructSubst dom) - null mmList => NIL - gotOne := NIL + null mmList => nil + gotOne := nil nargs := nargs + 1 for mm in rest mmList while not gotOne repeat nargs = #first mm => gotOne := [mm, :gotOne] @@ -701,21 +701,21 @@ isOpInDomain(opName,dom,nargs) == findCommonSigInDomain(opName,dom,nargs) == -- this looks at all signatures in dom with given opName and nargs - -- number of arguments. If no matches, returns NIL. Otherwise returns - -- a "signature" where a type position is non-NIL only if all + -- number of arguments. If no matches, returns nil. Otherwise returns + -- a "signature" where a type position is non-nil only if all -- signatures shares that type . - first(dom) in '(Union Record Mapping) => NIL + first(dom) in '(Union Record Mapping) => nil mmList := ASSQ(opName,getConstructorOperationsFromDB dom.op) mmList := subCopy(mmList,constructSubst dom) - null mmList => NIL - gotOne := NIL + null mmList => nil + gotOne := nil nargs := nargs + 1 - vec := NIL + vec := nil for mm in rest mmList repeat nargs = #first mm => null vec => vec := LIST2VEC first mm for i in 0.. for x in first mm repeat - if vec.i and vec.i ~= x then vec.i := NIL + if vec.i and vec.i ~= x then vec.i := nil VEC2LIST vec findUniqueOpInDomain(op,opName,dom) == @@ -770,35 +770,35 @@ selectMostGeneralMm mmList == findFunctionInDomain(op,dc,tar,args1,args2,$Coerce,$SubDom) == -- looks for a modemap for op with signature args1 -> tar -- in the domain of computation dc - -- tar may be NIL (= unknown) + -- tar may be nil (= unknown) null isLegitimateMode(tar, nil, nil) => nil - dcName:= first dc + dcName:= dc.op dcName in '(Union Record Mapping Enumeration) => -- First cut code that ignores args2, $Coerce and $SubDom -- When domains no longer have to have Set, the hard coded 6 and 7 -- should go. - op = '_= => - #args1 ~= 2 or args1.0 ~= dc or args1.1 ~= dc => NIL - tar and tar ~= $Boolean => NIL - [[[dc, $Boolean, dc, dc], [$Boolean,'$,'$], [NIL, NIL]]] - op = 'coerce => + op is '_= => + #args1 ~= 2 or args1.0 ~= dc or args1.1 ~= dc => nil + tar and tar ~= $Boolean => nil + [[[dc, $Boolean, dc, dc], [$Boolean,'$,'$], [nil, nil]]] + op is 'coerce => #args1 ~= 1 => nil - dcName='Enumeration and (args1.0=$Symbol or tar=dc)=> - [[[dc, dc, $Symbol], ['$,$Symbol], [NIL, NIL]]] - args1.0 ~= dc => NIL - tar and tar ~= $OutputForm => NIL - [[[dc, $OutputForm, dc], [$OutputForm,'$], [NIL, NIL]]] + dcName is 'Enumeration and (args1.0=$Symbol or tar=dc)=> + [[[dc, dc, $Symbol], ['$,$Symbol], [nil, nil]]] + args1.0 ~= dc => nil + tar and tar ~= $OutputForm => nil + [[[dc, $OutputForm, dc], [$OutputForm,'$], [nil, nil]]] dcName in '(Record Union) => findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) - NIL - fun:= NIL + nil + fun:= nil ( p := ASSQ(op,getConstructorOperationsFromDB dcName) ) and SL := constructSubst dc -- if the arglist is homogeneous, first look for homogeneous -- functions. If we don't find any, look at remaining ones if isHomogeneousList args1 then - q := NIL - r := NIL + q := nil + r := nil for mm in rest p repeat -- CDAR of mm is the signature argument list if isHomogeneousList CDAR mm then q := [mm,:q] @@ -822,7 +822,7 @@ allOrMatchingMms(mms,args1,tar,dc) == -- if there are exact matches on the arg types, return them -- otherwise return the original list null mms or null rest mms => mms - x := NIL + x := nil for mm in mms repeat [sig,:.] := mm [res,:args] := substitute(dc,"$",sig) @@ -836,7 +836,7 @@ isHomogeneousList y == y and rest y => z := first y "and"/[x = z for x in rest y] - NIL + nil findFunctionInDomain1(omm,op,tar,args1,args2,SL) == dc:= rest (dollarPair := ASSQ('$,SL)) @@ -844,7 +844,7 @@ findFunctionInDomain1(omm,op,tar,args1,args2,SL) == mm:= subCopy(omm, SL) -- tests whether modemap mm is appropriate for the function -- defined by op, target type tar and argument types args - $RTC:local:= NIL + $RTC:local:= nil -- $RTC is a list of run-time checks to be performed [sig,slot,cond,y] := mm @@ -853,29 +853,29 @@ findFunctionInDomain1(omm,op,tar,args1,args2,SL) == if CONTAINED('_#, sig) or CONTAINED('construct,sig) then sig := [replaceSharpCalls t for t in sig] matchMmCond cond and matchMmSig(mm,tar,args1,args2) and - y="Subsumed" and + y is "Subsumed" and -- hmmmm: do Union check in following because (as in DP) -- Unions are subsumed by total modemaps which are in the -- mm list in findFunctionInDomain. y := 'ELT -- if subsumed fails try it again not $SubDom and first sig isnt ['Union,:.] and slot is [tar,:args] and - (f := findFunctionInDomain(op,dc,tar,args,args,NIL,NIL)) => f - y='ELT => [[[dc,:sig],osig,reverse! $RTC]] - y='CONST => [[[dc,:sig],osig,reverse! $RTC]] - y='ASCONST => [[[dc,:sig],osig,reverse! $RTC]] + (f := findFunctionInDomain(op,dc,tar,args,args,nil,nil)) => f + y is 'ELT => [[[dc,:sig],osig,reverse! $RTC]] + y is 'CONST => [[[dc,:sig],osig,reverse! $RTC]] + y is 'ASCONST => [[[dc,:sig],osig,reverse! $RTC]] y is ['XLAM,:.] => [[[dc,:sig],y,reverse! $RTC]] sayKeyedMsg("S2IF0006",[y]) - NIL + nil findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) == -- looks for a modemap for op with signature args1 -> tar -- in the domain of computation dc - -- tar may be NIL (= unknown) - dcName:= first dc - not (dcName in '(Record Union Enumeration)) => NIL - fun:= NIL + -- tar may be nil (= unknown) + dcName := dc.op + not (dcName in '(Record Union Enumeration)) => nil + fun:= nil -- cat := constructorCategory dc - makeFunc := GETL(dcName,"makeFunctionList") or + makeFunc := property(dcName,"makeFunctionList") or systemErrorHere ["findFunctionInCategory",dcName] [funlist,.] := FUNCALL(makeFunc,"$",dc,$CategoryFrame) -- get list of implementations and remove sharps @@ -891,7 +891,7 @@ findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) == impls := [[b,n,true,k],:impls] impls := reverse! impls if maxargs ~= -1 then - SL:= NIL + SL:= nil for i in 1..maxargs repeat impls := substitute(gensym(),INTERNL('"#",STRINGIMAGE i),impls) impls and @@ -914,7 +914,7 @@ matchMmCond(cond) == cond.op in '(OR or %or) => or/[matchMmCond c for c in cond.args] cond is ["has",dom,x] => - hasCaty(dom,x,NIL) ~= 'failed + hasCaty(dom,x,nil) isnt 'failed cond is [op,cond1] and op in '(not NOT %not) => not matchMmCond cond1 keyedSystemError("S2GE0016", ['"matchMmCond",'"unknown form of condition"]) @@ -928,7 +928,7 @@ matchMmSig(mm,tar,args1,args2) == sig := [replaceSharpCalls COPY t for t in sig] null args1 => matchMmSigTar(tar,first sig) a:= rest sig - arg:= NIL + arg:= nil for i in 1.. while args1 and args2 and a until not b repeat x1:= first args1 args1:= rest args1 @@ -936,7 +936,7 @@ matchMmSig(mm,tar,args1,args2) == args2:= rest args2 x:= first a a:= rest a - rtc:= NIL + rtc:= nil if x is ['SubDomain,y,:.] then x:= y b := isEqualOrSubDomain(x1,x) or (string?(x) and (x1 is ['Variable,v]) and (x = PNAME v)) or @@ -974,8 +974,8 @@ filterModemapsFromPackages(mms, names, op) == -- this returns a 2-list containing those modemaps that have one -- of the names in the package source of the modemap and all the -- rest of the modemaps in the second element. - good := NIL - bad := NIL + good := nil + bad := nil -- hack to speed up factorization choices for mpolys and to overcome -- some poor naming of packages mpolys := '("Polynomial" "MultivariatePolynomial" @@ -987,13 +987,13 @@ filterModemapsFromPackages(mms, names, op) == type := getDomainFromMm mm null type => bad := [mm,:bad] if cons? type then type := first type - getConstructorKindFromDB type = "category" => bad := [mm,:bad] + getConstructorKindFromDB type is "category" => bad := [mm,:bad] name := object2String type found := nil for n in names while not found repeat - STRPOS(n,name,0,NIL) => found := true + STRPOS(n,name,0,nil) => found := true -- hack, hack - (op = 'factor) and member(n,mpolys) and member(name,mpacks) => + (op is 'factor) and member(n,mpolys) and member(name,mpacks) => found := true if found then good := [mm,:good] @@ -1002,9 +1002,9 @@ filterModemapsFromPackages(mms, names, op) == isTowerWithSubdomain(towerType,elem) == - atom towerType => NIL + atom towerType => nil dt := deconstructT towerType - 2 ~= #dt => NIL + 2 ~= #dt => nil s := underDomainOf(towerType) isEqualOrSubDomain(s,elem) and constructM(first dt,[elem]) @@ -1013,12 +1013,12 @@ selectMmsGen(op,tar,args1,args2) == -- evaluates the condition and looks for the slot number -- returns all functions which are applicable -- args2 is a list of polynomial types for symbols - $Subst: local := NIL - $SymbolType: local := NIL + $Subst: local := nil + $SymbolType: local := nil - null (S := getModemapsFromDatabase(op,#args1)) => NIL + null (S := getModemapsFromDatabase(op,#args1)) => nil - if (op = 'map) and (2 = #args1) and + if (op is 'map) and (2 = #args1) and (first(args1) is ['Mapping,., elem]) and (a := isTowerWithSubdomain(second args1,elem)) then args1 := [first args1,a] @@ -1030,7 +1030,7 @@ selectMmsGen(op,tar,args1,args2) == -- get top level constructor names for constructors with parameters conNames := nil - if op = 'reshape then args := append(rest args1, rest args2) + if op is 'reshape then args := append(rest args1, rest args2) else args := append(args1,args2) if tar then args := [tar,:args] -- for common aggregates, use under domain also @@ -1038,16 +1038,16 @@ selectMmsGen(op,tar,args1,args2) == a => atom a => nil fa := a.op - fa in '(Record Union) => NIL + fa in '(Record Union) => nil conNames := insert(STRINGIMAGE fa, conNames) if conNames then [haves,havenots] := filterModemapsFromPackages(S,conNames,op) else - haves := NIL + haves := nil havenots := S - mmS := NIL + mmS := nil if $reportBottomUpFlag then sayMSG ['"%l",:bright '"Modemaps from Associated Packages"] @@ -1087,17 +1087,17 @@ selectMmsGen(op,tar,args1,args2) == mmS where exact?(mmS,tar,args) == - ex := inex := NIL + ex := inex := nil for (mm := [sig,[mmC,:.],:.]) in mmS repeat [c,t,:a] := sig ok := true for pat in a for arg in args while ok repeat - not CONTAINED(['isDomain,pat,arg],mmC) => ok := NIL + not CONTAINED(['isDomain,pat,arg],mmC) => ok := nil ok => ex := [mm,:ex] inex := [mm,:inex] [ex,inex] matchMms(mmaps,op,tar,args1,args2) == - mmS := NIL + mmS := nil for [sig,mmC] in mmaps repeat -- sig is [dc,result,:args] $Subst := @@ -1105,12 +1105,12 @@ selectMmsGen(op,tar,args1,args2) == -- throw in the target if it is not the same as one -- of the arguments res := second sig - member(res,CDDR sig) => NIL + member(res,CDDR sig) => nil [[res,:tar]] - NIL + nil [c,t,:a] := sig if a then matchTypes(a,args1,args2) - $Subst ~= 'failed => + $Subst isnt 'failed => mmS := append!(evalMm(op,tar,sig,mmC),mmS) mmS @@ -1118,7 +1118,7 @@ matchTypes(pm,args1,args2) == -- pm is a list of pattern variables, args1 a list of argument types, -- args2 a list of polynomial types for symbols -- the result is a match from pm to args, if one exists - for v in pm for t1 in args1 for t2 in args2 until $Subst='failed repeat + for v in pm for t1 in args1 for t2 in args2 until $Subst is 'failed repeat p:= ASSQ(v,$Subst) => t:= rest p t=t1 => $Coerce and t1 = $Symbol and @@ -1137,13 +1137,13 @@ matchTypes(pm,args1,args2) == evalMm(op,tar,sig,mmC) == -- evaluates a modemap with signature sig and condition mmC - -- the result is a list of lists [sig,slot,cond] or NIL - --if $Coerce is NIL, tar has to be the same as the computed target type + -- the result is a list of lists [sig,slot,cond] or nil + --if $Coerce is nil, tar has to be the same as the computed target type --if CONTAINED('LinearlyExplicitRingOver,mmC) then hohoho() - mS:= NIL + mS:= nil for st in evalMmStack mmC repeat SL:= evalMmCond(op,sig,st) - SL ~= 'failed => + SL isnt 'failed => SL := fixUpTypeArgs SL sig:= [subCopy(deepSubCopy(x,SL),$Subst) for x in sig] not containsVars sig => @@ -1152,14 +1152,14 @@ evalMm(op,tar,sig,mmC) == "or"/[not isValidType(arg) for arg in sig] => nil [dc,t,:args]:= sig $Coerce or null tar or tar=t => - mS:= append!(findFunctionInDomain(op,dc,t,args,args,NIL,'T),mS) + mS:= append!(findFunctionInDomain(op,dc,t,args,args,nil,'T),mS) mS evalMmFreeFunction(op,tar,sig,mmC) == [dc,t,:args]:= sig $Coerce or null tar or tar=t => nilArgs := nil - for a in args repeat nilArgs := [NIL,:nilArgs] + for a in args repeat nilArgs := [nil,:nilArgs] [[[["__FreeFunction__",:dc],t,:args], [t, :args], nilArgs]] nil @@ -1172,7 +1172,7 @@ evalMmStack(mmC) == mmC is ['partial,:mmD] => evalMmStack mmD mmC is ['ofCategory,pvar,cat] and cat is ['Join,:args] => evalMmStack ['%and,:[['ofCategory,pvar,c] for c in args]] - mmC is ['ofType,:.] => [NIL] + mmC is ['ofType,:.] => [nil] mmC is ["has",pat,x] => x in '(ATTRIBUTE SIGNATURE) => [[['ofCategory,pat,['CATEGORY,'unknown,x]]]] @@ -1186,8 +1186,8 @@ evalMmStackInner(mmC) == mmC is ['partial,:mmD] => evalMmStackInner mmD mmC is ['ofCategory,pvar,cat] and cat is ['Join,:args] => [['ofCategory, pvar, c] for c in args] - mmC is ['ofType,:.] => NIL - mmC is ['isAsConstant] => NIL + mmC is ['ofType,:.] => nil + mmC is ['isAsConstant] => nil mmC is ["has",pat,x] => x in '(ATTRIBUTE SIGNATURE) => [['ofCategory,pat,['CATEGORY,'unknown,x]]] @@ -1202,7 +1202,7 @@ evalMmCond0(op,sig,st) == -- evaluates the nonempty list of modemap conditions st -- the result is either 'failed or a substitution list SL:= evalMmDom st - SL='failed => 'failed + SL is 'failed => 'failed for p in SL until p1 and not b repeat b:= p1:= ASSQ(first p,$Subst) p1 and @@ -1218,7 +1218,7 @@ evalMmCond0(op,sig,st) == (t1 = $AnonymousFunction and t is ['Mapping, :.]) => t first p = second sig and not member(first p, CDDR sig) => canCoerceFrom(t,t1) => 'T - NIL + nil canCoerceFrom(t1,t) => 'T isSubDomain(t,t1) => p.rest := t1 t1 = $Symbol and canCoerceFrom(getSymbolType first p,t) @@ -1243,7 +1243,7 @@ doReplaceSharpCalls t == noSharpCallsHere t == t isnt [con, :args] => true - con in '(construct _#) => NIL + con in '(construct _#) => nil and/[noSharpCallsHere u for u in args] coerceTypeArgs(t1, t2, SL) == @@ -1283,8 +1283,8 @@ makeConstrArg(arg1, arg2, t1, t2, cs) == evalMmDom(st) == -- evals all isDomain(v,d) of st - SL:= NIL - for mmC in st until SL='failed repeat + SL:= nil + for mmC in st until SL is 'failed repeat mmC is ['isDomain,v,d] => string? d => SL:= 'failed p:= ASSQ(v,SL) and not (d=rest p) => SL:= 'failed @@ -1323,35 +1323,35 @@ mmCatComp(c1, c2) == evalMmCat(op,sig,stack,SL) == -- evaluates all ofCategory's of stack as soon as possible - $hope:local:= NIL + $hope:local:= nil numConds:= #stack stack:= orderMmCatStack [mmC for mmC in stack | mmC is ["ofCategory",:.]] while stack until not makingProgress repeat st := stack - stack := NIL - makingProgress := NIL + stack := nil + makingProgress := nil for mmC in st repeat S:= evalMmCat1(mmC,op, SL) - S='failed and $hope => + S is 'failed and $hope => stack:= [mmC,:stack] - S = 'failed => return S + S is 'failed => return S cons? S => makingProgress:= 'T SL:= mergeSubs(S,SL) - if stack or S='failed then 'failed else SL + if stack or S is 'failed then 'failed else SL evalMmCat1(mmC is ['ofCategory,d,c],op, SL) == -- evaluates mmC using information from the lisplib -- d may contain variables, and the substitution list $Subst is used -- the result is a substitution or failed - $domPvar: local := NIL - $hope:= NIL + $domPvar: local := nil + $hope:= nil NSL:= hasCate(d,c,SL) - NSL='failed and isPatternVar d and $Coerce and ( p:= ASSQ(d,$Subst) ) + NSL is 'failed and isPatternVar d and $Coerce and ( p:= ASSQ(d,$Subst) ) and (rest(p) is ["Variable",:.] or rest(p) = $Symbol) => p.rest := getSymbolType d hasCate(d,c,SL) - NSL='failed and isPatternVar d => + NSL is 'failed and isPatternVar d => -- following is hack to take care of the case where we have a -- free substitution variable with a category condition on it. -- This would arise, for example, where a package has an argument @@ -1361,30 +1361,30 @@ evalMmCat1(mmC is ['ofCategory,d,c],op, SL) == -- If c is not Set, Ring or Field then the more general mechanism dom := defaultTypeForCategory(c, SL) null dom => - op ~= 'coerce => 'failed -- evalMmCatLastChance(d,c,SL) + op isnt 'coerce => 'failed -- evalMmCatLastChance(d,c,SL) null (p := ASSQ(d,$Subst)) => dom => NSL := [[d,:dom]] - op ~= 'coerce => 'failed -- evalMmCatLastChance(d,c,SL) + op isnt 'coerce => 'failed -- evalMmCatLastChance(d,c,SL) if containsVars dom then dom := resolveTM(rest p, dom) $Coerce and canCoerce(rest p, dom) => NSL := [[d,:dom]] - op ~= 'coerce => 'failed -- evalMmCatLastChance(d,c,SL) + op isnt 'coerce => 'failed -- evalMmCatLastChance(d,c,SL) NSL hasCate(dom,cat,SL) == -- asks whether dom has cat under SL -- augments substitution SL or returns 'failed - dom = $EmptyMode => NIL + dom = $EmptyMode => nil isPatternVar dom => - (p:= ASSQ(dom,SL)) and ((NSL := hasCate(rest p,cat,SL)) ~= 'failed) => + (p:= ASSQ(dom,SL)) and ((NSL := hasCate(rest p,cat,SL)) isnt 'failed) => NSL (p:= ASSQ(dom,$Subst)) or (p := ASSQ(dom, SL)) => -- S:= hasCate(rest p,cat,augmentSub(first p,rest p,copy SL)) S:= hasCate1(rest p,cat,SL, dom) - not (S='failed) => S + S isnt 'failed => S hasCateSpecial(dom,rest p,cat,SL) - if SL ~= 'failed then $hope:= 'T + if SL isnt 'failed then $hope:= 'T 'failed SL1 := [[v,:d] for [v,:d] in SL | not containsVariables d] if SL1 then cat := subCopy(cat, SL1) @@ -1402,7 +1402,7 @@ hasCateSpecial(v,dom,cat,SL) == if isSubDomain(arg,$Integer) then arg := $Integer d := ['FactoredRing,arg] SL:= hasCate(arg,$Ring,augmentSub(v,d,SL)) - SL = 'failed => 'failed + SL is 'failed => 'failed hasCaty(d,cat,SL) cat = $Field or cat = $DivisionRing => if isSubDomain(dom,$Integer) then dom := $Integer @@ -1414,7 +1414,7 @@ hasCateSpecial(v,dom,cat,SL) == and hasCaty(dom', cat, augmentSub(v,dom',SL)) isSubDomain(dom,$Integer) => NSL:= hasCate($Integer,cat,augmentSub(v,$Integer,SL)) - NSL = 'failed => + NSL is 'failed => hasCateSpecialNew(v, dom, cat, SL) hasCaty($Integer,cat,NSL) hasCateSpecialNew(v, dom, cat, SL) @@ -1464,12 +1464,12 @@ hasCateSpecialNew(v,dom,cat,SL) == d := defaultTargetFE dom augmentSub(v, d, SL) 'failed - partialResult = 'failed => 'failed + partialResult is 'failed => 'failed hasCaty(d, cat, partialResult) hasCaty(d,cat,SL) == -- calls hasCat, which looks up a hashtable and returns: - -- 1. T, NIL or a (has x1 x2) condition, if cat is not parameterized + -- 1. T, nil or a (has x1 x2) condition, if cat is not parameterized -- 2. a list of pairs (argument to cat,condition) otherwise -- then the substitution SL is augmented, or the result is 'failed cat is ['CATEGORY,.,:y] => hasAttSig(d,subCopy(y,constructSubst d),SL) @@ -1477,21 +1477,21 @@ hasCaty(d,cat,SL) == hasSig(d,foo,subCopy(sig,constructSubst d),SL) cat is ['ATTRIBUTE,a] => hasAtt(d,subCopy(a,constructSubst d),SL) cat is ["Join",:.] => - for c in rest cat while SL ~= "failed" repeat + for c in cat.args while SL isnt "failed" repeat SL := hasCaty(d,c,SL) SL x:= hasCat(opOf d,opOf cat) => y:= KDR cat => S := constructSubst d - for [z,:cond] in x until not (S1='failed) repeat + for [z,:cond] in x until S1 isnt 'failed repeat S' := [[p, :mkDomPvar(p, d, z, y)] for [p,:d] in S] if $domPvar then - dom := [first d, :[domArg(arg, i, z, y) for i in 0.. - for arg in rest d]] + dom := [d.op, :[domArg(arg, i, z, y) for i in 0.. + for arg in d.args]] SL := augmentSub($domPvar, dom, copy SL) z' := [domArg2(a, S, S') for a in z] S1:= unifyStruct(y,z',copy SL) - if not (S1='failed) then S1:= + if S1 isnt 'failed then S1:= atom cond => S1 ncond := subCopy(cond, S) ncond is ["has", =d, =cat] => 'failed @@ -1515,16 +1515,16 @@ domArg(type, i, subs, y) == domArg2(arg, SL1, SL2) == isSharpVar arg => subCopy(arg, SL1) - arg = '_$ and $domPvar => $domPvar + arg is '$ and $domPvar => $domPvar subCopy(arg, SL2) hasCaty1(cond,SL) == -- cond is either a (has a b) or an OR clause of such conditions -- SL is augmented, if cond is true, otherwise the result is 'failed - $domPvar: local := NIL + $domPvar: local := nil cond is ["has",a,b] => hasCate(a,b,SL) cond is [op,:args] and op in '(AND and %and) => - for x in args while not (S='failed) repeat S:= + for x in args while S isnt 'failed repeat S:= x is ["has",a,b] => hasCate(a,b, SL) -- next line is for an obscure bug in the table x is [["has",a,b]] => hasCate(a,b, SL) @@ -1532,7 +1532,7 @@ hasCaty1(cond,SL) == hasCaty1(x, SL) S cond is [op,:args] and op in '(OR or %or) => - for x in args until not (S='failed) repeat S:= + for x in args until S isnt 'failed repeat S:= x is ["has",a,b] => hasCate(a,b,copy SL) -- next line is for an obscure bug in the table x is [["has",a,b]] => hasCate(a,b,copy SL) @@ -1545,7 +1545,7 @@ hasCaty1(cond,SL) == hasAttSig(d,x,SL) == -- d is domain, x a list of attributes and signatures -- the result is an augmented SL, if d has x, 'failed otherwise - for y in x until SL='failed repeat SL:= + for y in x until SL is 'failed repeat SL:= y is ['ATTRIBUTE,a] => hasAtt(d,a,SL) y is ['SIGNATURE,foo,s] => hasSig(d,foo,s,SL) keyedSystemError("S2GE0016", @@ -1553,7 +1553,7 @@ hasAttSig(d,x,SL) == SL hasSigAnd(andCls, S0, SL) == - dead := NIL + dead := nil SA := 'failed for cls in andCls while not dead repeat SA := @@ -1562,11 +1562,11 @@ hasSigAnd(andCls, S0, SL) == hasCate(subCopy(a,S0),subCopy(b,S0),copy SL) keyedSystemError("S2GE0016", ['"hasSigAnd",'"unexpected condition for signature"]) - if SA = 'failed then dead := true + if SA is 'failed then dead := true SA hasSigOr(orCls, S0, SL) == - found := NIL + found := nil SA := 'failed for cls in orCls until found repeat SA := @@ -1577,17 +1577,17 @@ hasSigOr(orCls, S0, SL) == hasSigAnd(andCls, S0, SL) keyedSystemError("S2GE0016", ['"hasSigOr",'"unexpected condition for signature"]) - if SA ~= 'failed then found := true + if SA isnt 'failed then found := true SA hasSig(dom,foo,sig,SL) == -- tests whether domain dom has function foo with signature sig -- under substitution SL $domPvar: local := nil - fun:= getConstructorAbbreviationFromDB first dom => + fun:= getConstructorAbbreviationFromDB dom.op => S0:= constructSubst dom p := ASSQ(foo,getConstructorOperationsFromDB dom.op) => - for [x,.,cond,.] in rest p until not (S='failed) repeat + for [x,.,cond,.] in rest p until S isnt 'failed repeat S:= atom cond => copy SL cond is ["has",a,b] => @@ -1598,7 +1598,7 @@ hasSig(dom,foo,sig,SL) == hasSigOr(orCls, S0, SL) keyedSystemError("S2GE0016", ['"hasSig",'"unexpected condition for signature"]) - not (S='failed) => S:= unifyStruct(subCopy(x,S0),sig,S) + S isnt 'failed => S:= unifyStruct(subCopy(x,S0),sig,S) S 'failed 'failed @@ -1607,26 +1607,26 @@ hasAtt(dom,att,SL) == -- tests whether dom has attribute att under SL -- needs S0 similar to hasSig above ?? $domPvar: local := nil - fun:= first dom => + fun := dom.op => atts:= subCopy(getConstructorAttributesFromDB fun,constructSubst dom) => - cons? (u := getInfovec first dom) => + cons? (u := getInfovec dom.op) => --UGH! New world has attributes stored as pairs not as lists!! - for [x,:cond] in atts until not (S='failed) repeat + for [x,:cond] in atts until S isnt 'failed repeat S:= unifyStruct(x,att,copy SL) - cons? cond and not (S='failed) => S := hasCatExpression(cond,S) + cons? cond and S isnt 'failed => S := hasCatExpression(cond,S) S - for [x,cond] in atts until not (S='failed) repeat + for [x,cond] in atts until S isnt 'failed repeat S:= unifyStruct(x,att,copy SL) - cons? cond and not (S='failed) => S := hasCatExpression(cond,S) + cons? cond and S isnt 'failed => S := hasCatExpression(cond,S) S 'failed 'failed hasCatExpression(cond,SL) == cond is [op,:l] and op in '(OR or %or) => - or/[(y:=hasCatExpression(x,SL)) ~= 'failed for x in l] => y + or/[(y:=hasCatExpression(x,SL)) isnt 'failed for x in l] => y cond is [op,:l] and op in '(AND and %and) => - and/[(SL:= hasCatExpression(x,SL)) ~= 'failed for x in l] => SL + and/[(SL:= hasCatExpression(x,SL)) isnt 'failed for x in l] => SL cond is ["has",a,b] => hasCate(a,b,SL) keyedSystemError("S2GE0016", ['"hasSig",'"unexpected condition for attribute"]) @@ -1637,13 +1637,13 @@ unifyStruct(s1,s2,SL) == s1=s2 => SL if s1 is [":",x,.] then s1:= x if s2 is [":",x,.] then s2:= x - if cons? s1 and first s1 = '_# then s1:= # second s1 - if cons? s2 and first s2 = '_# then s2:= # second s2 + if cons? s1 and first s1 is '_# then s1:= # second s1 + if cons? s2 and first s2 is '_# then s2:= # second s2 s1=s2 => SL isPatternVar s1 => unifyStructVar(s1,s2,SL) isPatternVar s2 => unifyStructVar(s2,s1,SL) atom s1 or atom s2 => 'failed - until null s1 or null s2 or SL='failed repeat + until null s1 or null s2 or SL is 'failed repeat SL:= unifyStruct(first s1,first s2,SL) s1:= rest s1 s2:= rest s2 @@ -1658,8 +1658,8 @@ unifyStructVar(v,s,SL) == s1 := (ps => ps; s) (s0 := LASSOC(v, SL)) or (s0 := LASSOC(v,$Subst)) => S:= unifyStruct(s0,s1,copy SL) - S='failed => - $Coerce and cons? s0 and constructor? first s0 => + S is 'failed => + $Coerce and cons? s0 and constructor? s0.op => containsVars s0 or containsVars s1 => ns0 := subCopy(s0, SL) ns1 := subCopy(s1, SL) @@ -1690,12 +1690,12 @@ unifyStructVar(v,s,SL) == ofCategory(dom,cat) == -- entry point to category evaluation from other points than type -- analysis - -- the result is true or NIL - $Subst:local:= NIL - $hope:local := NIL - IDENTP dom => NIL + -- the result is true or nil + $Subst:local:= nil + $hope:local := nil + IDENTP dom => nil cat is ['Join,:cats] => and/[ofCategory(dom,c) for c in cats] - (hasCaty(dom,cat,NIL) ~= 'failed) + (hasCaty(dom,cat,nil) isnt 'failed) printMms(mmS) == -- mmS a list of modemap signatures @@ -1704,7 +1704,7 @@ printMms(mmS) == istr := strconc('"[",STRINGIMAGE i,'"]") if #istr = 3 then istr := strconc(istr,'" ") sayMSG [:bright istr,'"signature: ",:formatSignature rest sig] - first sig='local => + first sig is 'local => sayMSG ['" implemented: local function ",imp] imp is ['XLAM,:.] => sayMSG concat('" implemented: XLAM from ", @@ -1752,28 +1752,28 @@ defaultTypeForCategory(cat, SL) == -- might not want to use this result. For example, evalMmCat1 -- calls this and should possibly fail in some cases. cat := subCopy(cat, SL) - c := first cat + c := cat.op d := getConstructorDefaultFromDB c - d => [d, :rest cat] + d => [d, :cat.args] cat is [c] => - c = 'Field => $RationalNumber + c is 'Field => $RationalNumber c in '(Ring IntegralDomain EuclideanDomain GcdDomain OrderedRing DifferentialRing) => $Integer - c = 'OrderedSet => $Symbol - c = 'FloatingPointSystem => $Float - NIL + c is 'OrderedSet => $Symbol + c is 'FloatingPointSystem => $Float + nil cat is [c,p1] => - c = 'FiniteLinearAggregate => ['Vector, p1] - c = 'VectorCategory => ['Vector, p1] - c = 'SetAggregate => ['Set, p1] - c = 'SegmentCategory => ['Segment, p1] - NIL + c is 'FiniteLinearAggregate => ['Vector, p1] + c is 'VectorCategory => ['Vector, p1] + c is 'SetAggregate => ['Set, p1] + c is 'SegmentCategory => ['Segment, p1] + nil cat is [c,p1,p2] => - NIL + nil cat is [c,p1,p2,p3] => cat is ['MatrixCategory, d, ['Vector, =d], ['Vector, =d]] => ['Matrix, d] - NIL - NIL + nil + nil diff --git a/src/interp/interop.boot b/src/interp/interop.boot index 5e4badcd..27ce88d8 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -43,7 +43,7 @@ namespace BOOT hashCode? x == integer? x -$domainTypeTokens := ['lazyOldAxiomDomain, 'oldAxiomDomain, 'oldAxiomPreCategory, +$domainTypeTokens == ['lazyOldAxiomDomain, 'oldAxiomDomain, 'oldAxiomPreCategory, 'oldAxiomCategory, 0] -- The name game. @@ -55,10 +55,10 @@ $domainTypeTokens := ['lazyOldAxiomDomain, 'oldAxiomDomain, 'oldAxiomPreCategory -- NB: (c) is for tuple-ish constructors, -- and (d) is for dependent types. -DNameStringID := 0 -DNameApplyID := 1 -DNameTupleID := 2 -DNameOtherID := 3 +DNameStringID == 0 +DNameApplyID == 1 +DNameTupleID == 2 +DNameOtherID == 3 DNameToSExpr1 dname == null dname => error "unexpected domain name" @@ -66,16 +66,16 @@ DNameToSExpr1 dname == makeSymbol(CompStrToString rest dname) name0 := DNameToSExpr1 second dname args := rest rest dname - name0 = '_-_> => + name0 is '_-_> => froms := first args froms := MAPCAR(function DNameToSExpr, rest froms) ret := second args -- a tuple ret := DNameToSExpr second ret -- contents ['Mapping,:[ret,:froms]] - name0 = 'Union or name0 = 'Record => + name0 is 'Union or name0 is 'Record => sxs := MAPCAR(function DNameToSExpr, rest first args) [name0,:sxs] - name0 = 'Enumeration => + name0 is 'Enumeration => [name0,:MAPCAR(function DNameFixEnum, rest first args)] [name0,:MAPCAR(function DNameToSExpr, args)] @@ -90,16 +90,16 @@ DNameFixEnum arg == CompStrToString rest arg SExprToDName(sexpr, cosigVal) == -- is it a non-type valued object? - NOT cosigVal => [DNameOtherID, :sexpr] - if first sexpr = '_: then sexpr := third sexpr - first sexpr = 'Mapping => + not cosigVal => [DNameOtherID, :sexpr] + if first sexpr is '_: then sexpr := third sexpr + first sexpr is 'Mapping => args := [ SExprToDName(sx,true) for sx in rest sexpr] [DNameApplyID, [DNameStringID,: StringToCompStr '"->"], [DNameTupleID, : rest args], [DNameTupleID, first args]] name0 := [DNameStringID, : StringToCompStr symbolName first sexpr] - first sexpr = 'Union or first sexpr = 'Record => + first sexpr is 'Union or first sexpr is 'Record => [DNameApplyID, name0, [DNameTupleID,: [ SExprToDName(sx,true) for sx in rest sexpr]]] newCosig := rest getDualSignatureFromDB first sexpr @@ -116,7 +116,7 @@ CompStrToString(str) == runOldAxiomFunctor(:allArgs) == [:args,env] := allArgs - getConstructorKindFromDB env = "category" => + getConstructorKindFromDB env is "category" => [$oldAxiomPreCategoryDispatch,: [env, :args]] dom:=apply(env, args) makeOldAxiomDispatchDomain dom @@ -124,7 +124,7 @@ runOldAxiomFunctor(:allArgs) == makeLazyOldAxiomDispatchDomain domform == attribute? domform => [$attributeDispatch, domform, hashString(symbolName domform)] - getConstructorKindFromDB opOf domform = "category" => + getConstructorKindFromDB opOf domform is "category" => [$oldAxiomPreCategoryDispatch,: domform] dd := [$lazyOldAxiomDomainDispatch, hashTypeForm(domform,0), domform] append!(dd,dd) -- installs back pointer to head of domain. @@ -284,10 +284,10 @@ getCatAncestors x == [CAAR y for y in parentsOf opOf x] listOfEntries form == atom form => form form is [op,:l] => - op = 'Join => "append"/[listOfEntries x for x in l] - op = 'CATEGORY => listOfCategoryEntries rest l - op = 'PROGN => listOfCategoryEntries l - op = 'ATTRIBUTE and first l is [f,:.] and constructor? f => [first l] + op is 'Join => "append"/[listOfEntries x for x in l] + op is 'CATEGORY => listOfCategoryEntries rest l + op is 'PROGN => listOfCategoryEntries l + op is 'ATTRIBUTE and first l is [f,:.] and constructor? f => [first l] op in '(ATTRIBUTE SIGNATURE) => nil [form] categoryFormatError() @@ -296,10 +296,10 @@ listOfCategoryEntries l == null l => nil l is [[op,:u],:v] => firstItemList:= - op = 'ATTRIBUTE and first u is [f,:.] and constructor? f => + op is 'ATTRIBUTE and first u is [f,:.] and constructor? f => [first u] op in '(ATTRIBUTE SIGNATURE) => nil - op = 'IF and u is [pred,conseq,alternate] => + op is 'IF and u is [pred,conseq,alternate] => listOfCategoryEntriesIf(pred,conseq,alternate) categoryFormatError() [:firstItemList,:listOfCategoryEntries v] @@ -352,12 +352,12 @@ instantiate domenv == hashTypeForm([fn,: args], percentHash) == hashType([fn,:devaluateList args], percentHash) -$hashOp1 := hashString '"1" -$hashOp0 := hashString '"0" -$hashOpApply := hashString '"apply" -$hashOpSet := hashString '"set!" -$hashSeg := hashString '".." -$hashPercent := hashString '"%" +$hashOp1 == hashString '"1" +$hashOp0 == hashString '"0" +$hashOpApply == hashString '"apply" +$hashOpSet == hashString '"set!" +$hashSeg == hashString '".." +$hashPercent == hashString '"%" oldAxiomDomainLookupExport _ (domenv, self, op, sig, box, skipdefaults, env) == @@ -417,7 +417,7 @@ basicLookupCheckDefaults(op,sig,domain,dollar) == first SPADCALL(rest dollar, dollar, op, hashSig, box, not $lookupDefaults, lookupFun) first SPADCALL(rest dollar, dollar, op, sig, box, not $lookupDefaults, lookupFun) -$hasCatOpHash := hashString '"%%" +$hasCatOpHash == hashString '"%%" opIsHasCat op == hashCode? op => scalarEq?(op, $hasCatOpHash) op = "%%" |