diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/ChangeLog | 6 | ||||
| -rw-r--r-- | src/interp/Makefile.in | 7 | ||||
| -rw-r--r-- | src/interp/Makefile.pamphlet | 13 | ||||
| -rw-r--r-- | src/interp/define.boot (renamed from src/interp/define.boot.pamphlet) | 78 | ||||
| -rw-r--r-- | src/interp/functor.boot.pamphlet | 48 |
5 files changed, 60 insertions, 92 deletions
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog index bc1dc193..f74f3000 100644 --- a/src/interp/ChangeLog +++ b/src/interp/ChangeLog @@ -1,4 +1,10 @@ 2007-11-01 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet (functor.$(FASLEXT)): New rule. + (<<functor.clisp>>): Remove. + * functor.boot.pamphlet: Push into package "BOOT". + +2007-11-01 Gabriel Dos Reis <gdr@cs.tamu.edu> Waldek Hebisch <hebisch@math.uni.wroc.pl> * int-top.boot (ncParseFromString): Fix thinko. diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index b2f00424..97fac659 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -457,6 +457,9 @@ define.$(FASLEXT): define.boot cattable.$(FASLEXT) category.$(FASLEXT) \ c-util.$(FASLEXT) $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $< +functor.$(FASLEXT): functor.boot 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=. $< @@ -689,10 +692,6 @@ database.clisp: database.boot @ echo 243 making $@ from $< @ echo '(old-boot::boot "database.boot")' | ${DEPSYS} -functor.clisp: functor.boot - @ echo 254 making $@ from $< - @ echo '(old-boot::boot "functor.boot")' | ${DEPSYS} - i-analy.clisp: i-analy.boot @ echo 280 making $@ from $< @ echo '(old-boot::boot "i-analy.boot")' | ${DEPSYS} diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 9ff90c55..69abbb73 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -1116,14 +1116,6 @@ database.clisp: database.boot @ echo '(old-boot::boot "database.boot")' | ${DEPSYS} @ -\subsection{functor.boot} - -<<functor.clisp>>= -functor.clisp: functor.boot - @ echo 254 making $@ from $< - @ echo '(old-boot::boot "functor.boot")' | ${DEPSYS} -@ - \subsection{i-analy.boot} <<i-analy.clisp>>= @@ -1564,6 +1556,9 @@ define.$(FASLEXT): define.boot cattable.$(FASLEXT) category.$(FASLEXT) \ c-util.$(FASLEXT) $(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $< +functor.$(FASLEXT): functor.boot 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=. $< @@ -1774,8 +1769,6 @@ boot-pkg.$(FASLEXT): boot-pkg.lisp <<database.clisp>> -<<functor.clisp>> - <<i-analy.clisp>> <<i-code.clisp>> diff --git a/src/interp/define.boot.pamphlet b/src/interp/define.boot index 6bebbf01..20238790 100644 --- a/src/interp/define.boot.pamphlet +++ b/src/interp/define.boot @@ -1,45 +1,7 @@ -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp/define.boot} Pamphlet} -\author{The Axiom Team} - -\begin{document} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject - -\section{compCapsuleItems} - -The variable [[data]] appears to be unbound at runtime. Optimized -code won't check for this but interpreted code fails. We should -PROVE that data is unbound at runtime but have not done so yet. -Rather than remove the code entirely (since there MIGHT be a -path where it is used) we check for the runtime bound case and -assign [[$myFunctorBody]] if data has a value. - -The [[compCapsuleInner]] function in this file LOOKS like it sets -data and expects code to manipulate the assigned data structure. -Since we can't be sure we take the least disruptive course of action. -<<compCapsuleItems>>= -compCapsuleItems(itemlist,$predl,$e) == - $TOP__LEVEL: local - $myFunctorBody :local -- := data ---needed for translator - 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) - $e - -@ -\section{License} -<<license>>= -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. +-- Copyright (C) 2007, Gabriel Dos Reis. +-- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are @@ -69,9 +31,6 @@ compCapsuleItems(itemlist,$predl,$e) == -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<<license>> import '"c-util" import '"cattable" @@ -183,7 +142,7 @@ macroExpand(x,e) == --not worked out yet macroExpandList(l,e) == -- macros should override niladic props (l is [name]) and IDENTP name and GETDATABASE(name, 'NILADIC) and - (u := get(name, 'macro, e)) => macroExpand(u,e) + (u := get(name, 'macro, e)) => macroExpand(u,e) [macroExpand(x,e) for x in l] compDefineCategory1(df is ['DEF,form,sig,sc,body],m,e,prefix,fal) == @@ -1078,8 +1037,8 @@ compile u == encodeFunctionName(op,$functorForm,$signatureOfForm,";",$suffix) where isLocalFunction op == - null member(op,$formalArgList) and - getmode(op,$e) is ['Mapping,:.] + 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). @@ -1259,7 +1218,18 @@ processFunctor(form,signature,data,localParList,e) == error "CategoryDefaults is a reserved name" buildFunctor(form,signature,data,localParList,e) -<<compCapsuleItems>> +compCapsuleItems(itemlist,$predl,$e) == + $TOP__LEVEL: local + $myFunctorBody :local -- := data ---needed for translator + -- ??? the following line needs more investigation. Why is data + -- ??? expected to be a dynamic variable? Looks more like a bug. + 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) + $e + compSingleCapsuleItem(item,$predl,$e) == doIt(macroExpandInPlace(item,$e),$predl) $e @@ -1370,11 +1340,11 @@ doItIf(item is [.,p,x,y],$predl,$e) == 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] + nils:=[u,:nils] else - gv := GENSYM() - ans:=[['LET,gv,u],:ans] - nils:=[gv,:nils] + gv := GENSYM() + ans:=[['LET,gv,u],:ans] + nils:=[gv,:nils] n:=n+1 $functorLocalParameters:=[:oldFLP,:NREVERSE nils] NREVERSE ans @@ -1535,9 +1505,3 @@ compCategoryItem(x,predl) == -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/functor.boot.pamphlet b/src/interp/functor.boot.pamphlet index 7e952a88..60111870 100644 --- a/src/interp/functor.boot.pamphlet +++ b/src/interp/functor.boot.pamphlet @@ -50,6 +50,10 @@ <<*>>= <<license>> +import '"c-util" +import '"category" +)package "BOOT" + --% Domain printing keyItem a == isDomain a => CDAR a.4 @@ -243,7 +247,7 @@ compCategories1(u,v) == NewbFVectorCopy(u,domName) == v:= GETREFV SIZE u for i in 0..5 repeat v.i:= u.i - for i in 6..MAXINDEX v | PAIRP u.i repeat v.i:= [Undef,[domName,i],:first u.i] + for i in 6..MAXINDEX v | PAIRP u.i repeat v.i:= [function Undef,[domName,i],:first u.i] v mkVector u == @@ -360,11 +364,12 @@ setVector12 args == args2:=[CDR u,:args2] freeof($domainShell.1,args1) and freeof($domainShell.2,args1) and - freeof($domainShell.4,args1) => nil where freeof(a,b) == - ATOM a => NULL MEMQ(a,b) - freeof(CAR a,b) => freeof(CDR a,b) - false + freeof($domainShell.4,args1) => nil [['SetDomainSlots124,'$,['QUOTE,args1],['LIST,:args2]]] + where freeof(a,b) == + ATOM a => NULL MEMQ(a,b) + freeof(CAR a,b) => freeof(CDR a,b) + false SetDomainSlots124(vec,names,vals) == l:= PAIR(names,vals) @@ -483,7 +488,7 @@ setVector4part3(catNames,catvecList) == generated:= nil for u in catvecList for uname in catNames repeat for v in CADDR u.4 repeat - if w:= ASSOC(first v,generated) + if w:= assoc(first v,generated) then RPLACD(w,[[rest v,:uname],:rest w]) else generated:= [[first v,[rest v,:uname]],:generated] codeList := nil @@ -500,7 +505,7 @@ PrepareConditional u == u setVector5(catNames,locals) == generated:= nil for u in locals for uname in catNames repeat - if w:= ASSOC(u,generated) + if w:= assoc(u,generated) then RPLACD(w,[uname,:rest w]) else generated:= [[u,uname],:generated] [(w:= mkVectorWithDeferral(first u,first rest u); @@ -611,7 +616,7 @@ DescendCode(code,flag,viewAssoc,EnvToPass) == NREVERSE [v for u in REVERSE codelist | (v:= DescendCode(u,flag,viewAssoc,EnvToPass))^=nil]] code is ['COND,:condlist] => - c:= [[u2:= ProcessCond(first u,viewAssoc),:q] for u in condlist] where q == + c:= [[u2:= ProcessCond(first u,viewAssoc),:q] for u in condlist] where q() == null u2 => nil f:= TruthP u2 => flag; @@ -769,7 +774,7 @@ CheckVector(vec,name,catvecListMaker) == if y=v then code:= [[($QuickCode => 'QSETREFV; 'SETELT),name,i,x],:code] if name='$ then - ASSOC(first v,$CheckVectorList) => nil + assoc(first v,$CheckVectorList) => nil $CheckVectorList:= [[first v,:makeMissingFunctionEntry(condAlist,i)],:$CheckVectorList] -- member(first v,$CheckVectorList) => nil @@ -863,7 +868,7 @@ InvestigateConditions catvecListMaker == ['AND,:u] for [v,:.] in newS repeat for v' in [v,:CAR (CatEval v).4] repeat - if (w:=ASSOC(v',$HackSlot4)) then + if (w:=assoc(v',$HackSlot4)) then RPLAC(rest w,if rest w then mkOr(u,rest w) else u) (list:= update(list,u,secondaries,newS)) where update(list,cond,secondaries,newS) == @@ -907,17 +912,7 @@ ICformat u == l1:=mkAnd(u,l1) l1 u is ['OR,:l] => - (l:= ORreduce l) where - ORreduce l == - for u in l | u is ['AND,:.] or u is ['and,:.] repeat - --check that B causes (and A B) to go - for v in l | not (v=u) repeat - if member(v,u) or (and/[member(w,u) for w in v]) then l:= - delete(u,l) - --v subsumes u - --Note that we are ignoring AND as a component. - --Convince yourself that this code still works - l + (l:= ORreduce l) LENGTH l=1 => ICformat first l l:= ORreduce REMDUP [ICformat u for u in l] --causes multiple ANDs to be squashed, etc. @@ -941,6 +936,17 @@ ICformat u == LENGTH l=1 => first l ['OR,:l] systemErrorHere '"ICformat" + where + ORreduce l == + for u in l | u is ['AND,:.] or u is ['and,:.] repeat + --check that B causes (and A B) to go + for v in l | not (v=u) repeat + if member(v,u) or (and/[member(w,u) for w in v]) then l:= + delete(u,l) + --v subsumes u + --Note that we are ignoring AND as a component. + --Convince yourself that this code still works + l partPessimise(a,trueconds) == atom a => a |