aboutsummaryrefslogtreecommitdiff
path: root/src/interp/define.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-10-31 01:41:13 +0000
committerdos-reis <gdr@axiomatics.org>2007-10-31 01:41:13 +0000
commit847e8111104c485b09b879499efe4ec3beb8942b (patch)
treecf28332ac203416194292fe44ef44d3855b5ba42 /src/interp/define.boot.pamphlet
parent161d80a8ff9c0d819710de6a83a3cb5bbcfdbe61 (diff)
downloadopen-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.pamphlet91
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)