diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/interp/compiler.boot | 13 | ||||
| -rw-r--r-- | src/interp/define.boot | 88 | ||||
| -rw-r--r-- | src/interp/functor.boot | 25 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 12 | ||||
| -rw-r--r-- | src/interp/nrunfast.boot | 13 | ||||
| -rw-r--r-- | src/interp/nrungo.boot | 4 | ||||
| -rw-r--r-- | src/interp/nrunopt.boot | 3 |
7 files changed, 59 insertions, 99 deletions
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 5022d5dc..28a4cbf3 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -620,8 +620,8 @@ compFormWithModemap(form,m,e,modemap) == (c:=get(z,'condition,e)) and c is [["case",=z,c1]] and (c1 is [":",=(second argl),=m] or EQ(c1,second argl) ) => --- first is a full tag, as placed by getInverseEnvironment --- second is what getSuccessEnvironment will place there + -- first is a full tag, as placed by getInverseEnvironment + -- second is what getSuccessEnvironment will place there ["CDR",z] ["call",:form'] e':= @@ -843,7 +843,6 @@ setqSingle(id,val,m,E) == e':= augModemapsFromDomain1(id,val,e') --all we do now is to allocate a slot number for lhs --e.g. the %LET form below will be changed by putInLocalDomainReferences ---+ if k := NRTassocIndex(id) then form := ["setShellEntry","$",k,x] else form:= @@ -862,18 +861,18 @@ setqMultiple(nameList,val,m,e) == val is ["CONS",:.] and m=$NoValueMode => setqMultipleExplicit(nameList,uncons val,m,e) val is ["%Comma",:l] and m=$NoValueMode => setqMultipleExplicit(nameList,l,m,e) - 1 --create a gensym, %add to local environment, compile and assign rhs + -- 1. create a gensym, %add to local environment, compile and assign rhs g:= genVariable() e:= addBinding(g,nil,e) T:= [.,m1,.]:= compSetq1(g,val,$EmptyMode,e) or return nil e:= put(g,"mode",m1,e) [x,m',e]:= convert(T,m) or return nil - 1.1 --exit if result is a list + -- 1.1. exit if result is a list m1 is ["List",D] => for y in nameList repeat e:= put(y,"value",[genSomeVariable(),D,$noEnv],e) convert([["PROGN",x,["%LET",nameList,g],g],m',e],m) - 2 --verify that the #nameList = number of parts of right-hand-side + -- 2. verify that the #nameList = number of parts of right-hand-side selectorModePairs:= --list of modes decompose(m1,#nameList,e) or return nil where @@ -884,7 +883,7 @@ setqMultiple(nameList,val,m,e) == stackMessage('"no multiple assigns to mode: %1p",[t]) #nameList~=#selectorModePairs => stackMessage('"%1b must decompose into %2 components",[val,#nameList]) - 3 --generate code; return + -- 3. generate code; return assignList:= [([.,.,e]:= compSetq1(x,["elt",g,y],z,e) or return "failed").expr for x in nameList for [y,:z] in selectorModePairs] diff --git a/src/interp/define.boot b/src/interp/define.boot index ce5bf8d7..debdd992 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -364,17 +364,11 @@ macroExpandList(l,e) == [macroExpand(x,e) for x in l] --% constructor evaluation --- The following functions are used by the compiler but are modified --- here for use with new LISPLIB scheme mkEvalableCategoryForm c == c is [op,:argl] => op="Join" => ["Join",:[mkEvalableCategoryForm x for x in argl]] - op is "DomainSubstitutionMacro" => - --$extraParms :local - --catobj := EVAL c -- DomainSubstitutionFunction makes $extraParms - --mkEvalableCategoryForm sublisV($extraParms, catobj) - mkEvalableCategoryForm second argl + op is "DomainSubstitutionMacro" => mkEvalableCategoryForm second argl op is "mkCategory" => c MEMQ(op,$CategoryNames) => ([x,m,$e]:= compOrCroak(c,$EmptyMode,$e); m=$Category => x) @@ -464,25 +458,25 @@ compDefineCategory2(form,signature,specialCases,body,m,e, -- Remember the body for checking the current instantiation. $currentCategoryBody : local := body --Set in DomainSubstitutionFunction, used further down --- 1.1 augment e to add declaration $: <form> + -- 1.1 augment e to add declaration $: <form> [$op,:argl] := $definition e:= addBinding("$",[['mode,:$definition]],e) --- 2. obtain signature + -- 2. obtain signature signature':= [first signature, :[getArgumentModeOrMoan(a,$definition,e) for a in argl]] e:= giveFormalParametersValues(argl,e) --- 3. replace arguments by $1,..., substitute into body, --- and introduce declarations into environment + -- 3. replace arguments by $1,..., substitute into body, + -- and introduce declarations into environment sargl:= TAKE(# argl, $TriangleVariableList) $functorForm:= $form:= [$op,:sargl] $formalArgList:= [:sargl,:$formalArgList] aList := pairList(argl,sargl) formalBody:= SUBLIS(aList,body) signature' := SUBLIS(aList,signature') ---Begin lines for category default definitions + --Begin lines for category default definitions $functionStats: local:= [0,0] $functorStats: local:= [0,0] $getDomainCode: local := nil @@ -490,7 +484,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e, for x in sargl for t in rest signature' repeat [.,.,e]:= compMakeDeclaration(x,t,e) --- 4. compile body in environment of %type declarations for arguments + -- 4. compile body in environment of %type declarations for arguments op':= $op -- following line causes cats with no with or Join to be fresh copies if opOf(formalBody)~='Join and opOf(formalBody)~='mkCategory then @@ -510,13 +504,13 @@ compDefineCategory2(form,signature,specialCases,body,m,e, ["setShellEntry",g,0,mkConstructor $form]] fun:= compile [op',["LAM",sargl,body]] --- 5. give operator a 'modemap property + -- 5. give operator a 'modemap property pairlis := pairList(argl,$FormalMapVariableList) parSignature:= SUBLIS(pairlis,signature') parForm:= SUBLIS(pairlis,form) -- If we are only interested in the defaults, there is no point -- in writing out compiler info and load-time stuff for - --the category which is assumed to have already been translated. + -- the category which is assumed to have already been translated. if not $compileDefaultsOnly then lisplibWrite('"compilerInfo", removeZeroOne ['SETQ,'$CategoryFrame, @@ -528,7 +522,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e, evalAndRwriteLispForm('NILADIC, ['MAKEPROP,['QUOTE,op'],'(QUOTE NILADIC),true]) --- 6. put modemaps into InteractiveModemapFrame + -- 6. put modemaps into InteractiveModemapFrame $domainShell := eval [op',:MAPCAR('MKQ,sargl)] $lisplibCategory:= formalBody if $LISPLIB then @@ -609,7 +603,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], originale:= $e [$op,:argl]:= form $formalArgList:= [:argl,:$formalArgList] - $pairlis := pairList(argl,$FormalMapVariableList) + $pairlis: local := pairList(argl,$FormalMapVariableList) $mutableDomain: local := -- all defaulting packages should have caching turned off isCategoryPackageName $op or MEMQ($op,$mutableDomains) @@ -627,7 +621,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], [ds,.,$e]:= compMakeCategoryObject(target,$e) or return stackAndThrow('" cannot produce category object: %1pb",[target]) $compileExportsOnly => compDefineExports(form, ds.1, signature',$e) - $domainShell:= COPY_-SEQ ds + $domainShell: local := COPY_-SEQ ds attributeList := ds.2 --see below under "loadTimeAlist" $condAlist: local := nil $uncondAlist: local := nil @@ -866,26 +860,25 @@ mkOpVec(dom,siglist) == u:= ASSQ(op,oplist) assoc(sig,u) is [.,n,.,'ELT] => ops.i := dom.n noplist:= SUBLIS(substargs,u) - -- following variation on assoc needed for GENSYMS in Mutable domains + -- 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] ops + +++ form is lhs (f a1 ... an) of definition; body is rhs; +++ signature is (t0 t1 ... tn) where t0= target type, ti=type of ai, i > 0; +++ specialCases is (NIL l1 ... ln) where li is list of special cases +++ which can be given for each ti +++ removes declarative and assignment information from form and +++ signature, placing it in list L, replacing form by ("where",form',:L), +++ signature by a list of NILs (signifying declarations are in e) compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) == --- form is lhs (f a1 ... an) of definition; body is rhs; --- signature is (t0 t1 ... tn) where t0= target type, ti=type of ai, i > 0; --- specialCases is (NIL l1 ... ln) where li is list of special cases --- which can be given for each ti - --- removes declarative and assignment information from form and --- signature, placing it in list L, replacing form by ("where",form',:L), --- signature by a list of NILs (signifying declarations are in e) $sigAlist: local := nil $predAlist: local := nil - --- 1. create sigList= list of all signatures which have embedded --- declarations moved into global variable $sigAlist + -- 1. create sigList= list of all signatures which have embedded + -- declarations moved into global variable $sigAlist sigList:= [transformType fetchType(a,x,e,form) for a in rest form for x in rest signature] where @@ -900,16 +893,16 @@ compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) == x is ['Record,:.] => x --RDJ 8/83 [first x,:[transformType y for y in rest x]] --- 2. replace each argument of the form (|| x p) by x, recording --- the given predicate in global variable $predAlist + -- 2. replace each argument of the form (|| x p) by x, recording + -- the given predicate in global variable $predAlist argList:= [removeSuchthat a for a in rest form] where removeSuchthat x == x is ["|",y,p] => ($predAlist:= [[y,:p],:$predAlist]; y) x --- 3. obtain a list of parameter identifiers (x1 .. xn) ordered so that --- the type of xi is independent of xj if i < j + -- 3. obtain a list of parameter identifiers (x1 .. xn) ordered so that + -- the type of xi is independent of xj if i < j varList:= orderByDependency(ASSOCLEFT argDepAlist,ASSOCRIGHT argDepAlist) where argDepAlist:= @@ -919,13 +912,13 @@ compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) == delete(x,listOfIdentifiersIn LASSOC(x,$predAlist))) argSigAlist:= [:$sigAlist,:pairList(argList,sigList)] --- 4. construct a WhereList which declares and/or defines the xi's in --- the order constructed in step 3 + -- 4. construct a WhereList which declares and/or defines the xi's in + -- the order constructed in step 3 (whereList:= [addSuchthat(x,[":",x,LASSOC(x,argSigAlist)]) for x in varList]) where addSuchthat(x,y) == (p:= LASSOC(x,$predAlist) => ["|",y,p]; y) --- 5. compile new ('DEF,("where",form',:WhereList),:.) where --- all argument parameters of form' are bound/declared in WhereList + -- 5. compile new ('DEF,("where",form',:WhereList),:.) where + -- all argument parameters of form' are bound/declared in WhereList comp(form',m,e) where form':= ["where",defform,:whereList] where @@ -1031,8 +1024,8 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body], if $newCompCompare=true then SAY '"The old compiler generates:" prTriple T --- A THROW to the above CATCH occurs if too many semantic errors occur --- see stackSemanticError + -- A THROW to the above CATCH occurs if too many semantic errors occur + -- see stackSemanticError catchTag:= MKQ GENSYM() fun:= body':= replaceExitEtc(T.expr,catchTag,"TAGGEDreturn",$returnMode) @@ -1041,7 +1034,7 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body], compile [$op,["LAM",[:argl,'_$],finalBody]] $functorStats:= addStats($functorStats,$functionStats) --- 7. give operator a 'value property + --7. give operator a 'value property val:= [fun,signature',e] [fun,['Mapping,:signature'],$e] @@ -1202,7 +1195,7 @@ compile u == -- Deduce old sequence number and use it (items have been skipped). if $LISPLIB and $compileOnlyCertainItems then parts := splitEncodedFunctionName(u.0, ";") --- Next line JHD/SMWATT 7/17/86 to deal with inner functions + -- Next line JHD/SMWATT 7/17/86 to deal with inner functions parts='inner => $savableItems:=[u.0,:$savableItems] unew := nil for [s,t] in $splitUpItemsAlreadyThere repeat @@ -1555,9 +1548,6 @@ doItIf(item is [.,p,x,y],$predl,$e) == $functorLocalParameters:=[:oldFLP,:nreverse nils] nreverse ans ---compSingleCapsuleIf(x,predl,e,$functorLocalParameters) == --- compSingleCapsuleItem(x,predl,e) - --% CATEGORY AND DOMAIN FUNCTIONS compContained: (%Form, %Mode, %Env) -> %Maybe %Triple @@ -1649,7 +1639,7 @@ DomainSubstitutionFunction(parameters,body) == [Subst(parameters,u) for u in body] not (body is ["Join",:.]) => body atom $definition => body - null rest $definition => body + null rest $definition => body --should not bother if it will only be called once name:= INTERN STRCONC(KAR $definition,";CAT") SETANDFILE(name,nil) @@ -1709,9 +1699,9 @@ compCategoryItem(x,predl,env) == for u in l repeat compCategoryItem(u,predl,env) --- 4. otherwise, x gives a signature for a --- single operator name or a list of names; if a list of names, --- recurse + -- 4. otherwise, x gives a signature for a + -- single operator name or a list of names; if a list of names, + -- recurse x is ["SIGNATURE",:opsig] => compSignature(opsig,pred,env) systemErrorHere ["compCategoryItem",x] diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 95b9ccd1..75ac00e4 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -44,7 +44,7 @@ keyItem a == --The item that domain checks on --Global strategy here is to maintain a list of substitutions --- ( %in Sublis), of vectors and the names that they have, +-- ( in $Sublis), of vectors and the names that they have, -- which may be either local names ('View1') or global names ('Where1') -- The global names are remembered on $Sublis from one -- invocation of DomainPrint1 to the next @@ -803,9 +803,9 @@ InvestigateConditions catvecListMaker == list2 list:= [[sec,:ICformat u] for u in list for sec in secondaries] pv:= getPossibleViews $principal --- $HackSlot4 is used in SetVector4 to ensure that conditional --- extensions of the principal view are handles correctly --- here we build the code necessary to remove spurious extensions + -- $HackSlot4 is used in SetVector4 to ensure that conditional + -- extensions of the principal view are handles correctly + -- here we build the code necessary to remove spurious extensions ($HackSlot4:= [reshape u for u in $HackSlot4]) where reshape u == ['COND,[TryGDC ICformat rest u], @@ -907,23 +907,6 @@ resolvePatternVars(p,args) == p := SUBLISLIS(args, $TriangleVariableList, p) SUBLISLIS(args, $FormalMapVariableList, p) ---resolvePatternVars(p,args) == --- atom p => --- isSharpVarWithNum p => args.(position(p,$FormalMapVariableList)) --- p --- [resolvePatternVars(first p,args),:resolvePatternVars(rest p,args)] - --- Mysterious JENKS definition follows: ---DescendCodeVarAdd(base,flag) == --- baseops := [(u:=LASSOC([base,:SUBST(base,'$,types)], --- get(op,'modemap,$e))) and [sig,:u] --- for (sig := [op,types]) in $CheckVectorList] --- $CheckVectorList := [sig for sig in $CheckVectorList --- for op in baseops | null op] --- [SetFunctionSlots(sig,implem,flag,'adding) --- for u in baseops | u is [sig,[pred,implem]]] - - --% Code Processing Packages isCategoryPackageName nam == diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index f69f80b3..c0fdeda4 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -264,7 +264,6 @@ NRTgetLocalIndex item == -- ??? That we do is likely a bug. flag => item (compOrCroak(item,$EmptyMode,$e)).expr --- item RPLACA(saveNRTdeltaListComp,compEntry) saveIndex @@ -399,10 +398,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) == changeDirectoryInSlot1() --this extends $NRTslot1PredicateList - --pp '"==================" - --for item in $NRTdeltaList repeat pp item - ---LOCAL BOUND FLUID VARIABLES: + --LOCAL BOUND FLUID VARIABLES: $GENNO: local:= 0 --bound in compDefineFunctor1, then as parameter here $catvecList: local := nil --list of vectors v1..vn for each view $hasCategoryAlist: local := nil --list of GENSYMs bound to (HasCategory ..) items @@ -418,7 +414,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) == $supplementaries: local := nil --set in InvestigateConditions to represent any additional --category membership tests that may be needed(see buildFunctor for details) ------------------------- + oldtime:= TEMPUS_-FUGIT() [$catsig,:argsig]:= sig catvecListMaker:=REMDUP @@ -440,8 +436,8 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) == $catNames:= ['$,:[GENVAR() for u in rest catvecListMaker]] domname:='dv_$ ---> Do this now to create predicate vector; then DescendCode can refer ---> to predicate vector if it can + -- Do this now to create predicate vector; then DescendCode can refer + -- to predicate vector if it can [$uncondAlist,:$condAlist] := --bound in compDefineFunctor1 NRTsetVector4Part1($catNames,catvecListMaker,condCats) [$NRTslot1PredicateList,predBitVectorCode1,:predBitVectorCode2] := diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index 96f7b3bc..813dab7d 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -356,7 +356,7 @@ newLookupInCategories1(op,sig,dom,dollar) == slot4 := dom.4 packageVec := first slot4 catVec := first QCDR slot4 ---the next three lines can go away with new category world + --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 := [MKQ val for val in valueList] @@ -434,7 +434,7 @@ lazyMatchArg(s,a,dollar,domain) == lazyMatchArg2(s,a,dollar,domain,true) lazyMatchArg2(s,a,dollar,domain,typeFlag) == if s = '$ then --- a = 0 => return true --needed only if extra call in newGoGet to basicLookup + -- a = 0 => return true --needed only if extra call in newGoGet to basicLookup s := devaluate dollar -- calls from HasCategory can have $s INTEGERP a => not typeFlag => s = domain.a @@ -532,7 +532,7 @@ newExpandGoGetTypeSlot(slot,dollar,domain) == newExpandTypeSlot(slot,domain,domain) newExpandTypeSlot(slot, dollar, domain) == ---> returns domain form for dollar.slot +-- returns domain form for dollar.slot newExpandLocalType(sigDomainVal(dollar, domain, slot), dollar,domain) @@ -679,13 +679,6 @@ lazyMatchAssocV1(x,vec,domain) == --old style slot4 or/[QCDR QVELT(vec,i) for i in 0..n | xop = first (lazyt := first QVELT(vec,i)) and lazyMatch(x,lazyt,domain,domain)] ---newHasAttribute(domain,attrib) == --- predIndex := LASSOC(attrib,domain.2) => --- EQ(predIndex,0) => true --- predvec := domain.3 --- testBitVector(predvec,predIndex) --- false - --======================================================= -- Utility Functions --======================================================= diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot index 1fb22e93..a359fed7 100644 --- a/src/interp/nrungo.boot +++ b/src/interp/nrungo.boot @@ -340,8 +340,8 @@ NRTisRecurrenceRelation(op,body,minivectorName) == -- body should have a conditional expression which -- gives k boundary values, one general term plus possibly an -- "out of domain" condition ---pcl is [:.,[ ''T,:mess]] and not (CONTAINED('throwMessage,mess) or --- CONTAINED('throwKeyedMsg,mess)) => NIL + --pcl is [:.,[ ''T,:mess]] and not (CONTAINED('throwMessage,mess) or + -- CONTAINED('throwKeyedMsg,mess)) => NIL pcl := [x for x in pcl | not (x is [''T,:mess] and (CONTAINED('throwMessage,mess) or CONTAINED('throwKeyedMsg,mess)))] diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot index a4aea6b5..568929ee 100644 --- a/src/interp/nrunopt.boot +++ b/src/interp/nrunopt.boot @@ -384,7 +384,6 @@ NRTcatCompare [catform,:pred] == LASSOC(first catform,$levelAlist) hasDefaultPackage catname == defname := INTERN STRCONC(catname,'"&") constructor? defname => defname ---MEMQ(defname,allConstructors()) => defname nil @@ -911,6 +910,6 @@ expandTypeArgs(u,template,domform) == templateVal(template,domform,index) == --returns a domform or a lazy slot - index = 0 => harhar() --template + index = 0 => BREAK() --template template.index |