From ab8cc85adde879fb963c94d15675783f2cf4b183 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Tue, 14 Aug 2007 05:14:52 +0000 Subject: Initial population. --- src/interp/ptrees.boot.pamphlet | 788 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 788 insertions(+) create mode 100644 src/interp/ptrees.boot.pamphlet (limited to 'src/interp/ptrees.boot.pamphlet') diff --git a/src/interp/ptrees.boot.pamphlet b/src/interp/ptrees.boot.pamphlet new file mode 100644 index 00000000..43471476 --- /dev/null +++ b/src/interp/ptrees.boot.pamphlet @@ -0,0 +1,788 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp ptrees.boot} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +\begin{verbatim} +Abstract Syntax Trees + +This file provides functions to create and examine abstract +syntax trees. These are called pform, for short. +The definition of valid pforms see ABSTRACT BOOT. + +!! This file also contains constructors for concrete syntax, although +!! they should be somewhere else. + +THE PFORM DATA STRUCTURE + Leaves: [hd, tok, pos] + Trees: [hd, tree, tree, ...] + hd is either an id or (id . alist) + +\end{verbatim} +\section{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. + +@ +<<*>>= +<> + +)package "BOOT" + +--constructer and selectors for leaf tokens + +tokConstruct(hd,tok,:pos)== + a:=cons(hd,tok) + IFCAR pos => + pfNoPosition? CAR pos=> a + ncPutQ(a,"posn",CAR pos) + a + a + +tokType x== ncTag x +tokPart x== CDR x +tokPosn x== + a:= QASSQ("posn",ncAlist x) + if a then CDR a else pfNoPosition() + +pfAbSynOp form == + hd := CAR form + IFCAR hd or hd + +pfAbSynOp?(form, op) == + hd := CAR form + EQ(hd, op) or EQCAR(hd, op) + +pfLeaf? form == + MEMQ(pfAbSynOp form, + '(id idsy symbol string char float expression integer + Document error)) + +pfLeaf(x,y,:z) == tokConstruct(x,y, IFCAR z or pfNoPosition()) +pfLeafToken form == tokPart form +pfLeafPosition form == tokPosn form + +pfTree(x,y) == CONS(x,y) -- was ==> +pfParts form == CDR form -- was ==> +pfFirst form == CADR form -- was ==> +pfSecond form == CADDR form -- was ==> + +--% SPECIAL NODES +pfListOf x == pfTree('listOf,x) +pfListOf? x == pfAbSynOp?(x,'listOf) +pfAppend list == APPLY(function APPEND,list) + +pfNothing () == pfTree('nothing, []) +pfNothing? form == pfAbSynOp?(form, 'nothing) + +-- SemiColon + +pfSemiColon(pfbody) == pfTree('SemiColon, [pfbody]) +pfSemiColon?(pf) == pfAbSynOp? (pf, 'SemiColon) +pfSemiColonBody pf == CADR pf -- was ==> + +--% LEAVES +pfId(expr) == pfLeaf('id, expr) +pfIdPos(expr,pos) == pfLeaf('id,expr,pos) +pfId? form == + pfAbSynOp?(form,'id) or pfAbSynOp?(form,'idsy) +pfSymbolVariable? form == pfAbSynOp?(form,'idsy) +pfIdSymbol form == tokPart form +--pfAmpersand(amptok,name) == name + +pfDocument strings == pfLeaf('Document, strings) +pfDocument? form == pfAbSynOp?(form, 'Document) +pfDocumentText form == tokPart form + +pfLiteral? form == + MEMQ(pfAbSynOp form,'(integer symbol expression + one zero char string float)) + +pfLiteralClass form == pfAbSynOp form +pfLiteralString form == tokPart form + +pfStringConstString form == tokPart form + +pfExpression(expr, :optpos) == + pfLeaf("expression", expr, IFCAR optpos) +pfExpression? form == pfAbSynOp?(form, 'expression) + +pfSymbol(expr, :optpos) == + pfLeaf("symbol", expr, IFCAR optpos) + +pfSymb(expr, :optpos) == + if pfLeaf? expr + then pfSymbol(tokPart expr,IFCAR optpos) + else pfExpression(pfSexpr expr,IFCAR optpos) + +pfSymbol? form == pfAbSynOp?(form, 'symbol) + +pfSymbolSymbol form == tokPart form + +--% TREES +-- parser interface functions +-- these are potential sources of trouble in macro expansion + +-- the comment is attached to all signatutres +pfWDec(doc,name) == [pfWDeclare(i,doc) for i in pfParts name] + +pfTweakIf form== + a:=pfIfElse form + b:=if pfNothing? a then pfListOf [] else a + pfTree('WIf,[pfIfCond form,pfIfThen form,b]) + +pfInfApplication(op,left,right)== + pfCheckInfop left => + pfWrong(pfDocument ['"infop as argument to infop"],pfListOf []) + pfCheckInfop right => + pfWrong(pfDocument ['"infop as argument to infop"],pfListOf []) + EQ(pfIdSymbol op,"and")=> pfAnd (left,right) + EQ(pfIdSymbol op, "or")=> pfOr (left,right) + pfApplication(op,pfTuple pfListOf [left,right]) + +pfCheckInfop form== false + +pfAnd(pfleft, pfright) == pfTree('And, [pfleft, pfright]) +pfAnd?(pf) == pfAbSynOp? (pf, 'And) +pfAndLeft pf == CADR pf -- was ==> +pfAndRight pf == CADDR pf -- was ==> + +pfOr(pfleft, pfright) == pfTree('Or, [pfleft, pfright]) +pfOr?(pf) == pfAbSynOp? (pf, 'Or) +pfOrLeft pf == CADR pf -- was ==> +pfOrRight pf == CADDR pf -- was ==> + +pfNot(arg) == pfTree('Not, [arg]) +pfNot?(pf) == pfAbSynOp? (pf, 'Not) +pfNotArg pf == CADR pf -- was ==> + +pfEnSequence a== + if null a + then pfTuple pfListOf a + else if null cdr a + then car a + else pfSequence pfListOf a +pfFromDom(dom,expr)== + if pfApplication? expr + then pfApplication(pfFromdom(pfApplicationOp expr,dom), + pfApplicationArg expr) + else pfFromdom(expr,dom) + +pfReturnTyped(type,body)==pfTree('returntyped,[type,body]) + +pfLam(variable,body)==-- called from parser + rets:= if pfAbSynOp?(body,'returntyped) + then pfFirst body + else pfNothing () + bdy:= if pfAbSynOp?(body,'returntyped) then pfSecond body else body + pfLambda(variable,rets,bdy) + +pfTLam(variable,body)==-- called from parser + rets:= if pfAbSynOp?(body,'returntyped) + then pfFirst body + else pfNothing () + bdy:= if pfAbSynOp?(body,'returntyped) then pfSecond body else body + pfTLambda(variable,rets,bdy) + +pfIfThenOnly(pred,first)==pfIf(pred,first,pfNothing()) + +pfLp(iterators,body)== + pfLoop pfListOf [:iterators,pfDo body] +pfLoop1 body == pfLoop pfListOf [pfDo body] + + +pfExitNoCond value== pfExit(pfNothing(),value) + +pfReturnNoName(value)==pfReturn(value,pfNothing()) + +pfBrace(a,part)==pfApplication(pfIdPos( "{}",tokPosn a),part) + +pfBracket(a,part) == pfApplication(pfIdPos( "[]",tokPosn a),part) +pfBraceBar(a,part)==pfApplication(pfIdPos( "{||}",tokPosn a),part) + +pfBracketBar(a,part) == pfApplication(pfIdPos( "[||]",tokPosn a),part) +pfHide(a,part) == pfTree("Hide",[part]) +pfHide? x== pfAbSynOp?(x,"Hide") +pfHidePart x== CADR x +pfParen(a,part)==part + +pfPile(part)==part + +pfSpread(l,t)== [pfTyped(i,t) for i in l] + +pfTupleList form== pfParts pfTupleParts form + +--The rest have been generated from ABCUT INPUT +-- 1/31/89 + + +-- Add / Application / Assign / +-- Coerceto / Collect / ComDefinition / DeclPart / +-- Exit / Export / Free / +-- Fromdom / Id / If / Inline / +-- Iterate / Lambda / +-- Break / Literal / Local / Loop / +-- MLambda / Pretend / Restrict / Return / +-- Sequence / Tagged / Tuple / Typing / +-- Where / With + +pfExpr? pf == + pfAdd? pf or _ + pfApplication? pf or _ + pfAssign? pf or _ + pfCoerceto? pf or _ + pfCollect? pf or _ + pfComDefinition? pf or _ + pfDeclPart? pf or _ + pfExit? pf or _ + pfExport? pf or _ + pfFree? pf or _ + pfFromdom? pf or _ + pfId? pf or _ + pfIf? pf or _ + pfInline? pf or _ + pfIterate? pf or _ + pfLambda? pf or _ + pfBreak? pf or _ + pfLiteral? pf or _ + pfLocal? pf or _ + pfLoop? pf or _ + pfMLambda? pf or _ + pfPretend? pf or _ + pfRestrict? pf or _ + pfReturn? pf or _ + pfTagged? pf or _ + pfTuple? pf or _ + pfWhere? pf or _ + pfWith? pf + + +pfDeclPart? pf == + pfTyping? pf or _ + pfImport? pf or _ + pfDefinition? pf or _ + pfSequence? pf or _ + pfDWhere? pf or _ + pfMacro? pf + + +-- Wrong := (Why: Document, Rubble: [Expr]) + +pfWrong(pfwhy, pfrubble) == pfTree('Wrong, [pfwhy, pfrubble]) +pfWrong?(pf) == pfAbSynOp? (pf, 'Wrong) +pfWrongWhy pf == CADR pf -- was ==> +pfWrongRubble pf == CADDR pf -- was ==> +pf0WrongRubble pf == pfParts pfWrongRubble pf + + +-- Add := (Base: [Typed], Addin: Expr) + +pfAdd(pfbase, pfaddin,:addon) == + lhs := if addon + then first addon + else pfNothing() + pfTree('Add, [pfbase, pfaddin,lhs]) + +pfAdd?(pf) == pfAbSynOp? (pf, 'Add) +pfAddBase pf == CADR pf -- was ==> +pfAddAddin pf == CADDR pf -- was ==> +pfAddAddon pf == CADDDR pf -- was ==> +pf0AddBase pf == pfParts pfAddBase pf + + + +-- DWhere := (Context: [DeclPart], Expr: [DeclPart]) + +pfDWhere(pfcontext, pfexpr) == pfTree('DWhere, [pfcontext, pfexpr]) +pfDWhere?(pf) == pfAbSynOp? (pf, 'DWhere) +pfDWhereContext pf == CADR pf -- was ==> +pfDWhereExpr pf == CADDR pf -- was ==> + + + +-- With := (Base: [Typed], Within: [WithPart]) + +pfWith(pfbase, pfwithin,pfwithon) == + pfTree('With, [pfbase, pfwithin,pfwithon]) +pfWith?(pf) == pfAbSynOp? (pf, 'With) +pfWithBase pf == CADR pf -- was ==> +pfWithWithin pf == CADDR pf -- was ==> +pfWithWithon pf == CADDDR pf -- was ==> +pf0WithBase pf == pfParts pfWithBase pf +pf0WithWithin pf == pfParts pfWithWithin pf + + +-- WIf := (Cond: Primary, Then: [WithPart], Else: [WithPart]) + +pfWIf(pfcond, pfthen, pfelse) == pfTree('WIf, [pfcond, pfthen, pfelse]) +pfWIf?(pf) == pfAbSynOp? (pf, 'WIf) +pfWIfCond pf == CADR pf -- was ==> +pfWIfThen pf == CADDR pf -- was ==> +pfWIfElse pf == CADDDR pf -- was ==> + +-- WDeclare := (Signature: Typed, Doc: ? Document) + +pfWDeclare(pfsignature, pfdoc) == pfTree('WDeclare, [pfsignature, _ +pfdoc]) +pfWDeclare?(pf) == pfAbSynOp? (pf, 'WDeclare) +pfWDeclareSignature pf == CADR pf -- was ==> +pfWDeclareDoc pf == CADDR pf -- was ==> + + +-- Attribute := (Expr: Primary) + +pfAttribute(pfexpr) == pfTree('Attribute, [pfexpr]) +pfAttribute?(pf) == pfAbSynOp? (pf, 'Attribute) +pfAttributeExpr pf == CADR pf -- was ==> + + +-- Typed := (Id: Id, Type: ? Type) + +pfTyped(pfid, pftype) == pfTree('Typed, [pfid, pftype]) +pfTyped?(pf) == pfAbSynOp? (pf, 'Typed) +pfTypedId pf == CADR pf -- was ==> +pfTypedType pf == CADDR pf -- was ==> + + +-- Application := (Op: Expr, Arg: Expr) + +pfApplication(pfop, pfarg) == + pfTree('Application, [pfop, pfarg]) + +pfApplication?(pf) == pfAbSynOp? (pf, 'Application) +pfApplicationOp pf == CADR pf -- was ==> +pfApplicationArg pf == CADDR pf -- was ==> + + +-- Tuple := (Parts: [Expr]) + +pfTupleListOf(pfparts) == pfTuple pfListOf pfparts +pfTuple(pfparts) == pfTree('Tuple, [pfparts]) +pfTuple?(pf) == pfAbSynOp? (pf, 'Tuple) +pfTupleParts pf == CADR pf -- was ==> +pf0TupleParts pf == pfParts pfTupleParts pf + + +-- Tagged := (Tag: Expr, Expr: Expr) + +pfTagged(pftag, pfexpr) == pfTree('Tagged, [pftag, pfexpr]) +pfTagged?(pf) == pfAbSynOp? (pf, 'Tagged) +pfTaggedTag pf == CADR pf -- was ==> +pfTaggedExpr pf == CADDR pf -- was ==> + + +-- Pretend := (Expr: Expr, Type: Type) + +pfPretend(pfexpr, pftype) == pfTree('Pretend, [pfexpr, pftype]) +pfPretend?(pf) == pfAbSynOp? (pf, 'Pretend) +pfPretendExpr pf == CADR pf -- was ==> +pfPretendType pf == CADDR pf -- was ==> + + +-- Restrict := (Expr: Expr, Type: Type) + +pfRestrict(pfexpr, pftype) == pfTree('Restrict, [pfexpr, pftype]) +pfRestrict?(pf) == pfAbSynOp? (pf, 'Restrict) +pfRestrictExpr pf == CADR pf -- was ==> +pfRestrictType pf == CADDR pf -- was ==> + +pfRetractTo(pfexpr, pftype) == pfTree('RetractTo, [pfexpr, pftype]) +pfRetractTo?(pf) == pfAbSynOp? (pf, 'RetractTo) +pfRetractToExpr pf == CADR pf -- was ==> +pfRetractToType pf == CADDR pf -- was ==> + + +-- Coerceto := (Expr: Expr, Type: Type) + +pfCoerceto(pfexpr, pftype) == pfTree('Coerceto, [pfexpr, pftype]) +pfCoerceto?(pf) == pfAbSynOp? (pf, 'Coerceto) +pfCoercetoExpr pf == CADR pf -- was ==> +pfCoercetoType pf == CADDR pf -- was ==> + + +-- Fromdom := (What: Id, Domain: Type) + +pfFromdom(pfwhat, pfdomain) == pfTree('Fromdom, [pfwhat, pfdomain]) +pfFromdom?(pf) == pfAbSynOp? (pf, 'Fromdom) +pfFromdomWhat pf == CADR pf -- was ==> +pfFromdomDomain pf == CADDR pf -- was ==> + + +-- Lambda := (Args: [Typed], Rets: ? Type, Body: Expr) + +pfLambda(pfargs, pfrets, pfbody) == pfTree('Lambda, [pfargs, pfrets, _ +pfbody]) +pfLambda?(pf) == pfAbSynOp? (pf, 'Lambda) +pfLambdaArgs pf == CADR pf -- was ==> +pfLambdaRets pf == CADDR pf -- was ==> +pfLambdaBody pf == CADDDR pf -- was ==> +pf0LambdaArgs pf == pfParts pfLambdaArgs pf +pfFix pf== pfApplication(pfId "Y",pf) + + +-- TLambda := (Args: [Typed], Rets: ? Type, Body: Expr) + +pfTLambda(pfargs, pfrets, pfbody) == pfTree('TLambda, [pfargs, pfrets, pfbody]) +pfTLambda?(pf) == pfAbSynOp? (pf, 'TLambda) +pfTLambdaArgs pf == CADR pf -- was ==> +pfTLambdaRets pf == CADDR pf -- was ==> +pfTLambdaBody pf == CADDDR pf -- was ==> +pf0TLambdaArgs pf == pfParts pfTLambdaArgs pf + + +-- MLambda := (Args: [Id], Body: Expr) + +pfMLambda(pfargs, pfbody) == pfTree('MLambda, [pfargs, pfbody]) +pfMLambda?(pf) == pfAbSynOp? (pf, 'MLambda) +pfMLambdaArgs pf == CADR pf -- was ==> +pfMLambdaBody pf == CADDR pf -- was ==> +pf0MLambdaArgs pf == pfParts pfMLambdaArgs pf + + +-- Where := (Context: [DeclPart], Expr: Expr) + +pfWhere(pfcontext, pfexpr) == pfTree('Where, [pfcontext, pfexpr]) +pfWhere?(pf) == pfAbSynOp? (pf, 'Where) +pfWhereContext pf == CADR pf -- was ==> +pfWhereExpr pf == CADDR pf -- was ==> +pf0WhereContext pf == pfParts pfWhereContext pf + + +-- If := (Cond: Expr, Then: Expr, Else: ? Expr) + +pfIf(pfcond, pfthen, pfelse) == pfTree('If, [pfcond, pfthen, pfelse]) +pfIf?(pf) == pfAbSynOp? (pf, 'If) +pfIfCond pf == CADR pf -- was ==> +pfIfThen pf == CADDR pf -- was ==> +pfIfElse pf == CADDDR pf -- was ==> + + +-- Sequence := (Args: [Expr]) + +pfSequence(pfargs) == pfTree('Sequence, [pfargs]) +pfSequence?(pf) == pfAbSynOp? (pf, 'Sequence) +pfSequenceArgs pf == CADR pf -- was ==> +pf0SequenceArgs pf == pfParts pfSequenceArgs pf + + +-- Novalue := (Expr: Expr) + +pfNovalue(pfexpr) == pfTree('Novalue, [pfexpr]) +pfNovalue?(pf) == pfAbSynOp? (pf, 'Novalue) +pfNovalueExpr pf == CADR pf -- was ==> + + +-- Loop := (Iterators: [Iterator]) + +pfLoop(pfiterators) == pfTree('Loop, [pfiterators]) +pfLoop?(pf) == pfAbSynOp? (pf, 'Loop) +pfLoopIterators pf == CADR pf -- was ==> +pf0LoopIterators pf == pfParts pfLoopIterators pf + + +-- Collect := (Body: Expr, Iterators: [Iterator]) + +pfCollect(pfbody, pfiterators) == pfTree('Collect, [pfbody, _ +pfiterators]) +pfCollect?(pf) == pfAbSynOp? (pf, 'Collect) +pfCollectBody pf == CADR pf -- was ==> +pfCollectIterators pf == CADDR pf -- was ==> +pf0CollectIterators pf == pfParts pfCollectIterators pf + + +-- Forin := (Lhs: [AssLhs], Whole: Expr) + +pfForin(pflhs, pfwhole) == pfTree('Forin, [pflhs, pfwhole]) +pfForin?(pf) == pfAbSynOp? (pf, 'Forin) +pfForinLhs pf == CADR pf -- was ==> +pfForinWhole pf == CADDR pf -- was ==> +pf0ForinLhs pf == pfParts pfForinLhs pf + + +-- While := (Cond: Expr) + +pfWhile(pfcond) == pfTree('While, [pfcond]) +pfWhile?(pf) == pfAbSynOp? (pf, 'While) +pfWhileCond pf == CADR pf -- was ==> + + +-- Until := (Cond: Expr) + +--pfUntil(pfcond) == pfTree('Until, [pfcond]) +--pfUntil?(pf) == pfAbSynOp? (pf, 'Until) +--pfUntilCond pf == CADR pf -- was ==> + + +-- Suchthat := (Cond: Expr) + +pfSuchthat(pfcond) == pfTree('Suchthat, [pfcond]) +pfSuchthat?(pf) == pfAbSynOp? (pf, 'Suchthat) +pfSuchthatCond pf == CADR pf -- was ==> + + +-- Do := (Body: Expr) + +pfDo(pfbody) == pfTree('Do, [pfbody]) +pfDo?(pf) == pfAbSynOp? (pf, 'Do) +pfDoBody pf == CADR pf -- was ==> + + +-- Iterate := (From: ? Id) + +pfIterate(pffrom) == pfTree('Iterate, [pffrom]) +pfIterate?(pf) == pfAbSynOp? (pf, 'Iterate) +pfIterateFrom pf == CADR pf -- was ==> + + +-- Break := (From: ? Id) + +pfBreak(pffrom) == pfTree('Break, [pffrom]) +pfBreak?(pf) == pfAbSynOp? (pf, 'Break) +pfBreakFrom pf == CADR pf -- was ==> + + +-- Return := (Expr: ? Expr, From: ? Id) + +pfReturn(pfexpr, pffrom) == pfTree('Return, [pfexpr, pffrom]) +pfReturn?(pf) == pfAbSynOp? (pf, 'Return) +pfReturnExpr pf == CADR pf -- was ==> +pfReturnFrom pf == CADDR pf -- was ==> + + +-- Exit := (Cond: ? Expr, Expr: ? Expr) + +pfExit(pfcond, pfexpr) == pfTree('Exit, [pfcond, pfexpr]) +pfExit?(pf) == pfAbSynOp? (pf, 'Exit) +pfExitCond pf == CADR pf -- was ==> +pfExitExpr pf == CADDR pf -- was ==> + + +-- Macro := (Lhs: Id, Rhs: ExprorNot) + +pfMacro(pflhs, pfrhs) == pfTree('Macro, [pflhs, pfrhs]) +pfMacro?(pf) == pfAbSynOp? (pf, 'Macro) +pfMacroLhs pf == CADR pf -- was ==> +pfMacroRhs pf == CADDR pf -- was ==> + + +-- Definition := (LhsItems: [Typed], Rhs: Expr) + +pfDefinition(pflhsitems, pfrhs) == pfTree('Definition, [pflhsitems, pfrhs]) +pfDefinition?(pf) == pfAbSynOp? (pf, 'Definition) +pfDefinitionLhsItems pf == CADR pf -- was ==> +pfDefinitionRhs pf == CADDR pf -- was ==> +pf0DefinitionLhsItems pf == pfParts pfDefinitionLhsItems pf + +pfRule(pflhsitems, pfrhs) == pfTree('Rule, [pflhsitems, _ +pfrhs]) +pfRule?(pf) == pfAbSynOp? (pf, 'Rule) +pfRuleLhsItems pf == CADR pf -- was ==> +pfRuleRhs pf == CADDR pf -- was ==> + +-- ComDefinition := (Doc:Document,Def:Definition) + +pfComDefinition(pfdoc, pfdef) == pfTree('ComDefinition, [pfdoc, pfdef] ) +pfComDefinition?(pf) == pfAbSynOp? (pf, 'ComDefinition) +pfComDefinitionDoc pf == CADR pf -- was ==> +pfComDefinitionDef pf == CADDR pf -- was ==> + + +-- DefinitionSequence := (Args: [DeclPart]) + +pfDefinitionSequenceArgs pf == CADR pf -- was ==> + +-- Export := (Def: Definition) + +pfExportDef pf == CADR pf -- was ==> + +-- Assign := (LhsItems: [AssLhs], Rhs: Expr) + +pfAssign(pflhsitems, pfrhs) == pfTree('Assign, [pflhsitems, pfrhs]) +pfAssign?(pf) == pfAbSynOp? (pf, 'Assign) +pfAssignLhsItems pf == CADR pf -- was ==> +pfAssignRhs pf == CADDR pf -- was ==> +pf0AssignLhsItems pf == pfParts pfAssignLhsItems pf + + +-- Typing := (Items: [Typed]) + +pfTyping(pfitems) == pfTree('Typing, [pfitems]) +pfTyping?(pf) == pfAbSynOp? (pf, 'Typing) +pfTypingItems pf == CADR pf -- was ==> +pf0TypingItems pf == pfParts pfTypingItems pf + + +-- Export := (Items: [Typed]) + +pfExport(pfitems) == pfTree('Export, [pfitems]) +pfExport?(pf) == pfAbSynOp? (pf, 'Export) +pfExportItems pf == CADR pf -- was ==> +pf0ExportItems pf == pfParts pfExportItems pf + + +-- Local := (Items: [Typed]) + +pfLocal(pfitems) == pfTree('Local, [pfitems]) +pfLocal?(pf) == pfAbSynOp? (pf, 'Local) +pfLocalItems pf == CADR pf -- was ==> +pf0LocalItems pf == pfParts pfLocalItems pf + +-- Free := (Items: [Typed]) + +pfFree(pfitems) == pfTree('Free, [pfitems]) +pfFree?(pf) == pfAbSynOp? (pf, 'Free) +pfFreeItems pf == CADR pf -- was ==> +pf0FreeItems pf == pfParts pfFreeItems pf + + +-- Import := (Items: [QualType]) + +pfImport(pfitems) == pfTree('Import, [pfitems]) +pfImport?(pf) == pfAbSynOp? (pf, 'Import) +pfImportItems pf == CADR pf -- was ==> +pf0ImportItems pf == pfParts pfImportItems pf + + +-- Inline := (Items: [QualType]) + +pfInline(pfitems) == pfTree('Inline, [pfitems]) +pfInline?(pf) == pfAbSynOp? (pf, 'Inline) +pfInlineItems pf == CADR pf -- was ==> + +-- QualType := (Type: Type, Qual: ? Type) + +pfQualType(pftype, pfqual) == pfTree('QualType, [pftype, pfqual]) +pfQualType?(pf) == pfAbSynOp? (pf, 'QualType) +pfQualTypeType pf == CADR pf -- was ==> +pfQualTypeQual pf == CADDR pf -- was ==> + +pfSuch(x,y)== pfInfApplication(pfId "|",x,y) + +pfTaggedToTyped x== + rt:=if pfTagged? x then pfTaggedExpr x else pfNothing() + form:= if pfTagged? x then pfTaggedTag x else x + not pfId? form => + a:=pfId GENSYM() + pfTyped(pfSuch(a, + pfInfApplication (pfId "=", a,form)),rt) + pfTyped(form,rt) + +pfTaggedToTyped1 x== + pfCollect1? x => pfCollectVariable1 x + pfDefinition? x => pfTyped(x,pfNothing()) + pfTaggedToTyped x + +pfCollectVariable1 x== + a := pfApplicationArg x + var:=first pf0TupleParts a + id:=pfTaggedToTyped var + pfTyped(pfSuch(pfTypedId id,CADR pf0TupleParts a), + pfTypedType id) + +pfPushBody(t,args,body)== + if null args + then body + else if null rest args + then pfLambda(first args,t,body) + else + pfLambda(first args,pfNothing(), + pfPushBody(t,rest args,body)) + +pfCheckItOut x == + rt:=if pfTagged? x then pfTaggedExpr x else pfNothing() + form:= if pfTagged? x then pfTaggedTag x else x + pfId? form => [pfListOf [pfTyped(form,rt)],nil,rt] + pfCollect1? form => + [pfListOf [pfCollectVariable1 form],nil,rt] + pfTuple? form => + [pfListOf [pfTaggedToTyped i for i in pf0TupleParts form],nil,rt] + pfDefinition? form => + [pfListOf [pfTyped(form,pfNothing())],nil,rt] + pfApplication? form => + ls:=pfFlattenApp form + op:= pfTaggedToTyped1 first ls + args:=[pfTransformArg i for i in rest ls] + [pfListOf [op],args,rt] + npTrapForm form + +pfCollect1? x== + pfApplication? x => + a:=pfApplicationOp x + pfId? a => pfIdSymbol a = "|" + false + false + +pfTransformArg args== + argl:= if pfTuple? args then pf0TupleParts args else [args] + pfListOf [pfTaggedToTyped1 i for i in argl] + + +pfCheckMacroOut form == + pfId? form => [form,nil] + pfApplication? form => + ls:=pfFlattenApp form + op:= pfCheckId first ls + args:=[pfCheckArg i for i in rest ls] + [op,args] + npTrapForm form + +pfCheckArg args== + argl:= if pfTuple? args then pf0TupleParts args else [args] + pfListOf [pfCheckId i for i in argl] + +pfCheckId form== if not pfId? form then npTrapForm(form) else form + +pfPushMacroBody(args,body)== + null args => body + pfMLambda(first args,pfPushMacroBody(rest args,body)) + +pfFlattenApp x== + pfApplication? x=> + pfCollect1? x =>[ x ] + append (pfFlattenApp pfApplicationOp x, + pfFlattenApp pfApplicationArg x) + [x] + + + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document} -- cgit v1.2.3