diff options
author | dos-reis <gdr@axiomatics.org> | 2010-05-17 03:02:43 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2010-05-17 03:02:43 +0000 |
commit | b04728250962a67b923ed71237f6145e3d594255 (patch) | |
tree | 274fdad71c27e43669ec96d5dbe118498d0830de /src | |
parent | 103781c30e982fd28102d9268c2fb23863a1f971 (diff) | |
download | open-axiom-b04728250962a67b923ed71237f6145e3d594255.tar.gz |
* interp/as.boot: Clean up.
* interp/br-util.boot: Likewise.
* interp/category.boot: Likewise.
* interp/compiler.boot: Likewise.
* interp/define.boot: Likewise.
* interp/modemap.boot: Likewise.
* interp/wi2.boot: Likewise.
Diffstat (limited to 'src')
-rw-r--r-- | src/ChangeLog | 10 | ||||
-rw-r--r-- | src/interp/as.boot | 6 | ||||
-rw-r--r-- | src/interp/br-util.boot | 2 | ||||
-rw-r--r-- | src/interp/category.boot | 2 | ||||
-rw-r--r-- | src/interp/compiler.boot | 8 | ||||
-rw-r--r-- | src/interp/define.boot | 90 | ||||
-rw-r--r-- | src/interp/modemap.boot | 2 | ||||
-rw-r--r-- | src/interp/wi2.boot | 2 |
8 files changed, 66 insertions, 56 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index a48af9e1..ea16334c 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,15 @@ 2010-05-16 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/as.boot: Clean up. + * interp/br-util.boot: Likewise. + * interp/category.boot: Likewise. + * interp/compiler.boot: Likewise. + * interp/define.boot: Likewise. + * interp/modemap.boot: Likewise. + * interp/wi2.boot: Likewise. + +2010-05-16 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/i-util.boot (flattenCOND): Move from g-boot.boot. (extractCONDClauses): Likewise. * interp/g-boot.boot: Remove. diff --git a/src/interp/as.boot b/src/interp/as.boot index fef01d2e..bd7ca583 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -89,7 +89,7 @@ asyParents(conform) == con:= opOf conform --formals := TAKE(#formalParams,$TriangleVariableList) modemap := LASSOC(con,$mmAlist) - $constructorCategory :local := asySubstMapping CADAR modemap + $constructorCategory :local := asySubstMapping modemap.mmTarget for x in folks $constructorCategory repeat -- x := SUBLISLIS(formalParams,formals,x) -- x := SUBLISLIS(IFCDR conform,formalParams,x) @@ -144,7 +144,7 @@ asMakeAlist con == abb := asyAbbreviation(con,#(KDR sig)) if null KDR form then PUT(opOf form,'NILADIC,'T) modemap := asySubstMapping LASSOC(con,$mmAlist) - $constructorCategory :local := CADAR modemap + $constructorCategory :local := modemap.mmTarget parents := mySort HGET($parentsHash,con) --children:= mySort HGET($childrenHash,con) alists := HGET($opHash,con) @@ -168,7 +168,7 @@ asMakeAlist con == constructorModemap := SUBLISLIS(falist,KDR form,modemap) --TTT fix a niladic category constructormodemap (remove the joins) if kind = 'category then - SETF(CADAR(constructorModemap),['Category]) + constructorModemap.mmTarget := $Category res := [['constructorForm,:form],:constantPart,:niladicPart, ['constructorKind,:kind], ['constructorModemap,:constructorModemap], diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot index 1312170c..fe1bb927 100644 --- a/src/interp/br-util.boot +++ b/src/interp/br-util.boot @@ -264,7 +264,7 @@ args2LispString x == strconc('",",form2LispString first x,fnTailTail rest x) dbConstructorKind x == - target := CADAR getConstructorModemapFromDB x + target := getConstructorModemapFromDB(x).mmTarget target = '(Category) => 'category target is ['CATEGORY,'package,:.] => 'package HGET($defaultPackageNamesHT,x) => 'default_ package diff --git a/src/interp/category.boot b/src/interp/category.boot index beabe110..c927d69f 100644 --- a/src/interp/category.boot +++ b/src/interp/category.boot @@ -108,7 +108,7 @@ mkCategory(domainOrPackage,sigList,attList,domList,PrincipalAncestor) == else s for s in sigList] NewLocals:= nil for s in sigList repeat - NewLocals:= union(NewLocals,Prepare CADAR s) where + NewLocals:= union(NewLocals,Prepare s.mmTarget) where Prepare u == "union"/[Prepare2 v for v in u] Prepare2 v == v is "$" => nil diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index c59519a8..12e6d458 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -189,7 +189,7 @@ comp3(x,m,$e) == y = x => [["QUOTE",x], m, $e] nil atom x => compAtom(x,m,e) - op:= first x + 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) @@ -284,7 +284,7 @@ freeVarUsage([.,vars,body],env) == free getmode(u,e) = nil => free [[u,:1],:free] - op := first u + op := u.op op in '(QUOTE GO function) => free op = "LAMBDA" => bound := UNIONQ(bound, second u) @@ -383,7 +383,7 @@ extractCodeAndConstructTriple(u, m, oldE) == compExpression(x,m,e) == $insideExpressionIfTrue: local:= true -- special forms have dedicated compilers. - (op := first x) and IDENTP op and (fn := GET(op,"SPECIAL")) => + (op := x.op) and IDENTP op and (fn := GET(op,"SPECIAL")) => FUNCALL(fn,x,m,e) compForm(x,m,e) @@ -1208,7 +1208,7 @@ compIf(["IF",a,b,c],m,E) == canReturn(expr,level,exitCount,ValueFlag) == --SPAD: exit and friends atom expr => ValueFlag and level=exitCount - (op:= first expr)="QUOTE" => ValueFlag and level=exitCount + (op:= expr.op)="QUOTE" => ValueFlag and level=exitCount op="TAGGEDexit" => expr is [.,count,data] => canReturn(data.expr,level,count,count=level) level=exitCount and not ValueFlag => nil diff --git a/src/interp/define.boot b/src/interp/define.boot index 58bc4863..d8d1f0d6 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -123,7 +123,7 @@ emitSubdomainInfo(form,super,pred) == pred := eqSubst($AtVariables,rest form,pred) super := eqSubst($AtVariables,rest form,super) evalAndRwriteLispForm("evalOnLoad2",["noteSubDomainInfo", - quoteForm first form,quoteForm super, quoteForm pred]) + quoteForm form.op,quoteForm super, quoteForm pred]) ++ List of operations defined in a given capsule @@ -237,11 +237,11 @@ checkRepresentation(addForm,body,env) == stackAndThrow('"You cannot define %1b in category defaults",["Rep"]) if args ~= nil then stackAndThrow('"%1b does take arguments",["Rep"]) - if first sig ~= nil then + if sig.target ~= nil then stackAndThrow('"You cannot specify type for %1b",["Rep"]) -- Now, trick the rest of the compiler into believing that -- `Rep' was defined the Old Way, for lookup purpose. - stmt.first := "%LET" + stmt.op := "%LET" stmt.rest := ["Rep",domainRep] $useRepresentationHack := false -- Don't confuse `Rep' and `%'. @@ -271,12 +271,12 @@ compDefine1(form,m,e) == --1. decompose after macro-expanding form ['DEF,lhs,signature,specialCases,rhs]:= form:= macroExpand(form,e) $insideWhereIfTrue and isMacro(form,e) and (m=$EmptyMode or m=$NoValueMode) - => [lhs,m,put(first lhs,"macro",rhs,e)] + => [lhs,m,put(lhs.op,"macro",rhs,e)] checkParameterNames rest lhs null signature.target and not MEMQ(KAR rhs,$BuiltinConstructorNames) and (sig:= getSignatureFromMode(lhs,e)) => -- here signature of lhs is determined by a previous declaration - compDefine1(['DEF,lhs,[first sig,:rest signature],specialCases,rhs],m,e) + compDefine1(['DEF,lhs,[sig.target,:signature.source],specialCases,rhs],m,e) if signature.target=$Category then $insideCategoryIfTrue:= true -- RDJ (11/83): when argument and return types are all declared, @@ -287,13 +287,13 @@ compDefine1(form,m,e) == -- 2. if signature list for arguments is not empty, replace ('DEF,..) by -- ('where,('DEF,..),..) with an empty signature list; -- otherwise, fill in all NILs in the signature - or/[x ~= nil for x in rest signature] => compDefWhereClause(form,m,e) + or/[x ~= nil for x in signature.source] => compDefWhereClause(form,m,e) signature.target=$Category => compDefineCategory(form,m,e,nil,$formalArgList) isDomainForm(rhs,e) and not $insideFunctorIfTrue => if null signature.target then signature:= [getTargetFromRhs(lhs,rhs,giveFormalParametersValues(rest lhs,e)),: - rest signature] + signature.source] rhs:= addEmptyCapsuleIfNecessary(signature.target,rhs) compDefineFunctor(['DEF,lhs,signature,specialCases,rhs],m,e,nil, $formalArgList) @@ -307,7 +307,7 @@ compDefineAddSignature([op,:argl],signature,e) == (sig:= hasFullSignature(argl,signature,e)) and not assoc(['$,:sig],LASSOC('modemap,getProplist(op,e))) => declForm:= - [":",[op,:[[":",x,m] for x in argl for m in rest sig]],first signature] + [":",[op,:[[":",x,m] for x in argl for m in sig.source]],signature.target] [.,.,e]:= comp(declForm,$EmptyMode,e) e e @@ -465,7 +465,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e, -- 2. obtain signature signature':= - [first signature, + [signature.target, :[getArgumentModeOrMoan(a,$definition,e) for a in argl]] e:= giveFormalParametersValues(argl,e) @@ -482,7 +482,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e, $functorStats: local:= [0,0] $getDomainCode: local := nil $addForm: local:= nil - for x in sargl for t in rest signature' repeat + for x in sargl for t in signature'.source repeat [.,.,e]:= compMakeDeclaration(x,t,e) -- 4. compile body in environment of %type declarations for arguments @@ -542,8 +542,8 @@ compDefineCategory2(form,signature,specialCases,body,m,e, mkConstructor: %Form -> %Form mkConstructor form == atom form => ['devaluate,form] - null rest form => ['QUOTE,[first form]] - ['LIST,MKQ first form,:[mkConstructor x for x in rest form]] + null rest form => ['QUOTE,[form.op]] + ['LIST,MKQ form.op,:[mkConstructor x for x in rest form]] compDefineCategory(df,m,e,prefix,fal) == $domainShell: local := nil -- holds the category of the object being compiled @@ -610,7 +610,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], isCategoryPackageName $op or MEMQ($op,$mutableDomains) --true if domain has mutable state signature':= - [first signature,:[getArgumentModeOrMoan(a,form,$e) for a in argl]] + [signature.target,:[getArgumentModeOrMoan(a,form,$e) for a in argl]] $functorForm := $form := [$op,:argl] if null signature'.target then signature':= modemap2Signature getModemap($form,$e) @@ -649,7 +649,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], -- domain D in argl,check its signature: if domain, its type is Join(A1,..,An); -- in this case, D is replaced by D1,..,Dn (gensyms) which are set -- to the A1,..,An view of D - makeFunctorArgumentParameters(argl,rest signature',first signature') + makeFunctorArgumentParameters(argl,signature'.source,signature'.target) $functorLocalParameters := argl -- 4. compile body in environment of %type declarations for arguments @@ -703,7 +703,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], -- see NRTsetVector4 for initial setting of $lisplibCategoriesExtended libFn := getConstructorAbbreviationFromDB op' $lookupFunction: local := - NRTgetLookupFunction($functorForm,CADAR $lisplibModemap,$NRTaddForm) + NRTgetLookupFunction($functorForm,$lisplibModemap.mmTarget,$NRTaddForm) --either lookupComplete (for forgetful guys) or lookupIncomplete $byteAddress :local := 0 $byteVec :local := nil @@ -881,18 +881,18 @@ compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) == -- 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] + [transformType fetchType(a,x,e,form) for a in rest form for x in signature.source] where fetchType(a,x,e,form) == x => x getmode(a,e) or userError concat( - '"There is no mode for argument",a,'"of function",first form) + '"There is no mode for argument",a,'"of function",form.op) transformType x == atom x => x x is [":",R,Rtype] => ($sigAlist:= [[R,:transformType Rtype],:$sigAlist]; x) x is ['Record,:.] => x --RDJ 8/83 - [first x,:[transformType y for y in rest x]] + [x.op,:[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 @@ -925,8 +925,8 @@ compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) == ["where",defform,:whereList] where defform:= ['DEF,form'',signature',specialCases,body] where - form'':= [first form,:argList] - signature':= [first signature,:[nil for x in rest signature]] + form'':= [form.op,:argList] + signature':= [signature.target,:[nil for x in signature.source]] orderByDependency(vl,dl) == -- vl is list of variables, dl is list of dependency-lists @@ -963,9 +963,9 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body], $returnMode:= m -- Change "^" to "**" in definitions. All other places have -- been changed before we get here. - if first form = "^" then + if form.op = "^" then sayBrightly ['"Replacing", :bright '"^", '"with",:bright '"**"] - form.first := "**" + form.op := "**" [$op,:argl]:= form $form:= [$op,:argl] argl:= stripOffArgumentConditions argl @@ -973,28 +973,28 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body], --let target and local signatures help determine modes of arguments argModeList:= - identSig:= hasSigInTargetCategory(argl,form,first signature,e) => + identSig:= hasSigInTargetCategory(argl,form,signature.target,e) => (e:= checkAndDeclare(argl,form,identSig,e); rest identSig) [getArgumentModeOrMoan(a,form,e) for a in argl] argModeList:= stripOffSubdomainConditions(argModeList,argl) - signature':= [first signature,:argModeList] + signature':= [signature.target,:argModeList] if null identSig then --make $op a local function $e := put($op,'mode,['Mapping,:signature'],$e) --obtain target type if not given - if null first signature' then signature':= + if null signature'.target then signature':= identSig => identSig - getSignature($op,rest signature',e) or return nil + getSignature($op,signature'.source,e) or return nil e:= giveFormalParametersValues(argl,e) $signatureOfForm:= signature' --this global is bound in compCapsuleItems $functionLocations := [[[$op,$signatureOfForm],:lineNumber], :$functionLocations] - e:= addDomain(first signature',e) + e:= addDomain(signature'.target,e) e:= compArgumentConditions e if $profileCompiler then - for x in argl for t in rest signature' repeat + for x in argl for t in signature'.source repeat profileRecord('arguments,x,t) --4. introduce needed domains into extendedEnv @@ -1062,8 +1062,8 @@ hasSigInTargetCategory(argl,form,opsig,e) == [sig for sig in sigs | fn(sig,opsig,mList)] where fn(sig,opsig,mList) == - (null opsig or opsig=first sig) and - (and/[compareMode2Arg(x,m) for x in mList for m in rest sig]) + (null opsig or opsig=sig.target) and + (and/[compareMode2Arg(x,m) for x in mList for m in sig.source]) c:= #potentialSigList 1=c => first potentialSigList --accept only those signatures op right length which match declared modes @@ -1088,7 +1088,7 @@ getArgumentMode(x,e) == checkAndDeclare(argl,form,sig,e) == -- arguments with declared types must agree with those in sig; -- those that don't get declarations put into e - for a in argl for m in rest sig repeat + for a in argl for m in sig.source repeat isQuasiquote m => nil -- we just built m from a. m1:= getArgumentMode(a,e) => not modeEqual(m1,m) => @@ -1096,7 +1096,7 @@ checkAndDeclare(argl,form,sig,e) == '" not ",m1,'%l,:stack] e:= put(a,'mode,m,e) if stack then - sayBrightly ['" Parameters of ",:bright first form, + sayBrightly ['" Parameters of ",:bright form.op, '" are of wrong type:",'%l,:stack] e @@ -1106,7 +1106,7 @@ getSignature(op,argModeList,$e) == removeDuplicates [sig for [[dc,:sig],[pred,:.]] in (mmList:= get(op,'modemap,$e)) | dc='_$ - and rest sig=argModeList and knownInfo pred]) => first sigl + and sig.source = argModeList and knownInfo pred]) => first sigl null sigl => (u:= getmode(op,$e)) is ['Mapping,:sig] => sig SAY '"************* USER ERROR **********" @@ -1314,7 +1314,7 @@ bootStrapError(functorForm,sourceFile) == ['COND, _ ['$bootStrapMode, _ ['VECTOR,mkTypeForm functorForm,nil,nil,nil,nil,nil]], - [''T, ['systemError,['LIST,''%b,MKQ first functorForm,''%d,'"from", _ + [''T, ['systemError,['LIST,''%b,MKQ functorForm.op,''%d,'"from", _ ''%b,MKQ namestring sourceFile,''%d,'"needs to be compiled"]]]] compAdd(['add,$addForm,capsule],m,e) == @@ -1324,7 +1324,7 @@ compAdd(['add,$addForm,capsule],m,e) == [['COND, _ ['$bootStrapMode, _ code],_ - [''T, ['systemError,['LIST,''%b,MKQ first $functorForm,''%d,'"from", _ + [''T, ['systemError,['LIST,''%b,MKQ $functorForm.op,''%d,'"from", _ ''%b,MKQ namestring _/EDITFILE,''%d,'"needs to be compiled"]]]],m,e] $addFormLhs: local:= $addForm if $addForm is ["SubDomain",domainForm,predicate] then @@ -1409,13 +1409,13 @@ compSingleCapsuleItem(item,$predl,$e) == ++ subroutine of doIt. Called to generate runtime noop insn. mutateToNothing item == - item.first := 'PROGN + item.op := 'PROGN item.rest := NIL doIt(item,$predl) == $GENNO: local:= 0 item is ['SEQ,:l,['exit,1,x]] => - item.first := "PROGN" + item.op := "PROGN" lastNode(item).first := x for it1 in rest item repeat $e:= compSingleCapsuleItem(it1,$predl,$e) --This will RPLAC as appropriate @@ -1426,7 +1426,7 @@ doIt(item,$predl) == -- a cycle otherwise. u:= ["import", [first item,:rest item]] stackWarning('"Use: import %1p",[[first item,:rest item]]) - item.first := first u + item.op := u.op item.rest := rest u doIt(item,$predl) item is ["%LET",lhs,rhs,:.] => @@ -1448,10 +1448,10 @@ doIt(item,$predl) == if $optimizeRep then nominateForInlining $Representation code is ["%LET",:.] => - item.first := "setShellEntry" + item.op := "setShellEntry" rhsCode := rhs' item.rest := ['$,NRTgetLocalIndex lhs,rhsCode] - item.first := first code + item.op := code.op item.rest := rest code item is [":",a,t] => [.,.,$e]:= compOrCroak(item,$EmptyMode,$e) item is ["import",:doms] => @@ -1471,7 +1471,7 @@ doIt(item,$predl) == item is ['DEF,[op,:.],:.] => body:= isMacro(item,$e) => $e:= put(op,"macro",body,$e) [.,.,$e]:= t:= compOrCroak(item,$EmptyMode,$e) - item.first := "CodeDefine" + item.op := "CodeDefine" --Note that DescendCode, in CodeDefine, is looking for this second(item).rest := [$signatureOfForm] --This is how the signature is updated for buildFunctor to recognise @@ -1523,7 +1523,7 @@ doItIf(item is [.,p,x,y],$predl,$e) == if y~="%noBranch" then compSingleCapsuleItem(y,[["not",p],:$predl],getInverseEnvironment(p,olde)) y':=localExtras(oldFLP) - item.first := "COND" + item.op := "COND" item.rest := [[p',x,:x'],['(QUOTE T),y,:y']] where localExtras(oldFLP) == EQ(oldFLP,$functorLocalParameters) => NIL @@ -1633,10 +1633,10 @@ DomainSubstitutionFunction(parameters,body) == --bound in buildFunctor --For categories, bound and used in compDefineCategory MKQ g - first body="QUOTE" => body + body.op = "QUOTE" => body cons? $definition and - isFunctor first body and - first body ~= first $definition + isFunctor body.op and + body.op ~= $definition.op => ['QUOTE,optimize body] [Subst(parameters,u) for u in body] not (body is ["Join",:.]) => body diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index 6b36e297..bb26af46 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -342,7 +342,7 @@ substNames(domainName,viewName,functorForm,opalist) == -- putInLocalDomainReferences [[:SUBSTQ("$","$$",SUBSTQ(nameForDollar,"$",modemapform)), [sel, viewName,if domainName = "$" then pos else - CADAR modemapform]] + modemapform.mmTarget]] for [:modemapform,[sel,"$",pos]] in EQSUBSTLIST(KDR functorForm,$FormalMapVariableList, opalist)] diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot index f40823ab..2be969a7 100644 --- a/src/interp/wi2.boot +++ b/src/interp/wi2.boot @@ -193,7 +193,7 @@ compDefineFunctor1(df, m,$e,$prefix,$formalArgList) == -- see NRTsetVector4 for initial setting of $lisplibCategoriesExtended libFn := getConstructorAbbreviation op' $lookupFunction: local := - NRTgetLookupFunction($functorForm,CADAR $lisplibModemap,$NRTaddForm) + NRTgetLookupFunction($functorForm,$lisplibModemap.mmTarget,$NRTaddForm) --either lookupComplete (for forgetful guys) or lookupIncomplete $byteAddress :local := 0 $byteVec :local := nil |