From a4a45e923a2435574c09619da442fd15e71b2652 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Mon, 18 Apr 2011 17:41:01 +0000 Subject: cleanup --- src/interp/br-op2.boot | 2 +- src/interp/compiler.boot | 113 +++++++++++++++++++++---------------------- src/interp/define.boot | 41 ++++++++-------- src/interp/g-util.boot | 3 +- src/interp/nrunfast.boot | 121 ++++++++++++++++++++++++----------------------- 5 files changed, 144 insertions(+), 136 deletions(-) (limited to 'src/interp') diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index e6b3de61..399c58fd 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -148,7 +148,7 @@ dbGetFormFromDocumentation(op,sig,x) == string? doc and (stringPrefix?('"\spad{",doc) and (k := 6) or stringPrefix?('"\s{",doc) and (k := 3)) => - n := charPosition($charRbrace,doc,k) + n := charPosition(char "}",doc,k) s := subString(doc,k,n - k) parse := ncParseFromString s parse is [=op,:.] and #parse = #sig => parse diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 5ab85ec7..67dd361c 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -190,8 +190,8 @@ comp3(x,m,$e) == atom x => compAtom(x,m,e) op:= x.op getmode(op,e) is ["Mapping",:ml] and (u:= applyMapping(x,m,e,ml)) => u - op=":" => compColon(x,m,e) - op="::" => compCoerce(x,m,e) + op is ":" => compColon(x,m,e) + op is "::" => compCoerce(x,m,e) not ($insideCompTypeOf=true) and stringPrefix?('"TypeOf",PNAME op) => compTypeOf(x,m,e) t:= compExpression(x,m,e) @@ -216,7 +216,7 @@ emitLocalCallInsn(op,args,e) == [op',:args,"$"] applyMapping([op,:argl],m,e,ml) == - #argl~=#ml-1 => nil + #argl ~= #ml-1 => nil isCategoryForm(first ml,e) => --is op a functor? pairlis:= pairList($FormalMapVariableList,argl) @@ -230,7 +230,7 @@ applyMapping([op,:argl],m,e,ml) == argl':= [T.expr for x in argl for m' in rest ml] where T() == [.,.,e]:= comp(x,m',e) or return "failed" - if argl'="failed" then return nil + if argl' is "failed" then return nil form:= atom op and not(op in $formalArgList) and null (u := get(op,"value",e)) => emitLocalCallInsn(op,argl',e) @@ -347,13 +347,13 @@ finishLambdaExpression(expr is ["LAMBDA",vars,.],env) == compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) == $killOptimizeIfTrue: local:= true - e:= oldE + e := oldE isFunctor x => if get(x,"modemap",$CategoryFrame) is [[[.,target,:argModeList],.],:.] and (and/[extendsCategoryForm("$",s,mode) for mode in argModeList for s in sl] ) and extendsCategoryForm("$",target,m') then return [x,m,e] x is ["+->",:.] => compLambda(x,m,oldE) - if string? x then x:= makeSymbol x + if string? x then x := makeSymbol x for m in sl for v in (vl:= take(#sl,$FormalMapVariableList)) repeat [.,.,e]:= compMakeDeclaration(v,m,e) (vl ~= nil) and not hasFormalMapVariable(x, vl) => return @@ -392,10 +392,10 @@ compAtomWithModemap(x,m,e,mmList) == CATCH("compUniquely", compForm3([x],m,e,mmList)) compAtom(x,m,e) == - x = "break" => compBreak(x,m,e) - x = "iterate" => compIterate(x,m,e) - T:= IDENTP x and compAtomWithModemap(x,m,e,get(x,"modemap",e)) => T - t:= + x is "break" => compBreak(x,m,e) + x is "iterate" => compIterate(x,m,e) + T := IDENTP x and compAtomWithModemap(x,m,e,get(x,"modemap",e)) => T + t := IDENTP x => compSymbol(x,m,e) or return nil member(m,$IOFormDomains) and primitiveType x => [x,m,e] string? x => [x,x,e] @@ -406,23 +406,23 @@ primitiveType x == x is nil => $EmptyMode string? x => $String integer? x => - x=0 => $NonNegativeInteger - x>0 => $PositiveInteger + x = 0 => $NonNegativeInteger + x > 0 => $PositiveInteger $Integer FLOATP x => $DoubleFloat nil compSymbol(s,m,e) == - s="$NoValue" => ["$NoValue",$NoValueMode,e] + s is "$NoValue" => ["$NoValue",$NoValueMode,e] isFluid s => [s,getmode(s,e) or return nil,e] - s=m or isLiteral(s,e) => [["QUOTE",s],s,e] + sameObject?(s,m) or isLiteral(s,e) => [["QUOTE",s],s,e] v := get(s,"value",e) => MEMQ(s,$functorLocalParameters) => NRTgetLocalIndex s [s,v.mode,e] --s will be replaced by an ELT form in beforeCompile [s,v.mode,e] --s has been SETQd - m':= getmode(s,e) => + m' := getmode(s,e) => if not MEMQ(s,$formalArgList) and not MEMQ(s,$FormalMapVariableList) and not isFunction(s,e) and null ($compForModeIfTrue=true) then errorRef s [s,m',e] --s is a declared argument @@ -437,12 +437,12 @@ compSymbol(s,m,e) == hasUniqueCaseView(x,m,e) == props := getProplist(x,e) for [p,:v] in props repeat - p = "condition" and v is [["case",.,t],:.] => return modeEqual(t,m) - p = "value" => return false + p is "condition" and v is [["case",.,t],:.] => return modeEqual(t,m) + p is "value" => return false convertOrCroak(T,m) == - u:= convert(T,m) => u + u := convert(T,m) => u userError ['"CANNOT CONVERT: ",T.expr,"%l",'" OF MODE: ",T.mode,"%l", '" TO MODE: ",m,"%l"] @@ -450,7 +450,7 @@ convert(T,m) == coerce(T,resolve(T.mode,m) or return nil) mkUnion(a,b) == - b="$" and $Rep is ["Union",:l] => b + b is "$" and $Rep is ["Union",:l] => b a is ["Union",:l] => b is ["Union",:l'] => ["Union",:union(l,l')] ["Union",:union([b],l)] @@ -467,7 +467,7 @@ hasType(x,e) == --% General Forms compForm(form,m,e) == - T:= + T := compForm1(form,m,e) or compArgumentsAndTryAgain(form,m,e) or return stackMessageIfNone ["cannot compile","%b",form,"%d"] T @@ -478,8 +478,8 @@ compArgumentsAndTryAgain(form is [.,:argl],m,e) == -- modemap with selector b form is ["elt",a,.] => ([.,.,e]:= comp(a,$EmptyMode,e) or return nil; compForm1(form,m,e)) - u:= for x in argl repeat [.,.,e]:= comp(x,$EmptyMode,e) or return "failed" - u="failed" => nil + u := for x in argl repeat [.,.,e]:= comp(x,$EmptyMode,e) or return "failed" + u is "failed" => nil compForm1(form,m,e) outputComp(x,e) == @@ -633,10 +633,10 @@ getFormModemaps(form is [op,:argl],e) == -- current domain. if $insideCategoryPackageIfTrue then modemapList := [x for x in modemapList | x.mmDC isnt '$] - if op="elt" + if op is "elt" then modemapList:= eltModemapFilter(last argl,modemapList,e) or return nil else - if op="setelt" then modemapList:= + if op is "setelt" then modemapList:= seteltModemapFilter(second argl,modemapList,e) or return nil nargs := #argl finalModemapList:= [mm for mm in modemapList @@ -660,10 +660,11 @@ checkCallingConvention(sigs,nargs) == for t in rest sig for i in 0.. repeat isQuasiquote t => - v.i < 0 => userError '"flag argument restriction violation" - v.i := v.i + 1 - v.i > 0 => userError '"flag argument restriction violation" - v.i := v.i - 1 + arrayRef(v,i) < 0 => + userError '"flag argument restriction violation" + arrayRef(v,i) := arrayRef(v,i) + 1 + arrayRef(v,i) > 0 => userError '"flag argument restriction violation" + arrayRef(v,i) := arrayRef(v,i) - 1 v @@ -699,12 +700,12 @@ compApplication(op,argl,m,T) == emitLocalCallInsn(T.expr,[a.expr for a in argTl],e) ['%call, ['applyFun, T.expr], :[a.expr for a in argTl]] coerce([form, retm, e],resolve(retm,m)) - op = 'elt => nil + op is 'elt => nil eltForm := ['elt, op, :argl] comp(eltForm, m, e) compToApply(op,argl,m,e) == - T:= compNoStacking(op,$EmptyMode,e) or return nil + T := compNoStacking(op,$EmptyMode,e) or return nil T.expr is ["QUOTE", =T.mode] => nil compApplication(op,argl,m,T) @@ -783,8 +784,8 @@ compSetq1(form,val,m,E) == [.,.,E']:= compMakeDeclaration(x,y,E) compSetq1(x,val,m,E') form is [op,:l] => - op="CONS" => setqMultiple(uncons form,val,m,E) - op="%Comma" => setqMultiple(l,val,m,E) + op is "CONS" => setqMultiple(uncons form,val,m,E) + op is "%Comma" => setqMultiple(l,val,m,E) setqSetelt(form,val,m,E) compMakeDeclaration: (%Form,%Mode,%Env) -> %Maybe %Triple @@ -930,7 +931,7 @@ compWhere([.,form,:exprList],m,eInit) == for item in exprList repeat recordDeclarationInSideCondition(item,e) [.,.,e]:= comp(item,$EmptyMode,e) or return "failed" - u="failed" => return nil + u is "failed" => return nil $insideWhereIfTrue := false [x,m,eAfter] := comp(macroExpand(form,eBefore := e),m,e) or return nil eFinal := @@ -969,13 +970,13 @@ compList: (%Form,%Mode,%Env) -> %Maybe %Triple compList(l,m is ["List",mUnder],e) == null l => ['%nil,m,e] Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l] - Tl="failed" => nil - T:= [['%list,:[T.expr for T in Tl]],["List",mUnder],e] + Tl is "failed" => nil + T := [['%list,:[T.expr for T in Tl]],["List",mUnder],e] compVector: (%Form,%Mode,%Env) -> %Maybe %Triple compVector(l,m is ["Vector",mUnder],e) == - Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l] - Tl="failed" => nil + Tl := [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l] + Tl is "failed" => nil [["MAKE-ARRAY", #Tl, KEYWORD::ELEMENT_-TYPE, quoteForm getVMType mUnder, KEYWORD::INITIAL_-CONTENTS, ['%list, :[T.expr for T in Tl]]],m,e] @@ -1100,7 +1101,7 @@ jumpFromLoop(kind,key) == compBreak: (%Symbol,%Mode,%Env) -> %Maybe %Triple compBreak(x,m,e) == - x ~= "break" or not jumpFromLoop("REPEAT",x) => nil + x isnt "break" or not jumpFromLoop("REPEAT",x) => nil index:= #$exitModeStack-1-$leaveLevelStack.0 $breakCount := $breakCount + 1 u := coerce(["$NoValue",$Void,e],$exitModeStack.index) or return nil @@ -1110,7 +1111,7 @@ compBreak(x,m,e) == compIterate: (%Symbol,%Mode,%Env) -> %Maybe %Triple compIterate(x,m,e) == - x ~= "iterate" or not jumpFromLoop("REPEAT",x) => nil + x isnt "iterate" or not jumpFromLoop("REPEAT",x) => nil index := #$exitModeStack - 1 - ($leaveLevelStack.0 + 1) $iterateCount := $iterateCount + 1 u := coerce(['%nil,'$Void,e],$exitModeStack.index) or return nil @@ -1165,9 +1166,9 @@ compTry(['%Try,x,ys,z],m,e) == ++ `op' supposedly designate an external entity with language linkage ++ `lang'. Return the mode of its local declaration (import). getExternalSymbolMode(op,lang,e) == - lang = 'Builtin => "%Thing" -- for the time being - lang = 'Lisp => "%Thing" -- for the time being - lang ~= "C" => + lang is 'Builtin => "%Thing" -- for the time being + lang is 'Lisp => "%Thing" -- for the time being + lang is "C" => stackAndThrow('"Sorry: %b Foreign %1b %d is invalid at the moment",[lang]) get(op,"%Lang",e) ~= lang => stackAndThrow('"%1bp is not known to have language linkage %2bp",[op,lang]) @@ -1176,7 +1177,7 @@ getExternalSymbolMode(op,lang,e) == compElt: (%Form,%Mode,%Env) -> %Maybe %Triple compElt(form,m,E) == form isnt ["elt",aDomain,anOp] => compForm(form,m,E) - aDomain="Lisp" or (aDomain is ["Foreign",lang] and lang="Builtin") => + aDomain is "Lisp" or (aDomain is ["Foreign",lang] and lang="Builtin") => [anOp',m,E] where anOp'() == (anOp = $Zero => 0; anOp = $One => 1; anOp) lang ~= nil => opMode := getExternalSymbolMode(anOp,lang,E) @@ -1251,12 +1252,12 @@ canReturn(expr,level,exitCount,ValueFlag) == --SPAD: exit and friends atom expr => ValueFlag and level=exitCount op := expr.op op in '(QUOTE CLOSEDFN) => ValueFlag and level=exitCount - op="TAGGEDexit" => + op is "TAGGEDexit" => expr is [.,count,data] => canReturn(data.expr,level,count,count=level) level=exitCount and not ValueFlag => nil - op="SEQ" => or/[canReturn(u,level+1,exitCount,false) for u in rest expr] - op="TAGGEDreturn" => nil - op="CATCH" => + op is "SEQ" => or/[canReturn(u,level+1,exitCount,false) for u in rest expr] + op is "TAGGEDreturn" => nil + op is "CATCH" => [.,gs,data]:= expr (findThrow(gs,data,level,exitCount,ValueFlag) => true) where findThrow(gs,expr,level,exitCount,ValueFlag) == @@ -1267,12 +1268,12 @@ canReturn(expr,level,exitCount,ValueFlag) == --SPAD: exit and friends or/[findThrow(gs,u,level+1,exitCount,ValueFlag) for u in l] or/[findThrow(gs,u,level,exitCount,ValueFlag) for u in rest expr] canReturn(data,level,exitCount,ValueFlag) - op = '%when => + op is '%when => level = exitCount => or/[canReturn(last u,level,exitCount,ValueFlag) for u in rest expr] or/[or/[canReturn(u,level,exitCount,ValueFlag) for u in v] for v in rest expr] - op="IF" => + op is "IF" => expr is [.,a,b,c] if not canReturn(a,0,0,true) then SAY "IF statement can not cause consequents to be executed" @@ -1302,7 +1303,7 @@ compPredicate(p,E) == [p',m,getSuccessEnvironment(p,E),getInverseEnvironment(p,E)] compFromIf(a,m,E) == - a="%noBranch" => ["%noBranch",m,E] + a is "%noBranch" => ["%noBranch",m,E] comp(a,m,E) compImport: (%Form,%Mode,%Env) -> %Triple @@ -1617,9 +1618,9 @@ tryCourtesyCoercion(T,m) == '"function coerce called from the interpreter."]) if $useRepresentationHack then T.rest.first := MSUBST("$",$Rep,second T) - T':= coerceEasy(T,m) => T' - T':= coerceSubset(T,m) => T' - T':= coerceHard(T,m) => T' + T' := coerceEasy(T,m) => T' + T' := coerceSubset(T,m) => T' + T' := coerceHard(T,m) => T' nil coerce(T,m) == @@ -1691,7 +1692,7 @@ coerceHard(T,m) == $bootStrapMode = true => [T.expr,m,$e] extendsCategoryForm(T.expr,T.mode,m) => [T.expr,m,$e] coerceExtraHard(T,m) - (m' = "$" and m = $functorForm) or (m' = $functorForm and m = "$") => + (m' is "$" and m = $functorForm) or (m' = $functorForm and m = "$") => [T.expr,m,$e] coerceExtraHard(T,m) @@ -1754,7 +1755,7 @@ compCoerce(["::",x,m'],m,e) == ++ checked courtesy coercion to `sub'. coerceSuperset: (%Triple, %Mode) -> %Maybe %Triple coerceSuperset(T,sub) == - sub = "$" => + sub is "$" => T' := coerceSuperset(T,$functorForm) or return nil T'.rest.first := "$" T' @@ -2273,7 +2274,7 @@ numberize x == ++ If there is a local reference to mode `m', return it. localReferenceIfThere m == - m = "$" => m + m is "$" => m idx := NRTassocIndex m => ['%tref,'$,idx] quoteForm m diff --git a/src/interp/define.boot b/src/interp/define.boot index 38f6e9c9..352d1aef 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -135,9 +135,9 @@ makeDomainTemplate vec == -- (slot 0 of the infovec); called by getInfovecCode from compDefineFunctor1 newVec := newShell # vec for index in 0..maxIndex vec repeat - item := vec.index + item := vectorRef(vec,index) null item => nil - newVec.index := + vectorRef(newVec,index) := atom item => item cons? first item => makeGoGetSlot(item,index) item @@ -321,9 +321,9 @@ extendsCategoryBasic0(dom,u,v) == v is ['IF,p,['ATTRIBUTE,c],.] => uVec := (compMakeCategoryObject(u,$EmptyEnvironment)).expr cons? c and isCategoryForm(c,nil) => - slot4 := uVec.4 + slot4 := vectorRef(uVec,4) LASSOC(c,second slot4) is [=p,:.] - slot2 := uVec.2 + slot2 := vectorRef(uVec,2) LASSOC(c,slot2) is [=p,:.] extendsCategoryBasic(dom,u,v) @@ -333,7 +333,7 @@ extendsCategoryBasic(dom,u,v) == uVec := (compMakeCategoryObject(u,$EmptyEnvironment)).expr isCategoryForm(v,nil) => catExtendsCat?(u,v,uVec) v is ['SIGNATURE,op,sig] => - or/[uVec.i is [[=op,=sig],:.] for i in 6..maxIndex uVec] + or/[vectorRef(uVec,i) is [[=op,=sig],:.] for i in 6..maxIndex uVec] u is ['CATEGORY,.,:l] => v is ['IF,:.] => member(v,l) nil @@ -342,7 +342,7 @@ extendsCategoryBasic(dom,u,v) == catExtendsCat?(u,v,uvec) == u = v => true uvec := uvec or (compMakeCategoryObject(u,$EmptyEnvironment)).expr - slot4 := uvec.4 + slot4 := vectorRef(uvec,4) prinAncestorList := first slot4 member(v,prinAncestorList) => true vOp := KAR v @@ -720,7 +720,7 @@ mkCategoryPackage(form is [op,:argl],cat,def) == x is ['DEF,y,:.] => [y,:oplist] fn(x.args,fn(x.op,oplist)) catvec := eval mkEvalableCategoryForm form - fullCatOpList:=(JoinInner([catvec],$e)).1 + fullCatOpList := vectorRef(JoinInner([catvec],$e),1) catOpList := [['SIGNATURE,op1,sig] for [[op1,sig],:.] in fullCatOpList | assoc(op1,capsuleDefAlist)] @@ -926,9 +926,10 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], $implicitParameters: local := inferConstructorImplicitParameters(argl,$e) [ds,.,$e]:= compMakeCategoryObject(target,$e) or return stackAndThrow('" cannot produce category object: %1pb",[target]) - $compileExportsOnly => compDefineExports(form, ds.1, signature',$e) + $compileExportsOnly => + compDefineExports(form, vectorRef(ds,1), signature',$e) $domainShell: local := COPY_-SEQ ds - attributeList := ds.2 --see below under "loadTimeAlist" + attributeList := vectorRef(ds,2) --see below under "loadTimeAlist" $condAlist: local := nil $uncondAlist: local := nil $NRTslot1PredicateList: local := predicatesFromAttributes attributeList @@ -998,7 +999,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], $functorTarget is ["CATEGORY",key,:.] and key~="domain" => 'package 'domain $lisplibForm:= form - if null $bootStrapMode then + if not $bootStrapMode then $NRTslot1Info := NRTmakeSlot1Info() $isOpPackageName: local := isCategoryPackageName $op if $isOpPackageName then lisplibWrite('"slot1DataBase", @@ -1160,18 +1161,20 @@ genDomainViewList(id,catlist) == mkOpVec(dom,siglist) == dom:= getPrincipalView dom - substargs:= [['$,:dom.0],:pairList($FormalMapVariableList,rest dom.0)] + substargs := [['$,:vectorRef(dom,0)], + :pairList($FormalMapVariableList,rest vectorRef(dom,0))] oplist:= getConstructorOperationsFromDB opOf dom.0 --new form is ( ) ops := newVector #siglist for (opSig:= [op,sig]) in siglist for i in 0.. repeat u:= ASSQ(op,oplist) - assoc(sig,u) is [.,n,.,'ELT] => ops.i := dom.n + assoc(sig,u) is [.,n,.,'ELT] => + vectorRef(ops,i) := vectorRef(dom,n) noplist:= SUBLIS(substargs,u) -- following variation on assoc needed for GENSYMS in Mutable domains AssocBarGensym(substitute(dom.0,'$,sig),noplist) is [.,n,.,'ELT] => - ops.i := dom.n - ops.i := [function Undef,[dom.0,i],:opSig] + vectorRef(ops,i) := vectorRef(dom,n) + vectorRef(ops,i) := [function Undef,[dom.0,i],:opSig] ops @@ -1359,7 +1362,7 @@ candidateSignatures(op,nmodes,slot1) == ++ is exported. Return the complete signature if yes; otherwise ++ return nil, with diagnostic in ambiguity case. hasSigInTargetCategory(argl,form,opsig,e) == - sigs := candidateSignatures($op,#form,$domainShell.1) + sigs := candidateSignatures($op,#form,vectorRef($domainShell,1)) cc := checkCallingConvention(sigs,#argl) mList:= [(cc.i > 0 => quasiquote x; getArgumentMode(x,e)) for x in argl for i in 0..] @@ -1501,18 +1504,18 @@ compile u == -- If just updating certain functions, check for previous existence. -- Deduce old sequence number and use it (items have been skipped). if $LISPLIB and $compileOnlyCertainItems then - parts := splitEncodedFunctionName(u.0, ";") + parts := splitEncodedFunctionName(u.op, ";") -- Next line JHD/SMWATT 7/17/86 to deal with inner functions - parts='inner => $savableItems:=[u.0,:$savableItems] + parts='inner => $savableItems:=[u.op,:$savableItems] unew := nil for [s,t] in $splitUpItemsAlreadyThere repeat if parts.0=s.0 and parts.1=s.1 and parts.2=s.2 then unew := t null unew => sayBrightly ['" Error: Item did not previously exist"] - sayBrightly ['" Item not saved: ", :bright u.0] + sayBrightly ['" Item not saved: ", :bright u.op] sayBrightly ['" What's there is: ", $lisplibItemsAlreadyThere] nil - sayBrightly ['" Renaming ", u.0, '" as ", unew] + sayBrightly ['" Renaming ", u.op, '" as ", unew] u := [unew, :rest u] $savableItems := [unew, :$saveableItems] -- tested by embedded RWRITE optimizedBody:= optimizeFunctionDef u diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 73d2e4a0..ba63390b 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -109,7 +109,8 @@ isSharpVarWithNum x == ++ Returns true if `x' is either an atom or a quotation. atomic? x == - not cons? x or x.op = 'QUOTE + cons? x => x.op is 'QUOTE + true --% Sub-domains information handlers diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index 216521a9..36aa4372 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -61,15 +61,15 @@ initNewWorld() == $doNotCompressHashTableIfTrue := true isNewWorldDomain domain == - integer? domain.3 --see HasCategory/Attribute + integer? vectorRef(domain,3) --see HasCategory/Attribute getDomainByteVector dom == - CDDR dom.4 + CDDR vectorRef(dom,4) ++ Return the sequence of categories `dom' belongs to, as a vector ++ of lazy category forms. getDomainCategoriesVector dom == - second(dom.4) + second vectorRef(dom,4) ++ Same as getDomainCategoriesVector except that we return a list of ++ input forms for the categories. @@ -77,7 +77,7 @@ getDomainCompleteCategories dom == vec := getDomainCategoriesVector dom cats := nil for i in 0..maxIndex vec repeat - cats := [newExpandLocalType(vec.i,dom,dom), :cats] + cats := [newExpandLocalType(vectorRef(vec,i),dom,dom), :cats] nreverse cats getOpCode(op,vec,max) == @@ -91,8 +91,8 @@ evalSlotDomain(u,dollar) == $returnNowhereFromGoGet: local := false $ : fluid := dollar -- ??? substitute $lookupDefaults : local := false -- new world - u = '$ => dollar - u = "$$" => dollar + u is '$ => dollar + u is "$$" => dollar integer? u => y := dollar.u vector? y => y @@ -133,17 +133,17 @@ replaceGoGetSlot env == [thisDomain,index,:op] := env thisDomainForm := devaluate thisDomain bytevec := getDomainByteVector thisDomain - numOfArgs := bytevec.index - goGetDomainSlotIndex := bytevec.(index := index + 1) + numOfArgs := arrayRef(bytevec,index) + goGetDomainSlotIndex := arrayRef(bytevec,index := index + 1) goGetDomain := goGetDomainSlotIndex = 0 => thisDomain - thisDomain.goGetDomainSlotIndex + vectorRef(thisDomain,goGetDomainSlotIndex) if cons? goGetDomain then goGetDomain := lazyDomainSet(goGetDomain,thisDomain,goGetDomainSlotIndex) sig := - [newExpandTypeSlot(bytevec.(index := index + 1),thisDomain,thisDomain) + [newExpandTypeSlot(arrayRef(bytevec,index := index + 1),thisDomain,thisDomain) for i in 0..numOfArgs] - thisSlot := bytevec.(index + 1) + thisSlot := arrayRef(bytevec,index + 1) if $monitorNewWorld then sayLooking(concat('"%l","..",form2String thisDomainForm, '" wants",'"%l",'" "),op,sig,goGetDomain) @@ -183,7 +183,7 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) == '"----> searching op table for:","%l"," "),op,sig,dollar) someMatch := false numvec := getDomainByteVector domain - predvec := domain.3 + predvec := vectorRef(domain,3) max := maxIndex opvec k := getOpCode(op,opvec,max) or return flag => newLookupInAddChain(op,sig,domain,dollar) @@ -202,8 +202,8 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) == while finish > start repeat PROGN i := start - numArgs ~= (numTableArgs :=numvec.i) => nil - predIndex := numvec.(i := i + 1) + numArgs ~= (numTableArgs := arrayRef(numvec,i)) => nil + predIndex := arrayRef(numvec,i := i + 1) predIndex ~= 0 and not testBitVector(predvec,predIndex) => nil loc := newCompareSig(sig,numvec,(i := i + 1),dollar,domain) null loc => nil --signifies no match @@ -213,13 +213,13 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) == i := start + 2 someMatch := true --mark so that if subsumption fails, look for original subsumptionSig := - [newExpandTypeSlot(numvec.(QSPLUS(i,j)), + [newExpandTypeSlot(arrayRef(numvec,QSPLUS(i,j)), dollar,domain) for j in 0..numTableArgs] if $monitorNewWorld then sayBrightly [formatOpSignature(op,sig),'"--?-->", formatOpSignature(op,subsumptionSig)] nil - slot := domain.loc + slot := vectorRef(domain,loc) cons? slot => slot.op = 'newGoGet => someMatch:=true --treat as if operation were not there @@ -247,16 +247,17 @@ newLookupInTable(op,sig,dollar,[domain,opvec],flag) == -- Lookup In Domain (from lookupInAddChain) --======================================================= lookupInDomain(op,sig,addFormDomain,dollar,index) == - addFormCell := addFormDomain.index => + addFormCell := vectorRef(addFormDomain,index) => integer? KAR addFormCell => or/[lookupInDomain(op,sig,addFormDomain,dollar,i) for i in addFormCell] - if not vector? addFormCell then addFormCell := eval addFormCell + if not vector? addFormCell then + addFormCell := eval addFormCell lookupInDomainVector(op,sig,addFormCell,dollar) nil --------------------> NEW DEFINITION (see interop.boot.pamphlet) lookupInDomainVector(op,sig,domain,dollar) == - slot1 := domain.1 + slot1 := vectorRef(domain,1) SPADCALL(op,sig,dollar,slot1) @@ -290,7 +291,8 @@ newLookupInDomain(op,sig,addFormDomain,dollar,index) == addFormCell := addFormDomain.index => integer? KAR addFormCell => or/[newLookupInDomain(op,sig,addFormDomain,dollar,i) for i in addFormCell] - if not vector? addFormCell then lazyDomainSet(addFormCell,addFormDomain,index) + if not vector? addFormCell then + lazyDomainSet(addFormCell,addFormDomain,index) lookupInDomainVector(op,sig,addFormDomain.index,dollar) nil @@ -298,30 +300,30 @@ newLookupInDomain(op,sig,addFormDomain,dollar,index) == -- Category Default Lookup (from goGet or lookupInAddChain) --======================================================= newLookupInCategories(op,sig,dom,dollar) == - slot4 := dom.4 + slot4 := vectorRef(dom,4) catVec := second slot4 # catVec = 0 => nil --early exit if no categories - integer? KDR catVec.0 => + integer? KDR vectorRef(catVec,0) => newLookupInCategories1(op,sig,dom,dollar) --old style $lookupDefaults : local := nil if $monitorNewWorld = true then sayBrightly concat('"----->", form2String devaluate dom,'"-----> searching default packages for ",op) - predvec := dom.3 + predvec := vectorRef(dom,3) packageVec := first slot4 --the next three lines can go away with new category world varList := ['$,:$FormalMapVariableList] - valueList := [dom,:[dom.(5+i) for i in 1..(# rest dom.0)]] + valueList := [dom,:[vectorRef(dom,5+i) for i in 1..(# rest dom.0)]] valueList := [MKQ val for val in valueList] nsig := MSUBST(dom.0,dollar.0,sig) for i in 0..maxIndex packageVec | - (entry := packageVec.i) and entry ~= 'T repeat + (entry := vectorRef(packageVec,i)) and entry ~= 'T repeat package := vector? entry => if $monitorNewWorld then sayLooking1('"already instantiated cat package",entry) entry IDENTP entry => - cat := catVec.i + cat := vectorRef(catVec,i) packageForm := nil if not GETL(entry,'LOADED) then loadLib entry infovec := GETL(entry,'infovec) @@ -341,7 +343,7 @@ newLookupInCategories(op,sig,dom,dollar) == --numOfArgs ~= #sig.source => nil packageForm := [entry,'$,:rest cat] package := evalSlotDomain(packageForm,dom) - packageVec.i := package + vectorRef(packageVec,i) := package package ----old world table := HGET($Slot1DataBase,entry) or systemError nil @@ -349,7 +351,7 @@ newLookupInCategories(op,sig,dom,dollar) == and (v := or/[rest x for x in u | #sig = #x.0]) => packageForm := [entry,'$,:rest cat] package := evalSlotDomain(packageForm,dom) - packageVec.i := package + vectorRef(packageVec,i) := package package nil not success => @@ -373,7 +375,7 @@ newLookupInCategories(op,sig,dom,dollar) == nil nrunNumArgCheck(num,bytevec,start,finish) == - args := bytevec.start + args := arrayRef(bytevec,start) num = args => true (start := start + args + 4) = finish => nil nrunNumArgCheck(num,bytevec,start,finish) @@ -382,16 +384,16 @@ newLookupInCategories1(op,sig,dom,dollar) == $lookupDefaults : local := nil if $monitorNewWorld = true then sayBrightly concat('"----->", form2String devaluate dom,'"-----> searching default packages for ",op) - predvec := dom.3 - slot4 := dom.4 + predvec := vectorRef(dom,3) + slot4 := vectorRef(dom,4) packageVec := first slot4 - catVec := first rest slot4 + catVec := second slot4 --the next three lines can go away with new category world varList := ['$,:$FormalMapVariableList] - valueList := [dom,:[dom.(5+i) for i in 1..(# rest dom.0)]] + valueList := [dom,:[vectorRef(dom,5+i) for i in 1..(# rest dom.0)]] valueList := [MKQ val for val in valueList] nsig := MSUBST(dom.0,dollar.0,sig) - for i in 0..maxIndex packageVec | (entry := packageVec.i) + for i in 0..maxIndex packageVec | (entry := vectorRef(packageVec,i)) and (vector? entry or (predIndex := rest (node := catVec.i)) and (predIndex = 0 or testBitVector(predvec,predIndex))) repeat package := @@ -411,18 +413,18 @@ newLookupInCategories1(op,sig,dom,dollar) == code := getOpCode(op,opvec,max) null code => nil byteVector := CDDR infovec.3 - numOfArgs := byteVector.(opvec.code) + numOfArgs := arrayRef(byteVector,opvec.code) numOfArgs ~= #sig.source => nil packageForm := [entry,'$,:rest cat] package := evalSlotDomain(packageForm,dom) - packageVec.i := package + vectorRef(packageVec,i) := package package table := HGET($Slot1DataBase,entry) or systemError nil (u := LASSQ(op,table)) and (v := or/[rest x for x in u | #sig = #x.0]) => packageForm := [entry,'$,:rest cat] package := evalSlotDomain(packageForm,dom) - packageVec.i := package + vectorRef(packageVec,i) := package package nil not success => @@ -451,9 +453,10 @@ newLookupInCategories1(op,sig,dom,dollar) == newCompareSig(sig, numvec, index, dollar, domain) == k := index null (target := first sig) - or lazyMatchArg(target,numvec.k,dollar,domain) => - and/[lazyMatchArg(s,numvec.(k := i),dollar,domain) - for s in rest sig for i in (index+1)..] => numvec.(k + 1) + or lazyMatchArg(target,arrayRef(numvec,k),dollar,domain) => + and/[lazyMatchArg(s,arrayRef(numvec,k := i),dollar,domain) + for s in rest sig for i in (index+1)..] => + arrayRef(numvec,k + 1) nil nil @@ -463,11 +466,11 @@ newCompareSig(sig, numvec, index, dollar, domain) == lazyMatchArg(s,a,dollar,domain) == lazyMatchArg2(s,a,dollar,domain,true) lazyMatchArg2(s,a,dollar,domain,typeFlag) == - if s = '$ then + if s is '$ then -- a = 0 => return true --needed only if extra call in newGoGet to basicLookup s := devaluate dollar -- calls from HasCategory can have $s integer? a => - not typeFlag => s = domain.a + not typeFlag => s = vectorRef(domain,a) a = 6 and $isDefaultingPackage => s = devaluate dollar vector? (d := domainVal(dollar,domain,a)) => s = d.0 => true @@ -476,16 +479,16 @@ lazyMatchArg2(s,a,dollar,domain,typeFlag) == lazyMatchArgDollarCheck(replaceSharpCalls s,d.0,dollar.0,domainArg) --vector? first d => lazyMatch(s,CDDR d,dollar,domain) --old style (erase) lazyMatch(replaceSharpCalls s,d,dollar,domain) --new style - a = '$ => s = devaluate dollar - a = "$$" => s = devaluate domain + a is '$ => s = devaluate dollar + a is "$$" => s = devaluate domain string? a => string? s => a = s s is ['QUOTE,y] and PNAME y = a IDENTP s and symbolName s = a atom a => a = s op := opOf a - op = 'NRTEVAL => s = nrtEval(second a,domain) - op = 'QUOTE => s = second a + op is 'NRTEVAL => s = nrtEval(second a,domain) + op is 'QUOTE => s = second a lazyMatch(s,a,dollar,domain) --above line is temporarily necessary until system is compiled 8/15/90 --s = a @@ -533,7 +536,7 @@ lazyMatchArgDollarCheck(s,d,dollarName,domainName) == fn() == x = arg => true x is ['elt,someDomain,opname] => lookupInDomainByName(opname,evalDomain someDomain,arg) - x = '$ and (arg = dollarName or arg = domainName) => true + x is '$ and (arg = dollarName or arg = domainName) => true x = dollarName and arg = domainName => true atom x or atom arg => false xt and first x = first arg => @@ -544,7 +547,7 @@ lookupInDomainByName(op,domain,arg) == atom arg => nil opvec := domain . 1 . 2 numvec := getDomainByteVector domain - predvec := domain.3 + predvec := vectorRef(domain,3) max := maxIndex opvec k := getOpCode(op,opvec,max) or return nil idxmax := maxIndex numvec @@ -556,12 +559,12 @@ lookupInDomainByName(op,domain,arg) == success := false while finish > start repeat i := start - numberOfArgs :=numvec.i - predIndex := numvec.(i := i + 1) + numberOfArgs := arrayRef(numvec,i) + predIndex := arrayRef(numvec,i := i + 1) predIndex ~= 0 and not testBitVector(predvec,predIndex) => nil - slotIndex := numvec.(i + 2 + numberOfArgs) + slotIndex := arrayRef(numvec,i + 2 + numberOfArgs) newStart := QSPLUS(start,QSPLUS(numberOfArgs,4)) - slot := domain.slotIndex + slot := vectorRef(domain,slotIndex) cons? slot and sameObject?(first slot,first arg) and sameObject?(rest slot,rest arg) => return (success := true) start := QSPLUS(start,QSPLUS(numberOfArgs,4)) success @@ -590,20 +593,20 @@ newExpandLocalTypeForm([functorName,:argl],dollar,domain) == for [.,tag,dom] in argl]] functorName in '(Union Mapping _[_|_|_] Enumeration) => [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]] - functorName = "QUOTE" => [functorName,:argl] + functorName is "QUOTE" => [functorName,:argl] coSig := getDualSignatureFromDB functorName null coSig => error ["bad functorName", functorName] [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,flag) for a in argl for flag in rest coSig]] newExpandLocalTypeArgs(u,dollar,domain,typeFlag) == - u = '$ => u + u is '$ => u integer? u => typeFlag => newExpandTypeSlot(u, dollar,domain) - domain.u + vectorRef(domain,u) u is ['NRTEVAL,y] => nrtEval(y,domain) u is ['QUOTE,y] => y - u = "$$" => domain.0 + u is "$$" => vectorRef(domain,0) atom u => u --can be first, rest, etc. newExpandLocalTypeForm(u,dollar,domain) @@ -615,14 +618,14 @@ domainVal(dollar,domain,index) == --returns a domain or a lazy slot index = 0 => dollar index = 2 => domain - domain.index + vectorRef(domain,index) -- ??? This function should be merged into the preceding one. sigDomainVal(dollar,domain,index) == --returns a domain or a lazy slot index = 0 => "$" index = 2 => domain - domain.index + vectorRef(domain,index) --======================================================= -- Convert Lazy Domain to Domain Form @@ -711,7 +714,7 @@ newHasTest(domform,catOrAtt) == lazyMatchAssocV(x,auxvec,catvec,domain) == --new style slot4 n := maxIndex catvec xop := first x - or/[auxvec.i for i in 0..n | + or/[vectorRef(auxvec,i) for i in 0..n | xop = first (lazyt := vectorRef(catvec,i)) and lazyMatch(x,lazyt,domain,domain)] lazyMatchAssocV1(x,vec,domain) == --old style slot4 -- cgit v1.2.3