Initial population.

1 files changed, 575 insertions, 0 deletions

diff --git a/src/interp/pf2atree.boot.pamphlet b/src/interp/pf2atree.boot.pamphlet
new file mode 100644
index 00000000..29e85ad1
--- /dev/null
+++ b/src/interp/pf2atree.boot.pamphlet
@@ -0,0 +1,575 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp pf2atree.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\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>>
+
+-- not hooked in yet
+
+-- BB parser tree to interpreter vectorized attributed trees.
+-- Used to interface the BB parser
+-- technology to the interpreter.  The input is a parseTree and the
+-- output is an interpreter attributed tree.
+
+SETANDFILEQ($useParserSrcPos, true)
+SETANDFILEQ($transferParserSrcPos, true)
+
+pf2Sexpr pf == packageTran (pf2Sex1)(pf)
+
+pf2Atree pf ==
+    (intUnsetQuiet)()
+
+    $insideRule:        local := false
+    $insideApplication: local := false
+    $insideSEQ:         local := false
+
+    -- we set the following because we will be using some things
+    -- within pf2sex.boot and they are in the spadcomp package.
+
+    ($insideRule):        local := false
+    ($insideApplication): local := false
+    ($insideSEQ):         local := false
+
+    pf2Atree1 pf
+
+pf2Atree1 pf ==
+    -- some simple things that are really just S-expressions
+
+    (pfNothing?)(pf) =>
+        mkAtree1WithSrcPos(pf2Sexpr(pf), pf)
+    (pfSymbol?) pf =>
+        mkAtree1WithSrcPos(pf2Sexpr(pf), pf)
+    (pfLiteral?)(pf) =>
+        mkAtree1WithSrcPos(pf2Sexpr(pf), pf)
+    (pfId?) pf =>
+        mkAtree1WithSrcPos(pf2Sexpr(pf), pf)
+
+    -- Now some compound forms
+
+    (pfApplication?)(pf) =>
+        pfApplication2Atree pf
+
+    (pfTuple?)(pf) =>
+        [mkAtreeNodeWithSrcPos("Tuple",pf),
+            :[pf2Atree1 x for x in (pf0TupleParts)(pf)]]
+
+    (pfIf?)(pf) =>
+        condPf      := (pfIfCond)(pf)
+        condPart    := pf2Atree1 condPf
+        thenPart    := pf2Atree1 (pfIfThen)(pf)
+        elsePart    := pf2Atree1 (pfIfElse)(pf)
+        ifPart      := mkAtreeNodeWithSrcPos("IF", pf)
+        thenPart = "noBranch" =>
+            [ifPart, [mkAtreeNodeWithSrcPos("not", condPf), condPart],
+                elsePart, thenPart]
+        [ifPart, condPart, thenPart, elsePart]
+
+    (pfTagged?)(pf) =>
+        tag := (pfTaggedTag)(pf)
+        tagPart :=
+            (pfTuple?) tag =>
+                ["Tuple", :[pf2Sexpr(arg) for arg in (pf0TupleParts)(tag)]]
+            pf2Sexpr(tag)
+        [mkAtreeNodeWithSrcPos("Declare",pf), tagPart,
+            pf2Sexpr((pfTaggedExpr)(pf))]
+
+    (pfCoerceto?)(pf) =>
+        [mkAtreeNodeWithSrcPos("COERCE",pf),
+            pf2Atree1 (pfCoercetoExpr)(pf),
+                pf2Sexpr((pfCoercetoType)(pf))]
+
+    (pfPretend?)(pf) =>
+        [mkAtreeNodeWithSrcPos("pretend",pf),
+            pf2Atree1 (pfPretendExpr)(pf),
+                pf2Sexpr((pfPretendType)(pf))]
+
+    (pfFromdom?)(pf) =>
+        op := packageTran (opTran)(pf2Sexpr((pfFromdomWhat)(pf)))
+        if op = "braceFromCurly" then op := "SEQ"         -- ??
+
+        op = 0 =>
+            -- 0$Foo => Zero()$Foo
+            [mkAtreeNodeWithSrcPos("Dollar",pf),
+                pf2Sexpr((pfFromdomDomain)(pf)),
+                    [mkAtreeNodeWithSrcPos("Zero",pf)]]
+        op = 1 =>
+            -- 1$Foo => One()$Foo
+            [mkAtreeNodeWithSrcPos("Dollar",pf),
+                pf2Sexpr((pfFromdomDomain)(pf)),
+                    [mkAtreeNodeWithSrcPos("One",pf)]]
+        INTEGERP op =>
+            -- n$Foo => n * One()$Foo
+            [mkAtreeNodeWithSrcPos("*",pf),
+                mkAtree1WithSrcPos(op,pf),
+                    [mkAtreeNodeWithSrcPos("Dollar",pf),
+                        pf2Sexpr((pfFromdomDomain)(pf)),
+                            [mkAtreeNodeWithSrcPos("One",pf)]]]
+
+        [mkAtreeNodeWithSrcPos("Dollar",pf),
+            pf2Sexpr((pfFromdomDomain)(pf)),
+                mkAtreeNodeWithSrcPos(op,pf)]
+
+    (pfSequence?)(pf) =>
+        pfSequence2Atree pf
+
+    (pfExit?)(pf) =>
+        $insideSEQ =>
+            [mkAtreeNodeWithSrcPos("exit",pf),
+                pf2Atree1 (pfExitCond)(pf),
+                    pf2Atree1 (pfExitExpr)(pf)]
+        [mkAtreeNodeWithSrcPos("IF",pf),
+             pf2Atree1 (pfExitCond)(pf),
+                pf2Atree1 (pfExitExpr)(pf), "noBranch"]
+
+    (pfLoop?)(pf) =>
+        [mkAtreeNodeWithSrcPos("REPEAT",pf),
+            :loopIters2Atree  (pf0LoopIterators)(pf)]
+
+    (pfCollect?)(pf) =>
+        pfCollect2Atree(pf)
+
+    (pfForin?)(pf) =>
+        ["IN", :[pf2Atree1 x for x in (pf0ForinLhs)(pf)],
+            pf2Atree1 (pfForinWhole)(pf)]
+
+    (pfWhile?)(pf) =>
+        ["WHILE", pf2Atree1((pfWhileCond)(pf))]
+
+    (pfSuchthat?)(pf) =>
+        $insideRule = 'left =>
+            keyedSystemError('"S2GE0017", ['"pf2Atree1: pfSuchThat"])
+        ["SUCHTHAT", pf2Atree1 (pfSuchthatCond)(pf)]
+
+    (pfDo?)(pf) =>
+        pf2Atree1 (pfDoBody)(pf)
+
+--  (pfTyped?)(pf) =>
+--    type := pfTypedType pf
+--    pfNothing? type => pf2Atree1 pfTypedId pf
+--    [":", pf2Atree1 pfTypedId pf, pf2Atree1 pfTypedType pf]
+
+    (pfAssign?)(pf) =>
+        -- declarations on the lhs are broken out into another
+        -- statement preceding the LET of the id(s)
+        lhsThings := (pf0AssignLhsItems)(pf)
+        if #lhsThings = 1 and (pfTuple?)(first lhsThings) then
+            lhsThings := (pf0TupleParts)(first lhsThings)
+        decls := nil
+        ids   := nil
+        for x in lhsThings repeat
+            (pfTagged?)(x) =>
+                decls := [x, :decls]
+                ids   := [(pfTaggedTag)(x), :ids]
+            ids   := [x, :ids]
+        idList := [pf2Atree1 x for x in reverse ids]
+        if #idList ^= 1 then idList :=
+            [mkAtreeNodeWithSrcPos("Tuple",pf), :idList]
+        else idList := first idList
+        x := [mkAtreeNodeWithSrcPos("LET",pf),
+            idList, pf2Atree1 (pfAssignRhs)(pf)]
+        decls =>
+            [mkAtreeNodeWithSrcPos("SEQ",pf),
+                :[pf2Atree1 decl for decl in nreverse decls], x]
+        x
+
+--  (pfDefinition?)(pf) =>
+--      pfDefinition2Atree pf
+
+--  (pfLambda?)(pf) =>
+--    pfLambda2Atree pf
+--  (pfRestrict?)(pf) =>
+--    ["@", pf2Atree1 pfRestrictExpr pf, pf2Atree1 pfRestrictType pf]
+
+    (pfFree?)(pf) =>
+        [mkAtreeNodeWithSrcPos("free",pf),
+            :[pf2Atree1 item for item in (pf0FreeItems)(pf)]]
+    (pfLocal?)(pf) =>
+        [mkAtreeNodeWithSrcPos("local",pf),
+            :[pf2Atree1 item for item in (pf0LocalItems)(pf)]]
+
+    (pfWrong?)(pf) =>
+        spadThrow()
+
+    -- next 3 are probably be handled in pfApplication2Atree
+
+    (pfAnd?)(pf) =>
+        [mkAtreeNodeWithSrcPos("and",pf),
+            pf2Atree1 (pfAndLeft)(pf),
+                pf2Atree1 (pfAndRight)(pf)]
+    (pfOr?)(pf) =>
+        [mkAtreeNodeWithSrcPos("or",pf),
+            pf2Atree1 (pfOrLeft)(pf),
+                pf2Atree1 (pfOrRight)(pf)]
+    (pfNot?)(pf) =>
+        [mkAtreeNodeWithSrcPos("not",pf),
+            pf2Atree1 (pfNotArg)(pf)]
+
+--  (pfNovalue?)(pf) =>
+--    intSetQuiet()
+--    ["SEQ", pf2Atree1 pfNovalueExpr pf]
+--  (pfRule?)(pf) =>
+--    pfRule2Atree pf
+
+    (pfBreak?)(pf) =>
+        [mkAtreeNodeWithSrcPos("break",pf), (pfBreakFrom)(pf)]
+
+    (pfMacro?)(pf) =>
+        tree := mkAtree1WithSrcPos('(void), pf)
+        putValue(tree,objNewWrap(voidValue(),$Void))
+        putModeSet(tree,[$Void])
+        tree
+
+    (pfReturn?)(pf) =>
+        [mkAtreeNodeWithSrcPos("return",pf),
+            pf2Atree1 (pfReturnExpr)(pf)]
+
+    (pfIterate?)(pf) =>
+        [mkAtreeNodeWithSrcPos("iterate",pf)]
+
+--  (pfWhere?)(pf) =>
+--    args := [pf2Atree1 p for p in pf0WhereContext pf]
+--    #args = 1 =>
+--      ["where", pf2Atree1 pfWhereExpr pf, :args]
+--    ["where", pf2Atree1 pfWhereExpr pf, ["SEQ", :args]]
+
+    mkAtree1WithSrcPos(pf2Sexpr(pf), pf)
+
+--  keyedSystemError('"S2GE0017", ['"pf2Atree1"])
+--
+
+pfApplication2Atree pf ==
+    $insideApplication:             local := true
+    ($insideApplication): local := true
+
+    opPf := (pfApplicationOp)(pf)
+    op := packageTran ((opTran)(pfOp2Sex)(opPf))
+    op = "->" =>
+        args := (pf0TupleParts)((pfApplicationArg)(pf))
+        if (pfTuple?)(CAR args) then
+            typeList := [pf2Atree1 arg for arg in (pf0TupleParts)(CAR args)]
+        else
+            typeList := [pf2Atree1 CAR args]
+        args := [pf2Atree1 CADR args, :typeList]
+        [mkAtreeNodeWithSrcPos("Mapping", opPf), :args]
+
+    (symEqual)(op, '":") and $insideRule = 'left =>
+          [mkAtreeNodeWithSrcPos("multiple",opPf),
+              pf2Atree (pfApplicationArg)(pf)]
+
+    (symEqual)(op, '"?") and $insideRule = 'left =>
+          [mkAtreeNodeWithSrcPos("optional",opPf),
+              pf2Atree (pfApplicationArg)(pf)]
+
+    args := (pfApplicationArg)(pf)
+
+    (pfTuple?)(args) =>
+--!     symEqual(op, '"|") and $insideRule = 'left =>
+--!       pfSuchThat2Atree args
+        argAtree := [pf2Atree1 arg for arg in (pf0TupleParts)(args)]
+
+        (symEqual)(op, '">") =>
+            [mkAtreeNodeWithSrcPos("<",opPf), :reverse(argAtree)]
+        (symEqual)(op, '">=") =>
+            [mkAtreeNodeWithSrcPos("not",opPf),
+                [mkAtreeNodeWithSrcPos("<",opPf), :argAtree]]
+        (symEqual)(op, '"<=") =>
+            [mkAtreeNodeWithSrcPos("not",opPf),
+                [mkAtreeNodeWithSrcPos("<",opPf), :reverse(argAtree)]]
+        (symEqual)(op, '"AND") =>
+            [mkAtreeNodeWithSrcPos("and",opPf), :argAtree]
+        (symEqual)(op, '"OR") =>
+            [mkAtreeNodeWithSrcPos("or",opPf), :argAtree]
+        (symEqual) (op, '"Iterate") =>
+            [mkAtreeNodeWithSrcPos("iterate",opPf)]
+        (symEqual)(op, '"by") =>
+            [mkAtreeNodeWithSrcPos("BY",opPf), :argAtree]
+        (symEqual)(op, '"braceFromCurly") =>
+            argAtree and getUnname first argAtree = "SEQ" => argAtree
+            [mkAtreeNodeWithSrcPos("SEQ",opPf), :argAtree]
+        op is [qt, realOp] and (symEqual)(qt, '"QUOTE") =>
+            [mkAtreeNodeWithSrcPos("applyQuote",opPf),
+                mkAtreeNodeWithSrcPos(op,opPf), :argAtree]
+--!     val := (hasOptArgs?)(argSex) => [op, :val]
+        -- handle package call
+        (pfFromdom?)(opPf) =>
+            opAtree := pf2Atree1 opPf
+            [CAR opAtree, CADR opAtree, [CADDR opAtree, :argAtree]]
+        -- regular call
+        [mkAtreeNodeWithSrcPos(op,opPf), :argAtree]
+
+    op is [qt, realOp] and (symEqual)(qt, '"QUOTE") =>
+       [mkAtreeNodeWithSrcPos("applyQuote",opPf),
+           mkAtreeNodeWithSrcPos(op,opPf), pf2Atree1 args]
+    (symEqual)(op, '"braceFromCurly") =>
+        x := pf2Atree1 args
+        x and getUnname x = "SEQ" => x
+        [mkAtreeNodeWithSrcPos("SEQ",opPf), x]
+    (symEqual)(op, '"by") =>
+        [mkAtreeNodeWithSrcPos("BY",opPf), pf2Atree1 args]
+    -- handle package call
+    (pfFromdom?)(opPf) =>
+        opAtree := pf2Atree1 opPf
+        [CAR opAtree, CADR opAtree, [CADDR opAtree, pf2Atree1 args]]
+    -- regular call
+    [mkAtreeNodeWithSrcPos(op,opPf), pf2Atree1 args]
+
+--  pfDefinition2Atree pf ==
+--  --! $insideApplication =>
+--  --!     ["OPTARG", pf2Atree1 CAR pf0DefinitionLhsItems pf,
+--  --!         pf2Atree1 pfDefinitionRhs pf]
+--      idList := [pf2Atree1 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 := [pf2Atree1 pfTypedType arg, :argTypeList]
+--        systemError '"definition args should be typed"
+--      argList := nreverse argList
+--      retType :=
+--        pfNothing? pfLambdaRets pf => nil
+--        pf2Atree1 pfLambdaRets pf
+--      argTypeList := [retType, :nreverse argTypeList]
+--      [argList, :[argTypeList, [nil for arg in argTypeList],
+--        pf2Atree1 pfLambdaBody pf]]
+--    ['id, :['(()), '(()), pf2Atree1 pf]]
+--
+--  pfLambda2Atree pf ==
+--    [argList, :body] := pfLambdaTran pf
+--    ["ADEF", argList, :body]
+--
+--  pfCollectArgTran pf ==
+--    pfCollect? pf =>
+--      conds := [pf2Atree1 x for x in pfParts pfCollectIterators pf]
+--      id := pf2Atree1 pfCollectBody pf
+--      conds is [["|", cond]] =>
+--        ["|", id, cond]
+--      [id, :conds]
+--    pf2Atree1 pf
+--
+
+pfSequence2Atree pf ==
+    $insideSEQ:             local := true
+    ($insideSEQ): local := true
+
+    seq := pfSequence2Atree0([pf2Atree1 x for x in (pf0SequenceArgs)(pf)], pf)
+    seqSex := (pfSequence2Sex0)([pf2Sexpr(x) for x in (pf0SequenceArgs)(pf)])
+    seqSex is ["SEQ", :ruleList] and ruleList is [["rule", :.], :.] =>
+        [mkAtreeNodeWithSrcPos("ruleset",pf),
+            [mkAtreeNodeWithSrcPos("construct",pf), :rest seq]]
+    seq
+
+pfSequence2Atree0(seqList, pf) ==
+    null seqList => "noBranch"
+    seqTranList := []
+    while seqList ^= nil repeat
+        item := first seqList
+        item is [exitVal, cond, value] and getUnname(exitVal) = "exit" =>
+            item := [mkAtreeNodeWithSrcPos("IF",pf), cond, value,
+                pfSequence2Atree0(rest seqList, pf)]
+            seqTranList := [item, :seqTranList]
+            seqList := nil
+        seqTranList := [item ,:seqTranList]
+        seqList := rest seqList
+    #seqTranList = 1 => first seqTranList
+    [mkAtreeNodeWithSrcPos("SEQ",pf), :nreverse seqTranList]
+
+--
+--  float2Atree 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)
+--    [., frac, :exp] := bfForm
+--    [["$elt", intNewFloat(), 'float], frac, exp, 10]
+--
+
+loopIters2Atree iterList ==
+    -- could probably do a better job of getting accurate SrcPos info onto parts
+    result := nil
+    for iter in iterList repeat
+        -- ON and UNTIL forms are no longer supported
+        sex := pf2Sexpr(iter)
+        sex is ['IN, var, ['SEGMENT, i, ["BY", incr]]] =>
+            newIter := ["STEP", var, mkAtree1WithSrcPos(i,iter),
+                mkAtree1WithSrcPos(incr, iter)]
+            result := [newIter, :result]
+        sex is ['IN, var, ["BY", ['SEGMENT, i, j], incr]] =>
+            newIter := ["STEP", var, mkAtree1WithSrcPos(i,iter),
+                mkAtree1WithSrcPos(incr, iter), mkAtree1WithSrcPos(j,iter)]
+            result := [newIter, :result]
+        sex is ['IN, var, ['SEGMENT, i, j]] =>
+            newIter := ["STEP", var, mkAtree1WithSrcPos(i,iter),
+                mkAtree1WithSrcPos(1,iter), mkAtree1WithSrcPos(j,iter)]
+            result := [newIter, :result]
+        sex is ['IN, var, s] =>
+            newIter := ["IN", var, mkAtree1 s]
+            result := [newIter, :result]
+        result := [pf2Atree1(iter), :result]
+    nreverse result
+
+pfCollect2Atree pf ==
+    atree := [mkAtree1WithSrcPos("COLLECT",pf),
+        :loopIters2Atree (pfParts)((pfCollectIterators)(pf)),
+            pf2Atree1 (pfCollectBody)(pf)]
+
+    -- next are for what appears to a parser screw-up
+    sex := ["COLLECT",
+        :(loopIters2Sex)((pfParts)((pfCollectIterators)(pf))),
+            pf2Sexpr (pfCollectBody)(pf)]
+    sex is ["COLLECT", ["|", cond], var] and SYMBOLP var =>
+        [., [., condAtree], varAtree] := atree
+        ["SUCHTHAT", varAtree, condAtree]
+
+    atree
+
+--
+--  pfRule2Atree pf ==
+--    $quotedOpList:local := nil
+--    $predicateList:local := nil
+--    $multiVarPredicateList:local := nil
+--    lhs := pfLhsRule2Atree pfRuleLhsItems pf
+--    rhs := pfRhsRule2Atree 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
+--
+--  pfLhsRule2Atree lhs ==
+--    $insideRule: local := 'left
+--    ($insideRule): local := 'left
+--    pf2Atree1 lhs
+--
+--
+--  pfRhsRule2Atree rhs ==
+--    $insideRule: local := 'right
+--    ($insideRule): local := 'right
+--    pf2Atree1 rhs
+--
+
+--  pfSuchThat2Atree args ==
+--    name := GENTEMP()
+--    argList := pf0TupleParts args
+--    lhsSex := pf2Atree1 CAR argList
+--    rhsSex := pf2Atree CADR argList
+--    $predicateList := [[name, lhsSex, :rhsSex], :$predicateList]
+--    name
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}