aboutsummaryrefslogtreecommitdiff
path: root/src/interp/pf2sex.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-10-15 07:32:38 +0000
committerdos-reis <gdr@axiomatics.org>2007-10-15 07:32:38 +0000
commit6c715d9b21d64a8d6e46563d238c5526cab811a3 (patch)
tree3f47b1e28138da174f98cfe7c7a028c98b96de5d /src/interp/pf2sex.boot.pamphlet
parent438fc2b3dca328c5e9a10e75ccb6ec25d8cf782e (diff)
downloadopen-axiom-6c715d9b21d64a8d6e46563d238c5526cab811a3.tar.gz
remove more pamphlets from interp/
Diffstat (limited to 'src/interp/pf2sex.boot.pamphlet')
-rw-r--r--src/interp/pf2sex.boot.pamphlet526
1 files changed, 0 insertions, 526 deletions
diff --git a/src/interp/pf2sex.boot.pamphlet b/src/interp/pf2sex.boot.pamphlet
deleted file mode 100644
index a5ea9b6e..00000000
--- a/src/interp/pf2sex.boot.pamphlet
+++ /dev/null
@@ -1,526 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp pf2sex.boot}
-\author{The Axiom Team}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-\section{Changes}
-In the function [[float2Sex]] we need to special case the return value
-if the global variable [[$useBFasDefault]] is set to true. This variable
-allows ``big'' floating point values.
-
-The change can be seen from this email from Greg Vanuxem:
-\begin{verbatim}
-Attached is the patch (pf2sex.patch) that allows the use
-of DoubleFloat by default in the interpreter. Test it.
-
-(1) -> 1.7+7.2
-
- (1) 8.9
- Type: Float
-(2) -> 1.7-7.2
-
- (2) - 5.5
- Type: Float
-(3) -> -1.7-7.2
-
- (3) - 8.9
- Type: Float
-(4) -> )boot $useBFasDefault:=false
-
-(SPADLET |$useBFasDefault| NIL)
-Value = NIL
-
-(4) -> 1.7+7.2
-
- (4) 8.9000000000000004
- Type: DoubleFloat
-(5) -> 1.7-7.2
-
- (5) - 5.5
- Type: DoubleFloat
-(6) -> -1.7-7.2
-
- (6) - 8.9000000000000004
- Type: DoubleFloat
-
-
-
-\end{verbatim}
-\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"
-
-$dotdot := INTERN('"..", '"BOOT")
-$specificMsgTags := nil
-
--- Pftree to s-expression translation. Used to interface the new parser
--- technology to the interpreter. The input is a parseTree and the
--- output is an old-parser-style s-expression
-
-pf2Sex pf ==
- intUnsetQuiet()
- $insideRule:local := false
- $insideApplication: local := false
- $insideSEQ: local := false
- pf2Sex1 pf
-
-pf2Sex1 pf ==
- pfNothing? pf =>
- "noBranch"
- pfSymbol? pf =>
- $insideRule = 'left =>
- s := pfSymbolSymbol pf
- ["constant", ["QUOTE", s]]
- ["QUOTE", pfSymbolSymbol pf]
- pfLiteral? pf =>
- pfLiteral2Sex pf
- pfId? pf =>
- $insideRule =>
- s := pfIdSymbol pf
- SymMemQ(s, '(%pi %e %i)) => s
- ["QUOTE", s]
- pfIdSymbol pf
- pfApplication? pf =>
- pfApplication2Sex pf
- pfTuple? pf =>
- ["Tuple", :[pf2Sex1 x for x in pf0TupleParts pf]]
- pfIf? pf =>
- ['IF, pf2Sex1 pfIfCond pf, pf2Sex1 pfIfThen pf, pf2Sex1 pfIfElse pf]
- pfTagged? pf =>
- tag := pfTaggedTag pf
- tagPart :=
- pfTuple? tag =>
- ['Tuple, :[pf2Sex1 arg for arg in pf0TupleParts tag]]
- pf2Sex1 tag
- [":", tagPart, pf2Sex1 pfTaggedExpr pf]
- pfCoerceto? pf =>
- ["::", pf2Sex1 pfCoercetoExpr pf, pf2Sex1 pfCoercetoType pf]
- pfPretend? pf =>
- ["pretend", pf2Sex1 pfPretendExpr pf, pf2Sex1 pfPretendType pf]
- pfFromdom? pf =>
- op := opTran pf2Sex1 pfFromdomWhat pf
--- if op = "braceFromCurly" then op := "brace"
- if op = "braceFromCurly" then op := "SEQ"
- ["$elt", pf2Sex1 pfFromdomDomain pf, op]
- pfSequence? pf =>
- pfSequence2Sex pf
- pfExit? pf =>
- $insideSEQ => ["exit", pf2Sex1 pfExitCond pf, pf2Sex1 pfExitExpr pf]
- ["IF", pf2Sex1 pfExitCond pf, pf2Sex1 pfExitExpr pf, "noBranch"]
- pfLoop? pf =>
- ["REPEAT", :loopIters2Sex pf0LoopIterators pf]
- pfCollect? pf =>
- pfCollect2Sex pf
- pfForin? pf =>
- ["IN", :[pf2Sex1 x for x in pf0ForinLhs pf], pf2Sex1 pfForinWhole pf]
- pfWhile? pf =>
- ["WHILE", pf2Sex1 pfWhileCond pf]
- pfSuchthat? pf =>
- $insideRule = 'left =>
- keyedSystemError('"S2GE0017", ['"pf2Sex1: pfSuchThat"])
- ["|", pf2Sex1 pfSuchthatCond pf]
- pfDo? pf =>
- pf2Sex1 pfDoBody pf
- pfTyped? pf =>
- type := pfTypedType pf
- pfNothing? type => pf2Sex1 pfTypedId pf
- [":", pf2Sex1 pfTypedId pf, pf2Sex1 pfTypedType pf]
- pfAssign? pf =>
- idList := [pf2Sex1 x for x in pf0AssignLhsItems pf]
- if #idList ^= 1 then idList := ['Tuple, :idList]
- else idList := first idList
- ["LET", idList, pf2Sex1 pfAssignRhs pf]
- pfDefinition? pf =>
- pfDefinition2Sex pf
- pfLambda? pf =>
- pfLambda2Sex pf
- pfMLambda? pf =>
- "/throwAway"
- pfRestrict? pf =>
- ["@", pf2Sex1 pfRestrictExpr pf, pf2Sex1 pfRestrictType pf]
- pfFree? pf =>
- ['free, :[pf2Sex1 item for item in pf0FreeItems pf]]
- pfLocal? pf =>
- ['local, :[pf2Sex1 item for item in pf0LocalItems pf]]
- pfWrong? pf =>
- spadThrow()
- pfAnd? pf =>
- ["and", pf2Sex1 pfAndLeft pf, pf2Sex1 pfAndRight pf]
- pfOr? pf =>
- ["or", pf2Sex1 pfOrLeft pf, pf2Sex1 pfOrRight pf]
- pfNot? pf =>
- ["not", pf2Sex1 pfNotArg pf]
- pfNovalue? pf =>
- intSetQuiet()
- ["SEQ", pf2Sex1 pfNovalueExpr pf]
- pfRule? pf =>
- pfRule2Sex pf
- pfBreak? pf =>
- ["break", pfBreakFrom pf]
- pfMacro? pf =>
- "/throwAway"
- pfReturn? pf =>
- ["return", pf2Sex1 pfReturnExpr pf]
- pfIterate? pf =>
- ["iterate"]
- pfWhere? pf =>
- args := [pf2Sex1 p for p in pf0WhereContext pf]
- #args = 1 =>
- ["where", pf2Sex1 pfWhereExpr pf, :args]
- ["where", pf2Sex1 pfWhereExpr pf, ["SEQ", :args]]
-
- -- under strange circumstances/piling, system commands can wind
- -- up in expressions. This just passes it through as a string for
- -- the user to figure out what happened.
- pfAbSynOp(pf) = "command" => tokPart(pf)
-
- keyedSystemError('"S2GE0017", ['"pf2Sex1"])
-
-pfLiteral2Sex pf ==
- type := pfLiteralClass pf
- type = 'integer =>
- READ_-FROM_-STRING pfLiteralString pf
- type = 'string or type = 'char =>
- pfLiteralString pf
- type = 'float =>
- float2Sex pfLiteralString pf
- type = 'symbol =>
- $insideRule =>
- s := pfSymbolSymbol pf
- ["QUOTE", s]
- pfSymbolSymbol pf
- type = 'expression =>
- ["QUOTE", pfLeafToken pf]
- keyedSystemError('"S2GE0017", ['"pfLiteral2Sex: unexpected form"])
-
-symEqual(sym, sym2) == EQ(sym, sym2)
-
-SymMemQ(sy, l) == MEMQ(sy, l)
-
-pmDontQuote? sy ==
- SymMemQ(sy, '(_+ _- _* _*_* _^ _/ log exp pi sqrt ei li erf ci si dilog _
- sin cos tan cot sec csc asin acos atan acot asec acsc _
- sinh cosh tanh coth sech csch asinh acosh atanh acoth asech acsc))
-
-pfOp2Sex pf ==
- alreadyQuoted := pfSymbol? pf
- op := pf2Sex1 pf
- op is ["QUOTE", realOp] =>
- $insideRule = 'left => realOp
- $insideRule = 'right =>
- pmDontQuote? realOp => realOp
- $quotedOpList := [op, :$quotedOpList]
- op
- symEqual(realOp, "|") => realOp
- symEqual(realOp, ":") => realOp
- symEqual(realOp, "?") => realOp
- op
- op
-
-pfApplication2Sex pf ==
- $insideApplication: local := true
- op := pfOp2Sex pfApplicationOp pf
- op := opTran op
- op = "->" =>
- args := pf0TupleParts pfApplicationArg pf
- if pfTuple? CAR args then
- typeList := [pf2Sex1 arg for arg in pf0TupleParts CAR args]
- else
- typeList := [pf2Sex1 CAR args]
- args := [pf2Sex1 CADR args, :typeList]
- ["Mapping", :args]
- symEqual(op, ":") and $insideRule = 'left =>
- ["multiple", pf2Sex pfApplicationArg pf]
- symEqual(op, "?") and $insideRule = 'left =>
- ["optional", pf2Sex pfApplicationArg pf]
- args := pfApplicationArg pf
- pfTuple? args =>
- symEqual(op, "|") and $insideRule = 'left =>
- pfSuchThat2Sex args
- argSex := rest pf2Sex1 args
- symEqual(op, ">") =>
- ["<", CADR argSex, CAR argSex]
- symEqual(op, ">=") =>
- ["not", ["<", CAR argSex, CADR argSex]]
- symEqual(op, "<=") =>
- ["not", ["<", CADR argSex, CAR argSex]]
--- symEqual(op, "reduce") and (#argSex) = 2 =>
--- ["REDUCE", first argSex, 0, CADR argSex]
- symEqual(op, "AND") =>
- ["and", CAR argSex, CADR argSex]
- symEqual(op, "OR") =>
- ["or", CAR argSex, CADR argSex]
- symEqual(op, "Iterate") =>
- ["iterate"]
- symEqual(op, "by") =>
- ["BY", :argSex]
- symEqual(op, "braceFromCurly") =>
--- ["brace", ["construct", :argSex]]
- argSex is ["SEQ",:.] => argSex
- ["SEQ", :argSex]
- op is [qt, realOp] and symEqual(qt, "QUOTE") =>
- ["applyQuote", op, :argSex]
- val := hasOptArgs? argSex => [op, :val]
- [op, :argSex]
- op is [qt, realOp] and symEqual(qt, "QUOTE") =>
- ["applyQuote", op, pf2Sex1 args]
- symEqual(op, "braceFromCurly") =>
--- ["brace", ["construct", pf2Sex1 args]]
- x := pf2Sex1 args
- x is ["SEQ", :.] => x
- ["SEQ", x]
- symEqual(op, "by") =>
- ["BY", pf2Sex1 args]
- [op, pf2Sex1 args]
-
-hasOptArgs? argSex ==
- nonOpt := nil
- opt := nil
- for arg in argSex repeat
- arg is ["OPTARG", lhs, rhs] =>
- opt := [[lhs, rhs], :opt]
- nonOpt := [arg, :nonOpt]
- null opt => nil
- NCONC (nreverse nonOpt, [["construct", :nreverse opt]])
-
-pfDefinition2Sex pf ==
- $insideApplication =>
- ["OPTARG", pf2Sex1 CAR pf0DefinitionLhsItems pf,
- pf2Sex1 pfDefinitionRhs pf]
- idList := [pf2Sex1 x for x in pf0DefinitionLhsItems pf]
- #idList ^= 1 =>
- systemError '"lhs of definition must be a single item in the interpreter"
- id := first idList
- rhs := pfDefinitionRhs pf
- [argList, :body] := pfLambdaTran rhs
- ["DEF", (argList = 'id => id; [id, :argList]), :body]
-
-pfLambdaTran pf ==
- pfLambda? pf =>
- argTypeList := nil
- argList := nil
- for arg in pf0LambdaArgs pf repeat
- pfTyped? arg =>
- argList := [pfCollectArgTran pfTypedId arg, :argList]
- pfNothing? pfTypedType arg =>
- argTypeList := [nil, :argTypeList]
- argTypeList := [pf2Sex1 pfTypedType arg, :argTypeList]
- systemError '"definition args should be typed"
- argList := nreverse argList
- retType :=
- pfNothing? pfLambdaRets pf => nil
- pf2Sex1 pfLambdaRets pf
- argTypeList := [retType, :nreverse argTypeList]
- [argList, :[argTypeList, [nil for arg in argTypeList],
- pf2Sex1 pfLambdaBody pf]]
- ['id, :['(()), '(()), pf2Sex1 pf]]
-
-pfLambda2Sex pf ==
- [argList, :body] := pfLambdaTran pf
- ["ADEF", argList, :body]
-
-pfCollectArgTran pf ==
- pfCollect? pf =>
- conds := [pf2Sex1 x for x in pfParts pfCollectIterators pf]
- id := pf2Sex1 pfCollectBody pf
- conds is [["|", cond]] =>
- ["|", id, cond]
- [id, :conds]
- pf2Sex1 pf
-
-opTran op ==
- op = $dotdot => "SEGMENT"
- op = "[]" => "construct"
- op = "{}" => "braceFromCurly"
- op = "IS" => "is"
- op
-
-pfSequence2Sex pf ==
- $insideSEQ:local := true
- seq := pfSequence2Sex0 [pf2Sex1 x for x in pf0SequenceArgs pf]
- seq is ["SEQ", :ruleList] and ruleList is [["rule", :.], :.] =>
- ["ruleset", ["construct", :ruleList]]
- seq
-
-pfSequence2Sex0 seqList ==
- null seqList => "noBranch"
- seqTranList := []
- while seqList ^= nil repeat
- item := first seqList
- item is ["exit", cond, value] =>
- item := ["IF", cond, value, pfSequence2Sex0 rest seqList]
- seqTranList := [item, :seqTranList]
- seqList := nil
- seqTranList := [item ,:seqTranList]
- seqList := rest seqList
- #seqTranList = 1 => first seqTranList
- ["SEQ", :nreverse seqTranList]
-
-float2Sex num ==
- eIndex := SEARCH('"e", num)
- mantPart :=
- eIndex => SUBSEQ(num, 0, eIndex)
- num
- expPart := (eIndex => READ_-FROM_-STRING SUBSEQ(num, eIndex+1); 0)
- dotIndex := SEARCH('".", mantPart)
- intPart :=
- dotIndex => READ_-FROM_-STRING SUBSEQ(mantPart, 0, dotIndex)
- READ_-FROM_-STRING mantPart
- fracPartString :=
- dotIndex => SUBSEQ(mantPart, dotIndex+1)
- '"0"
- bfForm := MAKE_-FLOAT(intPart, READ_-FROM_-STRING fracPartString,
- LENGTH fracPartString, expPart)
- $useBFasDefault =>
- [., frac, :exp] := bfForm
- [["$elt", intNewFloat(), 'float], frac, exp, 10]
- bfForm
-
-loopIters2Sex iterList ==
- result := nil
- for iter in iterList repeat
- sex := pf2Sex1 iter
- sex is ['IN, var, ['SEGMENT, i, ["BY", incr]]] =>
- result := [['STEP, var, i, incr], :result]
- sex is ['IN, var, ["BY", ['SEGMENT, i, j], incr]] =>
- result := [['STEP, var, i, incr, j], :result]
- sex is ['IN, var, ['SEGMENT, i, j]] =>
- result := [['STEP, var, i, 1, j], :result]
- result := [sex, :result]
- nreverse result
-
-pfCollect2Sex pf ==
- sex := ["COLLECT", :loopIters2Sex pfParts pfCollectIterators pf,
- pf2Sex1 pfCollectBody pf]
- sex is ["COLLECT", ["|", cond], var] and SYMBOLP var =>
- ["|", var, cond]
- sex
-
-pfRule2Sex pf ==
- $quotedOpList:local := nil
- $predicateList:local := nil
- $multiVarPredicateList:local := nil
- lhs := pfLhsRule2Sex pfRuleLhsItems pf
- rhs := pfRhsRule2Sex pfRuleRhs pf
- lhs := ruleLhsTran lhs
- rulePredicateTran
- $quotedOpList => ["rule", lhs, rhs, ["construct", :$quotedOpList]]
- ["rule", lhs, rhs]
-
-
-ruleLhsTran ruleLhs ==
- for pred in $predicateList repeat
- [name, predLhs, :predRhs] := pred
- vars := patternVarsOf predRhs
- CDR vars => -- if there is more than one patternVariable
- ruleLhs := NSUBST(predLhs, name, ruleLhs)
- $multiVarPredicateList := [pred, :$multiVarPredicateList]
- predicate :=
- [., var] := predLhs
- ["suchThat", predLhs, ["ADEF", [var],
- '((Boolean) (Expression (Integer))), '(() ()), predRhs]]
- ruleLhs := NSUBST(predicate, name, ruleLhs)
- ruleLhs
-
-rulePredicateTran rule ==
- null $multiVarPredicateList => rule
- varList := patternVarsOf [rhs for [.,.,:rhs] in $multiVarPredicateList]
- predBody :=
- CDR $multiVarPredicateList =>
- ['AND, :[:pvarPredTran(rhs, varList) for [.,.,:rhs] in
- $multiVarPredicateList]]
- [[.,.,:rhs],:.] := $multiVarPredicateList
- pvarPredTran(rhs, varList)
- ['suchThat, rule,
- ['construct, :[["QUOTE", var] for var in varList]],
- ['ADEF, '(predicateVariable),
- '((Boolean) (List (Expression (Integer)))), '(() ()),
- predBody]]
-
-pvarPredTran(rhs, varList) ==
- for var in varList for i in 1.. repeat
- rhs := NSUBST(['elt, 'predicateVariable, i], var, rhs)
- rhs
-
-patternVarsOf expr ==
- patternVarsOf1(expr, nil)
-
-patternVarsOf1(expr, varList) ==
- NULL expr => varList
- ATOM expr =>
- null SYMBOLP expr => varList
- SymMemQ(expr, varList) => varList
- [expr, :varList]
- expr is [op, :argl] =>
- for arg in argl repeat
- varList := patternVarsOf1(arg, varList)
- varList
- varList
-
-pfLhsRule2Sex lhs ==
- $insideRule: local := 'left
- pf2Sex1 lhs
-
-
-pfRhsRule2Sex rhs ==
- $insideRule: local := 'right
- pf2Sex1 rhs
-
-pfSuchThat2Sex args ==
- name := GENTEMP()
- argList := pf0TupleParts args
- lhsSex := pf2Sex1 CAR argList
- rhsSex := pf2Sex CADR argList
- $predicateList := [[name, lhsSex, :rhsSex], :$predicateList]
- name
-
-
-
-
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}