diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/ChangeLog | 15 | ||||
| -rw-r--r-- | src/interp/Makefile.in | 4 | ||||
| -rw-r--r-- | src/interp/Makefile.pamphlet | 14 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 2 | ||||
| -rw-r--r-- | src/interp/define.boot.pamphlet | 91 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 42 | ||||
| -rw-r--r-- | src/interp/i-intern.boot.pamphlet | 39 | ||||
| -rw-r--r-- | src/interp/setq.lisp | 2 | ||||
| -rw-r--r-- | src/interp/sys-globals.boot | 1 |
9 files changed, 117 insertions, 93 deletions
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog index 2eb17b19..f05f86fe 100644 --- a/src/interp/ChangeLog +++ b/src/interp/ChangeLog @@ -1,3 +1,18 @@ +2007-10-30 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * 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. + 2007-10-29 Gabriel Dos Reis <gdr@cs.tamu.edu> * Makefile.pamphlet (cattable.$(FASLEXT)): New rule. diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index 88439f3f..089d96b8 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -453,6 +453,10 @@ match.$(FASLEXT): match.boot sys-macros.$(FASLEXT) ## OpenAxiom's compiler +define.$(FASLEXT): define.boot cattable.$(FASLEXT) category.$(FASLEXT) \ + c-util.$(FASLEXT) + $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $< + category.$(FASLEXT): category.boot g-util.$(FASLEXT) $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $< diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index ae08a35e..9aff4959 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -1124,14 +1124,6 @@ database.clisp: database.boot @ echo '(old-boot::boot "database.boot")' | ${DEPSYS} @ -\subsection{define.boot} - -<<define.clisp>>= -define.clisp: define.boot - @ echo 247 making $@ from $< - @ echo '(old-boot::boot "define.boot")' | ${DEPSYS} -@ - \subsection{functor.boot} <<functor.clisp>>= @@ -1595,6 +1587,10 @@ match.$(FASLEXT): match.boot sys-macros.$(FASLEXT) ## OpenAxiom's compiler +define.$(FASLEXT): define.boot cattable.$(FASLEXT) category.$(FASLEXT) \ + c-util.$(FASLEXT) + $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $< + category.$(FASLEXT): category.boot g-util.$(FASLEXT) $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $< @@ -1801,8 +1797,6 @@ boot-pkg.$(FASLEXT): boot-pkg.lisp <<database.clisp>> -<<define.clisp>> - <<functor.clisp>> <<i-analy.clisp>> diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 8bb8927c..e5f0a977 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -37,7 +37,7 @@ import '"g-util" --% Debugging Functions -CONTINUE() == continue() +--CONTINUE() == continue() continue() == FIN comp($x,$m,$f) LEVEL(:l) == APPLY('level,l) 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) diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 128e683b..117e8552 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -48,6 +48,48 @@ PPtoFile(x, fname) == SHUT stream x + +get(x,prop,e) == + $InteractiveMode => get0(x,prop,e) + get1(x,prop,e) + +get0(x,prop,e) == + null atom x => get(QCAR x,prop,e) + u:= QLASSQ(x,CAR QCAR e) => QLASSQ(prop,u) + (tail:= CDR QCAR e) and (u:= fastSearchCurrentEnv(x,tail)) => + QLASSQ(prop,u) + nil + +get1(x,prop,e) == + --this is the old get + null atom x => get(QCAR x,prop,e) + prop="modemap" and $insideCapsuleFunctionIfTrue=true => + LASSOC("modemap",getProplist(x,$CapsuleModemapFrame)) + or get2(x,prop,e) + LASSOC(prop,getProplist(x,e)) or get2(x,prop,e) + +get2(x,prop,e) == + prop="modemap" and constructor? x => + (u := getConstructorModemap(x)) => [u] + nil + nil + +put(x,prop,val,e) == + $InteractiveMode and not EQ(e,$CategoryFrame) => + putIntSymTab(x,prop,val,e) + --e must never be $CapsuleModemapFrame + null atom x => put(first x,prop,val,e) + newProplist:= augProplistOf(x,prop,val,e) + prop="modemap" and $insideCapsuleFunctionIfTrue=true => + SAY ["**** modemap PUT on CapsuleModemapFrame: ",val] + $CapsuleModemapFrame:= + addBinding(x,augProplistOf(x,"modemap",val,$CapsuleModemapFrame), + $CapsuleModemapFrame) + e + addBinding(x,newProplist,e) + + + -- Convert an arbitrary lisp object to canonical boolean. bool x == NULL NULL x diff --git a/src/interp/i-intern.boot.pamphlet b/src/interp/i-intern.boot.pamphlet index 1257ee0d..1ac1079b 100644 --- a/src/interp/i-intern.boot.pamphlet +++ b/src/interp/i-intern.boot.pamphlet @@ -629,31 +629,6 @@ getFlag x == get("--flags--",x,$e) putFlag(flag,value) == $e := put ("--flags--", flag, value, $e) -get(x,prop,e) == - $InteractiveMode => get0(x,prop,e) - get1(x,prop,e) - -get0(x,prop,e) == - null atom x => get(QCAR x,prop,e) - u:= QLASSQ(x,CAR QCAR e) => QLASSQ(prop,u) - (tail:= CDR QCAR e) and (u:= fastSearchCurrentEnv(x,tail)) => - QLASSQ(prop,u) - nil - -get1(x,prop,e) == - --this is the old get - null atom x => get(QCAR x,prop,e) - prop="modemap" and $insideCapsuleFunctionIfTrue=true => - LASSOC("modemap",getProplist(x,$CapsuleModemapFrame)) - or get2(x,prop,e) - LASSOC(prop,getProplist(x,e)) or get2(x,prop,e) - -get2(x,prop,e) == - prop="modemap" and constructor? x => - (u := getConstructorModemap(x)) => [u] - nil - nil - getI(x,prop) == get(x,prop,$InteractiveFrame) putI(x,prop,val) == ($InteractiveFrame := put(x,prop,val,$InteractiveFrame)) @@ -683,20 +658,6 @@ fastSearchCurrentEnv(x,currentEnv) == while (currentEnv:= QCDR currentEnv) repeat u:= QLASSQ(x,CAR currentEnv) => u -put(x,prop,val,e) == - $InteractiveMode and not EQ(e,$CategoryFrame) => - putIntSymTab(x,prop,val,e) - --e must never be $CapsuleModemapFrame - null atom x => put(first x,prop,val,e) - newProplist:= augProplistOf(x,prop,val,e) - prop="modemap" and $insideCapsuleFunctionIfTrue=true => - SAY ["**** modemap PUT on CapsuleModemapFrame: ",val] - $CapsuleModemapFrame:= - addBinding(x,augProplistOf(x,"modemap",val,$CapsuleModemapFrame), - $CapsuleModemapFrame) - e - addBinding(x,newProplist,e) - putIntSymTab(x,prop,val,e) == null atom x => putIntSymTab(first x,prop,val,e) pl0 := pl := search(x,e) diff --git a/src/interp/setq.lisp b/src/interp/setq.lisp index 2a182dba..195a1c84 100644 --- a/src/interp/setq.lisp +++ b/src/interp/setq.lisp @@ -104,7 +104,6 @@ (SETQ |S:SPADKEY| NIL) ;" this is augmented by MAKESPADOP" (SETQ |/EDIT,FT| 'SPAD) (SETQ |/EDIT,FM| 'A) -(SETQ /EDITFILE NIL) (SETQ INITCOLUMN 0) (SETQ |$functionTable| NIL) (SETQ |$spaddefs| NIL) @@ -311,7 +310,6 @@ |t#31| |t#32| |t#33| |t#34| |t#35| |t#36| |t#37| |t#38| |t#39| |t#40| |t#41| |t#42| |t#43| |t#44| |t#45| |t#46| |t#47| |t#48| |t#49| |t#50|)) -(SETQ NRTPARSE NIL) (SETQ |$NRTflag| T) (SETQ |$NRTaddForm| NIL) (SETQ |$NRTdeltaList| NIL) diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot index 9baac4f2..1e185a4e 100644 --- a/src/interp/sys-globals.boot +++ b/src/interp/sys-globals.boot @@ -404,6 +404,7 @@ SPADERRORSTREAM := _*ERROR_-OUTPUT_* ++ _/VERSION := 0 _/WSNAME := "NOBOOT" +_/EDITFILE := nil ++ CHR := nil |