diff options
author | dos-reis <gdr@axiomatics.org> | 2007-10-31 01:41:13 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2007-10-31 01:41:13 +0000 |
commit | 847e8111104c485b09b879499efe4ec3beb8942b (patch) | |
tree | cf28332ac203416194292fe44ef44d3855b5ba42 /src/interp/define.boot.pamphlet | |
parent | 161d80a8ff9c0d819710de6a83a3cb5bbcfdbe61 (diff) | |
download | open-axiom-847e8111104c485b09b879499efe4ec3beb8942b.tar.gz |
* Makefile.pamphlet (define.$(FASLEXT)): New rule.
(<<define.clisp>>): Remove.
* c-util.boot (CONTINUE): Comment out.
* define.boot.pamphlet: Push into package "BOOT". Fix syntax.
* i-intern.boot.pamphlet (put): Move to g-util.boot
(get): Likewise.
(get0): Likewise.
(get1): Likewise.
(get2): Likewise.
* setq.lisp (/EDITFILE): Don't set here. Define it in
sys-globals.boot.
(NRTPARSE): Don't set here. Define in define.boot.
Diffstat (limited to 'src/interp/define.boot.pamphlet')
-rw-r--r-- | src/interp/define.boot.pamphlet | 91 |
1 files changed, 50 insertions, 41 deletions
diff --git a/src/interp/define.boot.pamphlet b/src/interp/define.boot.pamphlet index cf6ba96a..6bebbf01 100644 --- a/src/interp/define.boot.pamphlet +++ b/src/interp/define.boot.pamphlet @@ -28,7 +28,8 @@ Since we can't be sure we take the least disruptive course of action. compCapsuleItems(itemlist,$predl,$e) == $TOP__LEVEL: local $myFunctorBody :local -- := data ---needed for translator - if (BOUNDP 'data) then $myFunctorBody:=data -- unbound at runtime? + if (BOUNDP 'data) then + $myFunctorBody:= SYMBOL_-VALUE 'data -- unbound at runtime? $signatureOfForm: local $suffix: local:= 0 for item in itemlist repeat $e:= compSingleCapsuleItem(item,$predl,$e) @@ -72,6 +73,13 @@ compCapsuleItems(itemlist,$predl,$e) == <<*>>= <<license>> +import '"c-util" +import '"cattable" +import '"category" +)package "BOOT" + +NRTPARSE := false + --% FUNCTIONS WHICH MUNCH ON == STATEMENTS compDefine(form,m,e) == @@ -123,7 +131,7 @@ compDefine1(form,m,e) == compDefineAddSignature([op,:argl],signature,e) == (sig:= hasFullSignature(argl,signature,e)) and - not ASSOC(['$,:sig],LASSOC('modemap,getProplist(op,e))) => + not assoc(['$,:sig],LASSOC('modemap,getProplist(op,e))) => declForm:= [":",[op,:[[":",x,m] for x in argl for m in rest sig]],first signature] [.,.,e]:= comp(declForm,$EmptyMode,e) @@ -229,13 +237,13 @@ mkCategoryPackage(form is [op,:argl],cat,def) == cat is ['Join,:u] => gn last u nil catvec := eval mkEvalableCategoryForm form - fullCatOpList:=JoinInner([catvec],$e).1 + fullCatOpList:=(JoinInner([catvec],$e)).1 catOpList := --note: this gets too many modemaps in general -- this is cut down in NRTmakeSlot1 [['SIGNATURE,op1,sig] for [[op1,sig],:.] in fullCatOpList --above line calls the category constructor just compiled - | ASSOC(op1,capsuleDefAlist)] + | assoc(op1,capsuleDefAlist)] null catOpList => nil packageCategory := ['CATEGORY,'domain, :SUBLISLIS(argl,$FormalMapVariableList,catOpList)] @@ -678,12 +686,12 @@ mkOpVec(dom,siglist) == ops:= MAKE_-VEC (#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] => 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(SUBST(dom.0,'$,sig),noplist) is [.,n,.,'ELT] => ops.i := dom.n - ops.i := [Undef,[dom.0,i],:opSig] + ops.i := [function Undef,[dom.0,i],:opSig] ops genDomainViewName(a,category) == @@ -733,7 +741,7 @@ compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) == argDepAlist:= [[x,:dependencies] for [x,:y] in argSigAlist] where dependencies() == - setUnion(listOfIdentifiersIn y, + union(listOfIdentifiersIn y, delete(x,listOfIdentifiersIn LASSOC(x,$predAlist))) argSigAlist:= [:$sigAlist,:pairList(argList,sigList)] @@ -760,7 +768,7 @@ orderByDependency(vl,dl) == fatalError => userError '"Parameter specification error" until (null vl) repeat newl:= - [v for v in vl for d in dl | null setIntersection(d,vl)] or return nil + [v for v in vl for d in dl | null intersection(d,vl)] or return nil orderedVarList:= [:newl,:orderedVarList] vl':= setDifference(vl,newl) dl':= [setDifference(d,newl) for x in vl for d in dl | member(x,vl')] @@ -964,9 +972,9 @@ stripOffArgumentConditions argl == stripOffSubdomainConditions(margl,argl) == [f for x in margl for arg in argl for i in 1..] where - f == + f() == x is ['SubDomain,marg,condition] => - pair:= ASSOC(i,$argumentConditionList) => + pair:= assoc(i,$argumentConditionList) => (RPLAC(CADR pair,MKPF([condition,CADR pair],'AND)); marg) $argumentConditionList:= [[i,arg,condition],:$argumentConditionList] marg @@ -975,7 +983,7 @@ stripOffSubdomainConditions(margl,argl) == compArgumentConditions e == $argumentConditionList:= [f for [n,a,x] in $argumentConditionList] where - f == + f() == y:= SUBST(a,'_#1,x) T := [.,.,e]:= compOrCroak(y,$Boolean,e) [n,x,T.expr] @@ -1062,15 +1070,16 @@ compile u == (and/[modeEqual(x,y) for x in sig for y in $signatureOfForm])] isLocalFunction op => if opexport then userError ['%b,op,'%d,'" is local and exported"] - INTERN STRCONC(encodeItem $prefix,'";",encodeItem op) where - isLocalFunction op == - null member(op,$formalArgList) and - getmode(op,$e) is ['Mapping,:.] + INTERN STRCONC(encodeItem $prefix,'";",encodeItem op) isPackageFunction() and KAR $functorForm^="CategoryDefaults" => if null opmodes then userError ['"no modemap for ",op] opmodes is [['PAC,.,name]] => name encodeFunctionName(op,$functorForm,$signatureOfForm,";",$suffix) encodeFunctionName(op,$functorForm,$signatureOfForm,";",$suffix) + where + isLocalFunction op == + null member(op,$formalArgList) and + getmode(op,$e) is ['Mapping,:.] u:= [op',lamExpr] -- If just updating certain functions, check for previous existence. -- Deduce old sequence number and use it (items have been skipped). @@ -1293,7 +1302,7 @@ doIt(item,$predl) == then NRTgetLocalIndex $Representation --+ $LocalDomainAlist:= --see genDeltaEntry - [[lhs,:SUBLIS($LocalDomainAlist,get(lhs,'value,$e).0)],:$LocalDomainAlist] + [[lhs,:SUBLIS($LocalDomainAlist,(get(lhs,'value,$e)).0)],:$LocalDomainAlist] --+ code is ['LET,:.] => RPLACA(item,($QuickCode => 'QSETREFV;'SETELT)) @@ -1339,36 +1348,36 @@ doItIf(item is [.,p,x,y],$predl,$e) == if x^="noBranch" then compSingleCapsuleItem(x,$predl,getSuccessEnvironment(p,$e)) x':=localExtras(oldFLP) - where localExtras(oldFLP) == - EQ(oldFLP,$functorLocalParameters) => NIL - flp1:=$functorLocalParameters - oldFLP':=oldFLP - n:=0 - while oldFLP' repeat - oldFLP':=CDR oldFLP' - flp1:=CDR flp1 - n:=n+1 - -- Now we have to add code to compile all the elements - -- of functorLocalParameters that were added during the - -- conditional compilation - nils:=ans:=[] - for u in flp1 repeat -- is =u form always an ATOM? - if ATOM u or (or/[v is [.,=u,:.] for v in $getDomainCode]) - then - nils:=[u,:nils] - else - gv := GENSYM() - ans:=[['LET,gv,u],:ans] - nils:=[gv,:nils] - n:=n+1 - $functorLocalParameters:=[:oldFLP,:NREVERSE nils] - NREVERSE ans oldFLP:=$functorLocalParameters if y^="noBranch" then compSingleCapsuleItem(y,$predl,getInverseEnvironment(p,olde)) y':=localExtras(oldFLP) RPLACA(item,"COND") RPLACD(item,[[p',x,:x'],['(QUOTE T),y,:y']]) + where localExtras(oldFLP) == + EQ(oldFLP,$functorLocalParameters) => NIL + flp1:=$functorLocalParameters + oldFLP':=oldFLP + n:=0 + while oldFLP' repeat + oldFLP':=CDR oldFLP' + flp1:=CDR flp1 + n:=n+1 + -- Now we have to add code to compile all the elements + -- of functorLocalParameters that were added during the + -- conditional compilation + nils:=ans:=[] + for u in flp1 repeat -- is =u form always an ATOM? + if ATOM u or (or/[v is [.,=u,:.] for v in $getDomainCode]) + then + nils:=[u,:nils] + else + gv := GENSYM() + ans:=[['LET,gv,u],:ans] + nils:=[gv,:nils] + n:=n+1 + $functorLocalParameters:=[:oldFLP,:NREVERSE nils] + NREVERSE ans --compSingleCapsuleIf(x,predl,e,$functorLocalParameters) == -- compSingleCapsuleItem(x,predl,e) |