diff options
author | dos-reis <gdr@axiomatics.org> | 2007-09-20 03:21:47 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2007-09-20 03:21:47 +0000 |
commit | 988485c37966b23cf7f3e058eb93b15d4e81236b (patch) | |
tree | a000da379fc108634189a29afa167c52160cea7f /src/interp/parse.boot.pamphlet | |
parent | 1d71a43cca77e1576cc1568298d5886a60c9b884 (diff) | |
download | open-axiom-988485c37966b23cf7f3e058eb93b15d4e81236b.tar.gz |
* Makefile.pamphlet (${DEPSYS}): Now depend on the compiled form
of parse. Load it.
(parse.$(FASLEXT)): New rule.
* parse.boot: New. Import "postpar".
* parse.boot.pamphlet: Move content to parse.boot.pamphlet. Remove.
Diffstat (limited to 'src/interp/parse.boot.pamphlet')
-rw-r--r-- | src/interp/parse.boot.pamphlet | 571 |
1 files changed, 0 insertions, 571 deletions
diff --git a/src/interp/parse.boot.pamphlet b/src/interp/parse.boot.pamphlet deleted file mode 100644 index b4c72963..00000000 --- a/src/interp/parse.boot.pamphlet +++ /dev/null @@ -1,571 +0,0 @@ -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp/parse.boot} Pamphlet} -\author{The Axiom Team} - -\begin{document} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject - -\section{parseTransform} -This is the top-level function in this file. - -When parsing spad code we walk an source code expression such as - -[[P ==> PositiveInteger]] - -This gets translated by [[|postTransform|]]\cite{1} into - -[[(MDEF P NIL NIL (|PositiveInteger|))]] - -[[|parseTranform|]] is called with this expression. The [[%]] symbol, -which represents the current domain, is replaced with the [[$]] symbol -internally. This hack was introduced because the Aldor compiler wanted -to use [[%]] for the [[current domain]]. The Spad compiler used [[$]]. -In order not to have to change this everywhere we do a subsitution here. -<<parseTransform>>= -parseTransform x == - $defOp: local:= nil - x := substitute('$,'%,x) -- for new compiler compatibility - parseTran x - -@ - -\section{parseTran} -[[|parseTran|]] sees an expression such as - -[[(MDEF P NIL NIL (|PositiveInteger|))]] - -It walks the -expression, which is a list, item by item (note the tail recursive -call in this function). In general, we are converting certain -source-level constructs into internal constructs. Note the subtle -way that functions get called in this file. The information about -what function to call is stored on the property list of the symbol. - -For example, given the form: [[(|has| S (|OrderedSet|))]] -the symbol [[|has|]] occurs in the car of the list. [[|parseTran|]] -assigns [[$op]] to be [[|has|]] and [[argl]] to be the list -[[(S (|OrderedSet|))]]. Next, a local function [[g]], which checks -for the compile-time elts, returns [[$op]] unchanged. The variable -[[u]] is set to [[|has|]]. - -Since [[|has|]] is an atom we do -[[(GET '|has| '|parseTran|)]] which returns [[|parseHas|]] -because the symbol [[|has|]] contains the association -[[|parseTran| |parseHas|]] on it's symbol property list. -You can see this by calling [[(symbol-plist '|has|)]]. - -This ends up calling [[(|parseHas| '(S (|OrderedSet|)))]]. - -The [[|parseTran|]] function walks the entire s-expression -calling special parsers for various special forms in the input. -This does things like reverse tests so that [[(if (not x) a b)]] -becomes [[(if x b a)]], etc. - -<<parseTran>>= -parseTran x == - $op: local - atom x => parseAtom x - [$op,:argl]:= x - u := g($op) where g op == (op is ["elt",op,x] => g x; op) - u="construct" => - r:= parseConstruct argl - $op is ["elt",:.] => [parseTran $op,:rest r] - r - SYMBOLP u and (fn:= GETL(u,'parseTran)) => FUNCALL(fn,argl) - [parseTran $op,:parseTranList argl] - -@ - -\section{License} -<<license>>= --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --- All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS --- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED --- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A --- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER --- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, --- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, --- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR --- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF --- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING --- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ - -<<*>>= -<<license>> - -)package "BOOT" - ---% Transformation of Parser Output - -<<parseTransform>> -<<parseTran>> - -parseAtom x == - -- next line for compatibility with new compiler - x = "break" => parseLeave ["$NoValue"] - x - -parseTranList l == - atom l => parseTran l - [parseTran first l,:parseTranList rest l] - -parseConstruct u == - $insideConstructIfTrue: local:= true - l:= parseTranList u - ["construct",:l] - -parseUpArrow u == parseTran ["**",:u] - -parseLeftArrow u == parseTran ["LET",:u] - -parseIs [a,b] == ["is",parseTran a,transIs parseTran b] - -parseIsnt [a,b] == ["isnt",parseTran a,transIs parseTran b] - -transIs u == - isListConstructor u => ["construct",:transIs1 u] - u - -isListConstructor u == u is [op,:.] and op in '(construct append cons) - -transIs1 u == - u is ["construct",:l] => [transIs x for x in l] - u is ["append",x,y] => - h:= [":",transIs x] - (v:= transIs1 y) is [":",z] => [h,z] - v="nil" => first rest h - atom v => [h,[":",v]] - [h,:v] - u is ["cons",x,y] => - h:= transIs x - (v:= transIs1 y) is [":",z] => [h,z] - v="nil" => [h] - atom v => [h,[":",v]] - [h,:v] - u - -parseLET [x,y] == - p := ["LET",parseTran x,parseTranCheckForRecord(y,opOf x)] - opOf x = "cons" => ["LET",transIs p.1,p.2] - p - -parseLETD [x,y] == ["LETD",parseTran x,parseTran parseType y] - -parseColon u == - u is [x] => [":",parseTran x] - u is [x,typ] => - $InteractiveMode => - $insideConstructIfTrue=true => ["TAG",parseTran x,parseTran typ] - [":",parseTran x,parseTran parseType typ] - [":",parseTran x,parseTran typ] - -parseBigelt [typ,consForm] == - [["elt",typ,"makeRecord"],:transUnCons consForm] - -transUnCons u == - atom u => systemErrorHere '"transUnCons" - u is ["APPEND",x,y] => - null y => x - systemErrorHere '"transUnCons" - u is ["CONS",x,y] => - atom y => [x,:y] - [x,:transUnCons y] - -parseCoerce [x,typ] == - $InteractiveMode => ["::",parseTran x,parseTran parseType typ] - ["::",parseTran x,parseTran typ] - -parseAtSign [x,typ] == - $InteractiveMode => ["@",parseTran x,parseTran parseType typ] - ["@",parseTran x,parseTran typ] - -parsePretend [x,typ] == - $InteractiveMode => ["pretend",parseTran x,parseTran parseType typ] - ["pretend",parseTran x,parseTran typ] - -parseType x == - x := substitute($EmptyMode,$quadSymbol,x) - x is ["typeOf",val] => ["typeOf",parseTran val] - $oldParserExpandAbbrs => parseTypeEvaluate unabbrevAndLoad x - x - -parseTypeEvaluate form == - form is [op,:argl] => - newType? op => form - $op: local:= op - op = "Mapping" => - [op,:[parseTypeEvaluate a for a in argl]] - op = "Union" => - isTaggedUnion form => - [op,:[['_:,sel,parseTypeEvaluate type] for - ['_:,sel,type] in argl]] - [op,:[parseTypeEvaluate a for a in argl]] - op = 'Record => - [op,:[['_:,sel,parseTypeEvaluate type] for ['_:,sel,type] in argl]] - cmm := - fn := constructor? op => - p := pathname [fn,$spadLibFT,'"*"] => - isExistingFile p => getConstructorModemap(abbreviation? fn) - nil - nil - cmm is [[.,.,:argml],:.] => [op,:parseTypeEvaluateArgs(argl,argml)] - throwKeyedMsg("S2IL0015",[op]) - form - -parseTypeEvaluateArgs(argl,argml) == - [argVal for arg in argl for md in argml for i in 1..] where argVal() == - isCategoryForm(md,$CategoryFrame) => parseTypeEvaluate arg - arg - - -parseTypeError(x,md,i) == throwKeyedMsg("S2IP0003",[i,$op,md]) - -specialModeTran form == - form is [op,:argl] => - not ATOM op => form --added 10/5/84 by SCM - (s0:= (sop:= PNAME op).0) = "*" => - n:= #sop - n=1=> form - argKey:= sop.1 - numArgs:= #argl - (argKey="1" => 1; 0) - zeroOrOne:= argKey="0" or argKey="1" - isDmp := - numArgs < 10 => - n=6 and ('"DMP"=SUBSTRING(sop,3,3)) and zeroOrOne - true => - n=7 and ('"DMP"=SUBSTRING(sop,4,3)) and zeroOrOne - isDmp => - if argKey="0" then - extraDomain:= $EmptyMode - vl:= argl - else - [:vl,extraDomain] := argl - ["DistributedMultivariatePolynomial",["construct",:vl], - specialModeTran extraDomain] - n=4 and (s3:= sop.3) = "M" and zeroOrOne => - specialModeTran - extraDomain:= (argKey="0" => [$EmptyMode]; nil) - (n:= PARSE_-INTEGER PNAME sop.2)=1 => - ["SquareMatrix",:argl,:extraDomain] - n=2 => ["RectangularMatrix",:argl,:extraDomain] - form - isUpOrMp := - numArgs < 10 => - n=4 and (s3:= sop.3) = "P" and zeroOrOne or - n=5 and (s3:= sop.3)="R" and sop.4="F" and zeroOrOne - true => - n=5 and (s3:= sop.4) = "P" and zeroOrOne or - n=6 and (s3:= sop.4)="R" and sop.5="F" and zeroOrOne - isUpOrMp => - polyForm:= - domainPart:= (argKey="0" => $EmptyMode; last argl) - argPart:= (argKey="0" => argl; drop(-1,argl)) - numArgs < 10 and (n:= PARSE_-INTEGER PNAME sop.2)=1 - => ["UP",:argPart,domainPart] - ["MP",["construct",:argPart],domainPart] - specialModeTran - s3 = "R" => [$QuotientField,polyForm] - polyForm - [first form,:[specialModeTran x for x in rest form]] - [first form,:[specialModeTran x for x in rest form]] - form - -parseHas [x,y] == - if $InteractiveMode then - x:= - get(x,'value,$CategoryFrame) is [D,m,.] - and m in '((Mode) (Domain) (SubDomain (Domain))) => D - parseType x - mkand [["has",x,u] for u in fn y] where - mkand x == - x is [a] => a - ["and",:x] - fn y == - if $InteractiveMode then y:= unabbrevAndLoad y - y is [":" ,op,["Mapping",:map]] => - op:= (STRINGP op => INTERN op; op) - [["SIGNATURE",op,map]] - y is ["Join",:u] => "append"/[fn z for z in u] - y is ["CATEGORY",:u] => "append"/[fn z for z in u] - kk:= GETDATABASE(opOf y,'CONSTRUCTORKIND) - kk = "domain" or kk = "category" => [makeNonAtomic y] - y is ["ATTRIBUTE",:.] => [y] - y is ["SIGNATURE",:.] => [y] - $InteractiveMode => parseHasRhs y - [["ATTRIBUTE",y]] - -parseHasRhs u == --$InteractiveMode = true - get(u,'value,$CategoryFrame) is [D,m,.] - and m in '((Mode) (Domain) (SubDomain (Domain))) => m - y := abbreviation? u => - loadIfNecessary y => [unabbrevAndLoad y] - [["ATTRIBUTE",u]] - [["ATTRIBUTE",u]] - -parseDEF [$lhs,tList,specialList,body] == - setDefOp $lhs - ["DEF",parseLhs $lhs,parseTranList tList,parseTranList specialList, - parseTranCheckForRecord(body,opOf $lhs)] - -parseLhs x == - atom x => parseTran x - atom first x => [parseTran first x,:[transIs parseTran y for y in rest x]] - parseTran x - -parseMDEF [$lhs,tList,specialList,body] == - ["MDEF",parseTran $lhs,parseTranList tList,parseTranList specialList, - parseTranCheckForRecord(body,opOf $lhs)] - -parseTranCheckForRecord(x,op) == - (x:= parseTran x) is ["Record",:l] => - or/[y for y in l | y isnt [":",.,.]] => - postError ['" Constructor",:bright x,'"has missing label"] - x - x - -parseCases [expr,ifClause] == - casefn(expr,ifClause) where - casefn(x,ifExpr) == - ifExpr="noBranch" => ["ifClauseError",x] - ifExpr is ["IF",a,b,c] => ["IF",parseTran a,parseTran b,casefn(x,c)] - postError ['" CASES format error: cases ",x," of ",ifExpr] - -parseCategory x == - l:= parseTranList parseDropAssertions x - key:= - CONTAINED("$",l) => "domain" - "package" - ["CATEGORY",key,:l] - -parseDropAssertions x == ---note: the COPY of this list is necessary-- do not replace by RPLACing version - x is [y,:r] => - y is ["IF","asserted",:.] => parseDropAssertions r - [y,:parseDropAssertions r] - x - -parseGreaterThan [x,y] == - [substitute("<",">",$op),parseTran y,parseTran x] - -parseGreaterEqual u == parseTran ["not",[substitute("<",">=",$op),:u]] - -parseLessEqual u == parseTran ["not",[substitute(">","<=",$op),:u]] - -parseNotEqual u == parseTran ["not",[substitute("=","^=",$op),:u]] - -parseDollarGreaterThan [x,y] == - [substitute("$<","$>",$op),parseTran y,parseTran x] - -parseDollarGreaterEqual u == - parseTran ["not",[substitute("$<","$>=",$op),:u]] - -parseDollarLessEqual u == - parseTran ["not",[substitute("$>","$<=",$op),:u]] - -parseDollarNotEqual u == - parseTran ["not",[substitute("$=","$^=",$op),:u]] - -parseAnd u == - $InteractiveMode => ["and",:parseTranList u] - null u => "true" - null rest u => first u - parseIf [parseTran first u,parseAnd rest u,"false"] - -parseOr u == - $InteractiveMode => ["or",:parseTranList u] - null u => "false" - null rest u => first u - (x:= parseTran first u) is ["not",y] => parseIf [y,parseOr rest u,"true"] - true => parseIf [x,"true",parseOr rest u] - -parseNot u == - $InteractiveMode => ["not",parseTran first u] - parseTran ["IF",first u,:'(false true)] - -parseEquivalence [a,b] == parseIf [a,b,parseIf [b,:'(false true)]] - -parseImplies [a,b] == parseIf [a,b,"true"] - -parseExclusiveOr [a,b] == parseIf [a,parseIf [b,:'(false true)],b] - -parseExit [a,:b] == - -- note: I wanted to convert 1s to 0s here to facilitate indexing in - -- comp code; unfortunately, parseTran-ning is sometimes done more - -- than once so that the count can be decremented more than once - a:= parseTran a - b:= parseTran b - b => - null INTEGERP a => - (MOAN('"first arg ",a,'" for exit must be integer"); ["exit",1,a]) - ["exit",a,:b] - ["exit",1,a] - -parseLeave [a,:b] == - a:= parseTran a - b:= parseTran b - b => - null INTEGERP a => - (MOAN('"first arg ",a,'" for 'leave' must be integer"); ["leave",1,a]) - ["leave",a,:b] - ["leave",1,a] - -parseReturn [a,:b] == - a:= parseTran a - b:= parseTran b - b => - (if a^=1 then MOAN '"multiple-level 'return' not allowed"; ["return",1,:b]) - ["return",1,a] - -parseJoin l == - ["Join",:fn parseTranList l] where - fn l == - null l => nil - l is [["Join",:x],:y] => [:x,:fn y] - [first l,:fn rest l] - -parseInBy [i,n,inc] == - (u:= parseIn [i,n]) isnt ["STEP",i,a,j,:r] => - postError [" You cannot use",:bright '"by", - '"except for an explicitly indexed sequence."] - inc:= parseTran inc - ["STEP",i,a,parseTran inc,:r] - -parseSegment p == - p is [a,b] => - b => ["SEGMENT",parseTran a, parseTran b] - ["SEGMENT",parseTran a] - ["SEGMENT",:p] - -parseIn [i,n] == - i:= parseTran i - n:= parseTran n - n is ["SEGMENT",a] => ["STEP",i,a,1] - n is ["reverse",["SEGMENT",a]] => - postError ['" You cannot reverse an infinite sequence."] - n is ["SEGMENT",a,b] => (b => ["STEP",i,a,1,b]; ["STEP",i,a,1]) - n is ["reverse",["SEGMENT",a,b]] => - b => ["STEP",i,b,-1,a] - postError ['" You cannot reverse an infinite sequence."] - n is ["tails",s] => ["ON",i,s] - ["IN",i,n] - -parseIf t == - t isnt [p,a,b] => t - ifTran(parseTran p,parseTran a,parseTran b) where - ifTran(p,a,b) == - null($InteractiveMode) and p="true" => a - null($InteractiveMode) and p="false" => b - p is ["not",p'] => ifTran(p',b,a) - p is ["IF",p',a',b'] => ifTran(p',ifTran(a',COPY a,COPY b),ifTran(b',a,b)) - p is ["SEQ",:l,["exit",1,p']] => - ["SEQ",:l,["exit",1,ifTran(p',incExitLevel a,incExitLevel b)]] - --this assumes that l has no exits - a is ["IF", =p,a',.] => ["IF",p,a',b] - b is ["IF", =p,.,b'] => ["IF",p,a,b'] - makeSimplePredicateOrNil p is ["SEQ",:s,["exit",1,val]] => - parseTran ["SEQ",:s,["exit",1,incExitLevel ["IF",val,a,b]]] - ["IF",p,a,b] - -makeSimplePredicateOrNil p == - isSimple p => nil - u:= isAlmostSimple p => u - true => wrapSEQExit [["LET",g:= GENSYM(),p],g] - -parseWhere l == ["where",:mapInto(l, function parseTran)] - - -parseSeq l == - not l is [:.,["exit",:.]] => - postError ['" Invalid ending to block: ",last l] - transSeq mapInto(l,function parseTran) - -transSeq l == - null l => nil - null rest l => decExitLevel first l - [item,:tail]:= l - item is ["SEQ",:l,["exit",1,["IF",p,["exit", =2,q],"noBranch"]]] and - (and/[x is ["LET",:.] for x in l]) => - ["SEQ",:[decExitLevel x for x in l],["exit",1,["IF",decExitLevel p, - decExitLevel q,transSeq tail]]] - item is ["IF",a,["exit",1,b],"noBranch"] => - ["IF",decExitLevel a,decExitLevel b,transSeq tail] - item is ["IF",a,"noBranch",["exit",1,b]] => - ["IF",decExitLevel a,transSeq tail,decExitLevel b] - (y:= transSeq tail) is ["SEQ",:s] => ["SEQ",item,:s] - ["SEQ",item,["exit",1,incExitLevel y]] - -transCategoryItem x == - x is ["SIGNATURE",lhs,rhs] => - lhs is ["LISTOF",:y] => - "append" /[transCategoryItem ["SIGNATURE",z,rhs] for z in y] - atom lhs => - if STRINGP lhs then lhs:= INTERN lhs - rhs is ["Mapping",:m] => - m is [.,"constant"] => LIST ["SIGNATURE",lhs,[first m],"constant"] - LIST ["SIGNATURE",lhs,m] - $transCategoryAssoc:= [[lhs,:rhs],:$transCategoryAssoc] - NIL - [op,:argl]:= lhs - extra:= nil - if rhs is ["Mapping",:m] then - if rest m then extra:= rest m - --should only be 'constant' or 'variable' - rhs:= first m - LIST ["SIGNATURE",op,[rhs,:SUBLIS($transCategoryAssoc,argl)],:extra] - LIST x - -superSub(name,x) == - for u in x repeat y:= [:y,:u] - code:= - x is [[u]] => $quadSymbol - STRCONC("_(",scriptTranRow first x,scriptTran rest x,"_)") - [INTERNL(PNAME name,"$",code),:y] - -scriptTran x == - null x => "" - STRCONC(";",scriptTranRow first x,scriptTran rest x) - -scriptTranRow x == - null x => "" - STRCONC($quadSymbol,scriptTranRow1 rest x) - -scriptTranRow1 x == - null x => "" - STRCONC(",",$quadSymbol,scriptTranRow1 rest x) - -parseVCONS l == ["VECTOR",:parseTranList l] -@ - -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} |