From 3a83e42280a29741eefd9ec6bfbc21fb5da3aaf6 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Wed, 12 Sep 2007 23:47:29 +0000 Subject: * posit.boot: New. Import sys-macros, astr. (tokConstruct): Move from ptrees.boot.pamphlet. (tokType): Likewise. (tokPart): Likewise. (tokPosn): Likewise. (pfAbSynOp): Likewise. (pfAbSynOp?): Likewise. (pfLeaf?): Likewise. (pfLeaf): Likewise. (pfLeafToken): Likewise. (pfLeafPosition): Likewise. (pfTree): Likewise. (pfParts): Likewise. (pfFirst): Likewise. (pfSecond): Likewise. * astr.boot: New. Import boot-pkg. * sys-constants.boot (IDENTITY): Define. * patches.lisp.pamphlet (identity): Move definition to sys-constants. * cformat.boot: New. Import unlisp, posit. Add ugly workwound for GCL bug. * incl.boot: New. Import unlisp, cstream, cformat. Tweak. Add ugly workwound for GCL bug. (incLude1): Fix thinko * Makefile.pamphlet (incl.$(FASLEXT)): New rule. (cformat.$(FASLEXT)): Likewise. (posit.$(FASLEXT)): Likewise. (astr.$(FASLEXT)): Likewise. (DEP): Don't include bits.lisp. (${DEPSYS}): Explicitly load "bits" here. --- src/interp/ChangeLog | 32 +++ src/interp/Makefile.in | 17 +- src/interp/Makefile.pamphlet | 17 +- src/interp/astr.boot | 80 +++++++ src/interp/astr.boot.pamphlet | 99 --------- src/interp/cformat.boot | 99 +++++++++ src/interp/cformat.boot.pamphlet | 108 ---------- src/interp/incl.boot | 435 +++++++++++++++++++++++++++++++++++++ src/interp/incl.boot.pamphlet | 447 --------------------------------------- src/interp/patches.lisp.pamphlet | 2 - src/interp/posit.boot | 220 +++++++++++++++++++ src/interp/posit.boot.pamphlet | 200 ------------------ src/interp/ptrees.boot.pamphlet | 38 ---- src/interp/sys-constants.boot | 3 + 14 files changed, 901 insertions(+), 896 deletions(-) create mode 100644 src/interp/astr.boot delete mode 100644 src/interp/astr.boot.pamphlet create mode 100644 src/interp/cformat.boot delete mode 100644 src/interp/cformat.boot.pamphlet create mode 100644 src/interp/incl.boot delete mode 100644 src/interp/incl.boot.pamphlet create mode 100644 src/interp/posit.boot delete mode 100644 src/interp/posit.boot.pamphlet (limited to 'src') diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog index 2c9c2332..ac77f0e0 100644 --- a/src/interp/ChangeLog +++ b/src/interp/ChangeLog @@ -1,3 +1,35 @@ +2007-09-12 Gabriel Dos Reis + + * posit.boot: New. Import sys-macros, astr. + (tokConstruct): Move from ptrees.boot.pamphlet. + (tokType): Likewise. + (tokPart): Likewise. + (tokPosn): Likewise. + (pfAbSynOp): Likewise. + (pfAbSynOp?): Likewise. + (pfLeaf?): Likewise. + (pfLeaf): Likewise. + (pfLeafToken): Likewise. + (pfLeafPosition): Likewise. + (pfTree): Likewise. + (pfParts): Likewise. + (pfFirst): Likewise. + (pfSecond): Likewise. + * astr.boot: New. Import boot-pkg. + * sys-constants.boot (IDENTITY): Define. + * patches.lisp.pamphlet (identity): Move definition to sys-constants. + * cformat.boot: New. Import unlisp, posit. Add ugly workwound + for GCL bug. + * incl.boot: New. Import unlisp, cstream, cformat. Tweak. + Add ugly workwound for GCL bug. + (incLude1): Fix thinko + * Makefile.pamphlet (incl.$(FASLEXT)): New rule. + (cformat.$(FASLEXT)): Likewise. + (posit.$(FASLEXT)): Likewise. + (astr.$(FASLEXT)): Likewise. + (DEP): Don't include bits.lisp. + (${DEPSYS}): Explicitly load "bits" here. + 2007-09-12 Gabriel Dos Reis * unlisp.lisp.pamphlet: Import sys-macros. diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index ebfa61fa..e66865dc 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -33,7 +33,7 @@ depsys_boot_sources = postpar.boot parse.boot clam.boot slam.boot \ DEP= nlib.lisp \ macros.lisp $(srcdir)/comp.lisp \ spaderror.lisp debug.lisp \ - spad.lisp bits.lisp \ + spad.lisp \ setq.lisp property.lisp \ unlisp.lisp foam_l.lisp \ axext_l.lisp @@ -332,6 +332,7 @@ depsys_objects = nocompil.$(FASLEXT) bookvol5.$(FASLEXT) g-error.$(FASLEXT) \ ${DEPSYS}: vmlisp.$(FASLEXT) \ hash.$(FASLEXT) \ + bits.$(FASLEXT) \ ggreater.$(FASLEXT) \ union.$(FASLEXT) \ boot-pkg.$(FASLEXT) \ @@ -358,6 +359,7 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \ @ rm -f makedep.lisp @ $(mkinstalldirs) $(axiom_build_bindir) @ echo '(|importModule| "vmlisp")' >> makedep.lisp + @ echo '(|importModule| "bits")' >> makedep.lisp @ echo '(|importModule| "hash")' >> makedep.lisp @ echo '(|importModule| "ggreater")' >> makedep.lisp @ echo '(|importModule| "union")' >> makedep.lisp @@ -477,12 +479,25 @@ database.date: $(AUTO)/%.$(FASLEXT): %.$(FASLEXT) $(INSTALL) $< $@ + +incl.$(FASLEXT): incl.clisp cstream.$(FASLEXT) unlisp.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + +cformat.$(FASLEXT): cformat.clisp unlisp.$(FASLEXT) posit.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + unlisp.$(FASLEXT): unlisp.lisp sys-macros.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< +posit.$(FASLEXT): posit.clisp sys-macros.$(FASLEXT) astr.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + cstream.$(FASLEXT): cstream.clisp sys-macros.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< +astr.$(FASLEXT): astr.clisp boot-pkg.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + bits.$(FASLEXT): bits.lisp boot-pkg.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index ccde669f..2f3825f1 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -271,7 +271,7 @@ in this list of files. DEP= nlib.lisp \ macros.lisp $(srcdir)/comp.lisp \ spaderror.lisp debug.lisp \ - spad.lisp bits.lisp \ + spad.lisp \ setq.lisp property.lisp \ unlisp.lisp foam_l.lisp \ axext_l.lisp @@ -965,6 +965,7 @@ depsys_objects = nocompil.$(FASLEXT) bookvol5.$(FASLEXT) g-error.$(FASLEXT) \ ${DEPSYS}: vmlisp.$(FASLEXT) \ hash.$(FASLEXT) \ + bits.$(FASLEXT) \ ggreater.$(FASLEXT) \ union.$(FASLEXT) \ boot-pkg.$(FASLEXT) \ @@ -991,6 +992,7 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \ @ rm -f makedep.lisp @ $(mkinstalldirs) $(axiom_build_bindir) @ echo '(|importModule| "vmlisp")' >> makedep.lisp + @ echo '(|importModule| "bits")' >> makedep.lisp @ echo '(|importModule| "hash")' >> makedep.lisp @ echo '(|importModule| "ggreater")' >> makedep.lisp @ echo '(|importModule| "union")' >> makedep.lisp @@ -1972,12 +1974,25 @@ distclean-local: clean-local $(AUTO)/%.$(FASLEXT): %.$(FASLEXT) $(INSTALL) $< $@ + +incl.$(FASLEXT): incl.clisp cstream.$(FASLEXT) unlisp.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + +cformat.$(FASLEXT): cformat.clisp unlisp.$(FASLEXT) posit.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + unlisp.$(FASLEXT): unlisp.lisp sys-macros.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< +posit.$(FASLEXT): posit.clisp sys-macros.$(FASLEXT) astr.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + cstream.$(FASLEXT): cstream.clisp sys-macros.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< +astr.$(FASLEXT): astr.clisp boot-pkg.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + bits.$(FASLEXT): bits.lisp boot-pkg.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< diff --git a/src/interp/astr.boot b/src/interp/astr.boot new file mode 100644 index 00000000..b3143314 --- /dev/null +++ b/src/interp/astr.boot @@ -0,0 +1,80 @@ +-- 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 +-- 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. + +import '"boot-pkg" + +)package "BOOT" + +--% Attributed Structures (astr) +-- For objects which are pairs where the CAR field is either just a tag +-- (an identifier) or a pair which is the tag and an association list. + +-- Pick off the tag +ncTag x == + not PAIRP x => ncBug('S2CB0031,[]) + x := QCAR x + IDENTP x => x + not PAIRP x => ncBug('S2CB0031,[]) + QCAR x + +-- Pick off the property list +ncAlist x == + not PAIRP x => ncBug('S2CB0031,[]) + x := QCAR x + IDENTP x => NIL + not PAIRP x => ncBug('S2CB0031,[]) + QCDR x + + --- Get the entry for key k on x's association list +ncEltQ(x,k) == + r := QASSQ(k,ncAlist x) + NULL r => ncBug ('S2CB0007,[k]) + CDR r + +-- Put (k . v) on the association list of x and return v +-- case1: ncPutQ(x,k,v) where k is a key (an identifier), v a value +-- put the pair (k . v) on the association list of x and return v +-- case2: ncPutQ(x,k,v) where k is a list of keys, v a list of values +-- equivalent to [ncPutQ(x,key,val) for key in k for val in v] +ncPutQ(x,k,v) == + LISTP k => + for key in k for val in v repeat ncPutQ(x,key,val) + v + r := QASSQ(k,ncAlist x) + if NULL r then + r := CONS( CONS(k,v), ncAlist x) + RPLACA(x,CONS(ncTag x,r)) + else + RPLACD(r,v) + v + diff --git a/src/interp/astr.boot.pamphlet b/src/interp/astr.boot.pamphlet deleted file mode 100644 index b8f9eb0b..00000000 --- a/src/interp/astr.boot.pamphlet +++ /dev/null @@ -1,99 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp astr.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\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" - ---% Attributed Structures (astr) --- For objects which are pairs where the CAR field is either just a tag --- (an identifier) or a pair which is the tag and an association list. - --- Pick off the tag -ncTag x == - not PAIRP x => ncBug('S2CB0031,[]) - x := QCAR x - IDENTP x => x - not PAIRP x => ncBug('S2CB0031,[]) - QCAR x - --- Pick off the property list -ncAlist x == - not PAIRP x => ncBug('S2CB0031,[]) - x := QCAR x - IDENTP x => NIL - not PAIRP x => ncBug('S2CB0031,[]) - QCDR x - - --- Get the entry for key k on x's association list -ncEltQ(x,k) == - r := QASSQ(k,ncAlist x) - NULL r => ncBug ('S2CB0007,[k]) - CDR r - --- Put (k . v) on the association list of x and return v --- case1: ncPutQ(x,k,v) where k is a key (an identifier), v a value --- put the pair (k . v) on the association list of x and return v --- case2: ncPutQ(x,k,v) where k is a list of keys, v a list of values --- equivalent to [ncPutQ(x,key,val) for key in k for val in v] -ncPutQ(x,k,v) == - LISTP k => - for key in k for val in v repeat ncPutQ(x,key,val) - v - r := QASSQ(k,ncAlist x) - if NULL r then - r := CONS( CONS(k,v), ncAlist x) - RPLACA(x,CONS(ncTag x,r)) - else - RPLACD(r,v) - v - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/cformat.boot b/src/interp/cformat.boot new file mode 100644 index 00000000..953fc744 --- /dev/null +++ b/src/interp/cformat.boot @@ -0,0 +1,99 @@ +-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- All rights reserved. +-- Copryight (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 +-- 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. + +-- This is a horrible hack to work around a horrible bug in GCL +-- as reported here: +-- http://lists.gnu.org/archive/html/gcl-devel/2007-08/msg00004.html +-- +)if %hasFeature KEYWORD::GCL +)package "VMLISP" +)package "AxiomCore" +)endif + +import '"unlisp" +import '"posit" + +)package "BOOT" + +--% Formatting functions for various compiler data objects. +-- These are used as [%origin o, %id n] for %1f %2f... style arguments +-- in a keyed message. +-- SMW, SG June 88 + +%id a == [IDENTITY, a] + +-- Union(FileName,"strings","console") +%origin x == + [function porigin, x] +porigin x == + (STRINGP x => x; pfname x) + +%fname x == + [function pfname, x] +pfname x == + PathnameString x + + +%pos p == [function ppos, p] +ppos p == + pfNoPosition? p => ['"no position"] + pfImmediate? p => ['"console"] + cpos := pfCharPosn p + lpos := pfLinePosn p + org := porigin pfFileName p + [org,'" ",'"line",'" ",lpos] + +%key keyStuff == [function pkey, keyStuff] +--keyStuff ::= keynumber | [ one or more keySeqs ] +--keySeq ::= keynumber optargList optdbn +--optARgL ::= [ 0 or more arguments ] | nothing at all +--optDbn ::= ['dbN , databaseName ] | nothing at all +----------- (override in format.boot.pamphlet) +pkey keyStuff == + if not PAIRP keyStuff then keyStuff := [keyStuff] + allMsgs := [] + while not null keyStuff repeat + dbN := NIL + argL := NIL + key := first keyStuff + keyStuff := IFCDR keyStuff + next := IFCAR keyStuff + while PAIRP next repeat + if CAR next = 'dbN then dbN := CADR next + else argL := next + keyStuff := IFCDR keyStuff + next := IFCAR keyStuff + oneMsg := returnStLFromKey(key,argL,dbN) + allMsgs := NCONC (oneMsg,allMsgs) + allMsgs + diff --git a/src/interp/cformat.boot.pamphlet b/src/interp/cformat.boot.pamphlet deleted file mode 100644 index a5fb233d..00000000 --- a/src/interp/cformat.boot.pamphlet +++ /dev/null @@ -1,108 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp cformat.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\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" - ---% Formatting functions for various compiler data objects. --- These are used as [%origin o, %id n] for %1f %2f... style arguments --- in a keyed message. --- SMW, SG June 88 - -%id a == [IDENTITY, a] - --- Union(FileName,"strings","console") -%origin x == - [function porigin, x] -porigin x == - (STRINGP x => x; pfname x) - -%fname x == - [function pfname, x] -pfname x == - PathnameString x - - -%pos p == [function ppos, p] -ppos p == - pfNoPosition? p => ['"no position"] - pfImmediate? p => ['"console"] - cpos := pfCharPosn p - lpos := pfLinePosn p - org := porigin pfFileName p - [org,'" ",'"line",'" ",lpos] - -%key keyStuff == [function pkey, keyStuff] ---keyStuff ::= keynumber | [ one or more keySeqs ] ---keySeq ::= keynumber optargList optdbn ---optARgL ::= [ 0 or more arguments ] | nothing at all ---optDbn ::= ['dbN , databaseName ] | nothing at all ------------ (override in format.boot.pamphlet) -pkey keyStuff == - if not PAIRP keyStuff then keyStuff := [keyStuff] - allMsgs := [] - while not null keyStuff repeat - dbN := NIL - argL := NIL - key := first keyStuff - keyStuff := IFCDR keyStuff - next := IFCAR keyStuff - while PAIRP next repeat - if CAR next = 'dbN then dbN := CADR next - else argL := next - keyStuff := IFCDR keyStuff - next := IFCAR keyStuff - oneMsg := returnStLFromKey(key,argL,dbN) - allMsgs := NCONC (oneMsg,allMsgs) - allMsgs - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/incl.boot b/src/interp/incl.boot new file mode 100644 index 00000000..c4e928aa --- /dev/null +++ b/src/interp/incl.boot @@ -0,0 +1,435 @@ +-- 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 +-- 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. + +-- This is a horrible hack to work around a horrible bug in GCL +-- as reported here: +-- http://lists.gnu.org/archive/html/gcl-devel/2007-08/msg00004.html +-- +)if %hasFeature KEYWORD::GCL +)package "VMLISP" +)package "AxiomCore" +)endif + +import '"unlisp" +import '"cstream" +import '"cformat" + +)package "BOOT" + +Top := 01 +IfSkipToEnd := 10 +IfKeepPart := 11 +IfSkipPart := 12 +ElseifSkipToEnd:= 20 +ElseifKeepPart := 21 +ElseifSkipPart := 22 +ElseSkipToEnd := 30 +ElseKeepPart := 31 + +Top? (st) == QUOTIENT(st,10) = 0 +If? (st) == QUOTIENT(st,10) = 1 +Elseif? (st) == QUOTIENT(st,10) = 2 +Else? (st) == QUOTIENT(st,10) = 3 +SkipEnd? (st) == REMAINDER(st,10) = 0 +KeepPart?(st) == REMAINDER(st,10) = 1 +SkipPart?(st) == REMAINDER(st,10) = 2 +Skipping?(st) == not KeepPart? st + +incStringStream s== + incRenumber incLude(0,incRgen s,0,['"strings"] ,[Top]) + +incFile fn== + incRenumber incLude(0,incRgen OPEN fn,0,[fn],[Top]) + +incStream(st, fn) == + incRenumber incLude(0,incRgen st,0,[fn],[Top]) + +incFileInput fn == incRgen MAKE_-INSTREAM fn +incConsoleInput () == incRgen MAKE_-INSTREAM 0 + +incLine(eb, str, gno, lno, ufo) == + ln := lnCreate(eb,str,gno,lno,ufo) + CONS(CONS(ln,1), str) + +incPos f == CAR f + +incRenumberItem(f, i) == + l := CAAR f + lnSetGlobalNum(l, i) + f + +incRenumberLine(xl, gno) == + l := incRenumberItem(xl.0, gno) + incHandleMessage xl + l + +incRenumber ssx == incZip (function incRenumberLine, ssx, incIgen 0) + +incPrefix?(prefix, start, whole) == + #prefix > #whole-start => false + good:=true + for i in 0..#prefix-1 for j in start.. while good repeat + good:= prefix.i = whole.j + good + +incCommand?(s) == #s > 0 and s.0 = char ")" + +incCommands := + ['"say" , _ + '"include", _ + '"console", _ + '"fin" , _ + '"assert" , _ + '"if" , _ + '"elseif" , _ + '"else" , _ + '"endif" ] + +incClassify(s) == + not incCommand? s => [false,0, '""] + i := 1; n := #s + while i < n and s.i = char " " repeat i := i + 1 + i >= n => [true,0,'"other"] + eb := (i = 1 => 0; i) + bad:=true + for p in incCommands while bad repeat + incPrefix?(p, i, s) => + bad:=false + p1 :=p + if bad then [true,0,'"other"] else [true,eb,p1] + +incCommandTail(s, info) == + start := (info.1 = 0 => 1; info.1) + incDrop(start+#info.2+1, s) + +incDrop(n, b) == + n >= #b => "" + SUBSTRING(b,n,nil) + + +inclFname(s, info) == incFileName incCommandTail(s, info) + +incBiteOff x == + n:=STRPOSL('" ",x,0,true)-- first nonspace + if null n + then false -- all spaces + else + n1:=STRPOSL ('" ",x,n,nil) + if null n1 -- all nonspaces + then [SUBSTRING(x,n,nil),'""] + else [SUBSTRING(x,n,n1-n),SUBSTRING(x,n1,nil)] + +incTrunc (n,x)== + if #x>n + then SUBSTRING(x,0,n) + else x + +incFileName x == first incBiteOff x + +fileNameStrings fn==[PNAME(fn.0),PNAME(fn.1),PNAME(fn.2)] + +ifCond(s, info) == + word := MakeSymbol StringTrim(incCommandTail(s, info), WhiteSpaceCset) + ListMemberQ?(word, $inclAssertions) + +assertCond(s, info) == + word := MakeSymbol StringTrim(incCommandTail(s, info), WhiteSpaceCset) + if not ListMemberQ?(word, $inclAssertions) then + $inclAssertions := [word, :$inclAssertions] + + +incActive?(fn,ufos)==member(fn,ufos) + +incNConsoles ufos== + a:=member('"console",ufos) + if a then 1+incNConsoles CDR a else 0 + + --% Message Handling +incHandleMessage(xl) == + xl.1.1 = "none" => + 0 + xl.1.1 = "error" => + inclHandleError(incPos xl.0, xl.1.0) + xl.1.1 = "warning" => + inclHandleWarning(incPos xl.0, xl.1.0) + xl.1.1 = "say" => + inclHandleSay(incPos xl.0, xl.1.0) + inclHandleBug(incPos xl.0, xl.1.0) + +xlOK(eb, str, lno, ufo) == + [incLine(eb, str, -1, lno, ufo), [NIL, "none"]] + +xlOK1(eb, str,str1, lno, ufo) == + [incLine1(eb, str,str1, -1, lno, ufo), [NIL, "none"]] + +incLine1(eb, str,str1, gno, lno, ufo) == + ln := lnCreate(eb,str,gno,lno,ufo) + CONS(CONS(ln,1), str1) +xlSkip(eb, str, lno, ufo) == + str := CONCAT('"-- Omitting:", str) + [incLine(eb, str, -1, lno, ufo), [NIL, "none"]] + +xlMsg(eb, str, lno, ufo, mess) == + [incLine(eb, str, -1, lno, ufo), mess] + +xlPrematureEOF(eb, str, lno, ufos) == + xlMsg(eb, str, lno,ufos.0, + [inclmsgPrematureEOF(ufos.0),"error"]) + +xlPrematureFin(eb, str, lno, ufos) == + xlMsg(eb, str, lno,ufos.0, + [inclmsgPrematureFin(ufos.0),"error"]) + +xlFileCycle(eb, str, lno, ufos, fn) == + xlMsg(eb, str, lno,ufos.0, + [inclmsgFileCycle(ufos,fn),"error"]) + +xlNoSuchFile(eb, str, lno, ufos, fn) == + xlMsg(eb, str, lno,ufos.0, + [inclmsgNoSuchFile(fn), "error"]) + +xlCannotRead(eb, str, lno, ufos, fn) == + xlMsg(eb, str, lno,ufos.0, + [inclmsgCannotRead(fn), "error"]) + +xlConsole(eb, str, lno, ufos) == + xlMsg(eb, str, lno,ufos.0, + [inclmsgConsole(),"say"]) + +xlConActive(eb, str, lno, ufos, n) == + xlMsg(eb, str, lno,ufos.0, + [inclmsgConActive(n),"warning"]) + +xlConStill(eb, str, lno, ufos, n) == + xlMsg(eb, str, lno,ufos.0, + [inclmsgConStill(n), "say"]) + +xlSkippingFin(eb, str, lno, ufos) == + xlMsg(eb, str, lno,ufos.0, + [inclmsgFinSkipped(),"warning"]) + +xlIfBug(eb, str, lno, ufos) == + xlMsg(eb, str, lno,ufos.0, + [inclmsgIfBug(), "bug"]) + +xlCmdBug(eb, str, lno, ufos) == + xlMsg(eb, str, lno,ufos.0, + [inclmsgCmdBug(), "bug"]) + +xlSay(eb, str, lno, ufos, x) == + xlMsg(eb, str, lno,ufos.0, + [inclmsgSay(x), "say"]) + +xlIfSyntax(eb, str, lno,ufos,info,sts) == + st := sts.0 + found := info.2 + context := + Top? st => "not in an )if...)endif" + Else? st => "after an )else" + "but can't figure out where" + xlMsg(eb, str, lno, ufos.0, + [inclmsgIfSyntax(ufos.0,found,context), "error"]) + + --% This is it + +incLude(eb, ss, ln, ufos, states) == + Delay(function incLude1,[eb, ss, ln, ufos, states]) + +Rest s==>incLude (eb,CDR ss,lno,ufos,states) + +incLude1 (:z) == + [eb, ss, ln, ufos, states]:=z + lno := ln+1 + state := states.0 + + StreamNull ss => + not Top? state => + cons(xlPrematureEOF(eb, + '")--premature end", lno,ufos), StreamNil) + StreamNil + + str := EXPAND_-TABS CAR ss + info := incClassify str + + not info.0 => + Skipping? state => cons(xlSkip(eb,str,lno,ufos.0), Rest s) + cons(xlOK(eb, str, lno, ufos.0),Rest s) + + info.2 = '"other" => + Skipping? state => cons(xlSkip(eb,str,lno,ufos.0), Rest s) + cons(xlOK1(eb, str,CONCAT('")command",str), lno, ufos.0), + Rest s) + + info.2 = '"say" => + Skipping? state => cons(xlSkip(eb,str,lno,ufos.0), Rest s) + str := incCommandTail(str, info) + cons(xlSay(eb, str, lno, ufos, str), + cons(xlOK(eb,str,lno,ufos.0), Rest s)) + + info.2 = '"include" => + Skipping? state => + cons(xlSkip(eb,str,lno,ufos.0), Rest s) + fn1 := inclFname(str, info) + not fn1 => + cons(xlNoSuchFile(eb, str, lno,ufos,fn1),Rest s) + not PROBE_-FILE fn1 => + cons(xlCannotRead(eb, str, lno,ufos,fn1),Rest s) + incActive?(fn1,ufos) => + cons(xlFileCycle (eb, str, lno,ufos,fn1),Rest s) + Includee := + incLude(eb+info.1,incFileInput fn1,0, + cons(fn1,ufos), cons(Top,states)) + cons( + xlOK(eb,str,lno,ufos.0), + incAppend(Includee, Rest s)) + + info.2 = '"console" => + Skipping? state => cons(xlSkip(eb,str,lno,ufos.0), Rest s) + Head := + incLude(eb+info.1,incConsoleInput(),0, + cons('"console",ufos),cons(Top,states) ) + Tail := Rest s + + n := incNConsoles ufos + if n > 0 then + Head := cons(xlConActive(eb, str, lno,ufos,n),Head) + Tail := + cons(xlConStill (eb, str, lno,ufos,n),Tail) + + Head := cons (xlConsole(eb, str, lno,ufos), Head) + cons(xlOK(eb,str,lno,ufos.0),incAppend(Head,Tail)) + + info.2 = '"fin" => + Skipping? state => + cons(xlSkippingFin(eb, str, lno,ufos), Rest s) + not Top? state => + cons(xlPrematureFin(eb, str, lno,ufos), StreamNil) + cons(xlOK(eb,str,lno,ufos.0), StreamNil) + + info.2 = '"assert" => + Skipping? state => + cons(xlSkippingFin(eb, str, lno,ufos), Rest s) + assertCond(str, info) + cons(xlOK(eb,str,lno,ufos.0), incAppend(Includee, Rest s)) + + info.2 = '"if" => + s1 := + Skipping? state => IfSkipToEnd + if ifCond(str,info) then IfKeepPart else IfSkipPart + cons(xlOK(eb,str,lno,ufos.0), + incLude(eb,CDR ss,lno,ufos,cons(s1,states))) + info.2 = '"elseif" => + not If? state and not Elseif? state => + cons(xlIfSyntax(eb, str,lno,ufos,info,states), + StreamNil) + + if SkipEnd? state or KeepPart? state or SkipPart? state + then + s1:=if SkipPart? state + then + pred := ifCond(str,info) + if pred + then ElseifKeepPart + else ElseifSkipPart + else ElseifSkipToEnd + cons(xlOK(eb,str,lno,ufos.0), + incLude(eb,CDR ss,lno,ufos,cons(s1,rest states))) + else + cons(xlIfBug(eb, str, lno,ufos), StreamNil) + + info.2 = '"else" => + not If? state and not Elseif? state => + cons(xlIfSyntax(eb, str,lno,ufos,info,states), + StreamNil) + if SkipEnd? state or KeepPart? state or SkipPart? state + then + s1 :=if SkipPart? state + then ElseKeepPart + else ElseSkipToEnd + cons(xlOK(eb,str,lno,ufos.0), + incLude(eb,CDR ss,lno,ufos,cons(s1,rest states))) + else + cons(xlIfBug(eb, str, lno,ufos), StreamNil) + + info.2 = '"endif" => + Top? state => + cons(xlIfSyntax(eb, str,lno,ufos,info,states), + StreamNil) + cons(xlOK(eb,str,lno,ufos.0), + incLude(eb,CDR ss,lno,ufos,rest states)) + + cons(xlCmdBug(eb, str, lno,ufos), StreamNil) + +--% Message handling for the source includer +-- SMW June 88 + +inclHandleError(pos, [key, args]) == + ncSoftError(pos, key, args) +inclHandleWarning(pos, [key, args]) == + ncSoftError(pos, key,args) +inclHandleBug(pos, [key, args]) == + ncBug(key, args) +inclHandleSay(pos, [key, args]) == + ncSoftError(pos, key, args) + +inclmsgSay str == + ['S2CI0001, [%id str]] +inclmsgPrematureEOF ufo == + ['S2CI0002, [%origin ufo]] +inclmsgPrematureFin ufo == + ['S2CI0003, [%origin ufo]] +inclmsgFileCycle(ufos,fn) == + flist := [porigin n for n in reverse ufos] + f1 := porigin fn + cycle := [:[:[n,'"==>"] for n in flist], f1] + ['S2CI0004, [%id cycle, %id f1]] +inclmsgConsole () == + ['S2CI0005, []] +inclmsgConActive n == + ['S2CI0006, [%id n]] +inclmsgConStill n == + ['S2CI0007, [%id n]] +inclmsgFinSkipped() == + ['S2CI0008, []] +inclmsgIfSyntax(ufo,found,context) == + found := CONCAT('")", found) + ['S2CI0009, [%id found, %id context, %origin ufo]] +inclmsgNoSuchFile fn == + ['S2CI0010, [%fname fn]] +inclmsgCannotRead fn == + ['S2CI0011, [%fname fn]] +inclmsgIfBug() == + ['S2CB0002, []] +inclmsgCmdBug() == + ['S2CB0003, []] + diff --git a/src/interp/incl.boot.pamphlet b/src/interp/incl.boot.pamphlet deleted file mode 100644 index 5f729bb7..00000000 --- a/src/interp/incl.boot.pamphlet +++ /dev/null @@ -1,447 +0,0 @@ -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp/incl.boot} Pamphlet} -\author{The Axiom Team} - -\begin{document} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject - -\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" - -incStringStream s== - incRenumber incLude(0,incRgen s,0,['"strings"] ,[Top]) - -incFile fn== - incRenumber incLude(0,incRgen OPEN fn,0,[fn],[Top]) - -incStream(st, fn) == - incRenumber incLude(0,incRgen st,0,[fn],[Top]) - -incFileInput fn == incRgen MAKE_-INSTREAM fn -incConsoleInput () == incRgen MAKE_-INSTREAM 0 - -incLine(eb, str, gno, lno, ufo) == - ln := lnCreate(eb,str,gno,lno,ufo) - CONS(CONS(ln,1), str) - -incPos f == CAR f - -incRenumberItem(f, i) == - l := CAAR f - lnSetGlobalNum(l, i) - f - -incRenumberLine(xl, gno) == - l := incRenumberItem(xl.0, gno) - incHandleMessage xl - l - -incRenumber ssx == incZip (function incRenumberLine, ssx, incIgen 0) - -incPrefix?(prefix, start, whole) == - #prefix > #whole-start => false - good:=true - for i in 0..#prefix-1 for j in start.. while good repeat - good:= prefix.i = whole.j - good - -incCommand?(s) == #s > 0 and s.0 = char ")" - -incCommands := - ['"say" , _ - '"include", _ - '"console", _ - '"fin" , _ - '"assert" , _ - '"if" , _ - '"elseif" , _ - '"else" , _ - '"endif" ] - -incClassify(s) == - not incCommand? s => [false,0, '""] - i := 1; n := #s - while i < n and s.i = char " " repeat i := i + 1 - i >= n => [true,0,'"other"] - eb := (i = 1 => 0; i) - bad:=true - for p in incCommands while bad repeat - incPrefix?(p, i, s) => - bad:=false - p1 :=p - if bad then [true,0,'"other"] else [true,eb,p1] - -incCommandTail(s, info) == - start := (info.1 = 0 => 1; info.1) - incDrop(start+#info.2+1, s) - -incDrop(n, b) == - n >= #b => "" - SUBSTRING(b,n,nil) - - -inclFname(s, info) == incFileName incCommandTail(s, info) - -incBiteOff x == - n:=STRPOSL('" ",x,0,true)-- first nonspace - if null n - then false -- all spaces - else - n1:=STRPOSL ('" ",x,n,nil) - if null n1 -- all nonspaces - then [SUBSTRING(x,n,nil),'""] - else [SUBSTRING(x,n,n1-n),SUBSTRING(x,n1,nil)] - -incTrunc (n,x)== - if #x>n - then SUBSTRING(x,0,n) - else x - -incFileName x == first incBiteOff x - -fileNameStrings fn==[PNAME(fn.0),PNAME(fn.1),PNAME(fn.2)] - -ifCond(s, info) == - word := MakeSymbol StringTrim(incCommandTail(s, info), WhiteSpaceCset) - ListMemberQ?(word, $inclAssertions) - -assertCond(s, info) == - word := MakeSymbol StringTrim(incCommandTail(s, info), WhiteSpaceCset) - if not ListMemberQ?(word, $inclAssertions) then - $inclAssertions := [word, :$inclAssertions] - - -incActive?(fn,ufos)==member(fn,ufos) - -incNConsoles ufos== - a:=member('"console",ufos) - if a then 1+incNConsoles CDR a else 0 - -Top := 01 -IfSkipToEnd := 10 -IfKeepPart := 11 -IfSkipPart := 12 -ElseifSkipToEnd:= 20 -ElseifKeepPart := 21 -ElseifSkipPart := 22 -ElseSkipToEnd := 30 -ElseKeepPart := 31 - -Top? (st) == QUOTIENT(st,10) = 0 -If? (st) == QUOTIENT(st,10) = 1 -Elseif? (st) == QUOTIENT(st,10) = 2 -Else? (st) == QUOTIENT(st,10) = 3 -SkipEnd? (st) == REMAINDER(st,10) = 0 -KeepPart?(st) == REMAINDER(st,10) = 1 -SkipPart?(st) == REMAINDER(st,10) = 2 -Skipping?(st) == not KeepPart? st - - --% Message Handling -incHandleMessage(xl) == - xl.1.1 = "none" => - 0 - xl.1.1 = "error" => - inclHandleError(incPos xl.0, xl.1.0) - xl.1.1 = "warning" => - inclHandleWarning(incPos xl.0, xl.1.0) - xl.1.1 = "say" => - inclHandleSay(incPos xl.0, xl.1.0) - inclHandleBug(incPos xl.0, xl.1.0) - -xlOK(eb, str, lno, ufo) == - [incLine(eb, str, -1, lno, ufo), [NIL, "none"]] - -xlOK1(eb, str,str1, lno, ufo) == - [incLine1(eb, str,str1, -1, lno, ufo), [NIL, "none"]] - -incLine1(eb, str,str1, gno, lno, ufo) == - ln := lnCreate(eb,str,gno,lno,ufo) - CONS(CONS(ln,1), str1) -xlSkip(eb, str, lno, ufo) == - str := CONCAT('"-- Omitting:", str) - [incLine(eb, str, -1, lno, ufo), [NIL, "none"]] - -xlMsg(eb, str, lno, ufo, mess) == - [incLine(eb, str, -1, lno, ufo), mess] - -xlPrematureEOF(eb, str, lno, ufos) == - xlMsg(eb, str, lno,ufos.0, - [inclmsgPrematureEOF(ufos.0),"error"]) - -xlPrematureFin(eb, str, lno, ufos) == - xlMsg(eb, str, lno,ufos.0, - [inclmsgPrematureFin(ufos.0),"error"]) - -xlFileCycle(eb, str, lno, ufos, fn) == - xlMsg(eb, str, lno,ufos.0, - [inclmsgFileCycle(ufos,fn),"error"]) - -xlNoSuchFile(eb, str, lno, ufos, fn) == - xlMsg(eb, str, lno,ufos.0, - [inclmsgNoSuchFile(fn), "error"]) - -xlCannotRead(eb, str, lno, ufos, fn) == - xlMsg(eb, str, lno,ufos.0, - [inclmsgCannotRead(fn), "error"]) - -xlConsole(eb, str, lno, ufos) == - xlMsg(eb, str, lno,ufos.0, - [inclmsgConsole(),"say"]) - -xlConActive(eb, str, lno, ufos, n) == - xlMsg(eb, str, lno,ufos.0, - [inclmsgConActive(n),"warning"]) - -xlConStill(eb, str, lno, ufos, n) == - xlMsg(eb, str, lno,ufos.0, - [inclmsgConStill(n), "say"]) - -xlSkippingFin(eb, str, lno, ufos) == - xlMsg(eb, str, lno,ufos.0, - [inclmsgFinSkipped(),"warning"]) - -xlIfBug(eb, str, lno, ufos) == - xlMsg(eb, str, lno,ufos.0, - [inclmsgIfBug(), "bug"]) - -xlCmdBug(eb, str, lno, ufos) == - xlMsg(eb, str, lno,ufos.0, - [inclmsgCmdBug(), "bug"]) - -xlSay(eb, str, lno, ufos, x) == - xlMsg(eb, str, lno,ufos.0, - [inclmsgSay(x), "say"]) - -xlIfSyntax(eb, str, lno,ufos,info,sts) == - st := sts.0 - found := info.2 - context := - Top? st => "not in an )if...)endif" - Else? st => "after an )else" - "but can't figure out where" - xlMsg(eb, str, lno, ufos.0, - [inclmsgIfSyntax(ufos.0,found,context), "error"]) - - --% This is it - -incLude(eb, ss, ln, ufos, states) == - Delay(function incLude1,[eb, ss, ln, ufos, states]) - -Rest s==>incLude (eb,CDR ss,lno,ufos,states) - -incLude1 (:z) == - [eb, ss, ln, ufos, states]:=z - lno := ln+1 - state := states.0 - - StreamNull ss => - not Top? state => - cons(xlPrematureEOF(eb, - '")--premature end", lno,ufos), StreamNil) - StreamNil - - str := EXPAND_-TABS CAR ss - info := incClassify str - - not info.0 => - Skipping? state => cons(xlSkip(eb,str,lno,ufos.0), Rest s) - cons(xlOK(eb, str, lno, ufos.0),Rest s) - - info.2 = '"other" => - Skipping? state => cons(xlSkip(eb,str,lno,ufos.0), Rest s) - cons(xlOK1(eb, str,CONCAT('")command",str), lno, ufos.0), - Rest s) - - info.2 = '"say" => - Skipping? state => cons(xlSkip(eb,str,lno,ufos.0), Rest s) - str := incCommandTail(str, info) - cons(xlSay(eb, str, lno, ufos, str), - cons(xlOK(eb,str,lno,ufos.0), Rest s)) - - info.2 = '"include" => - Skipping? state => - cons(xlSkip(eb,str,lno,ufos.0), Rest s) - fn1 := inclFname(str, info) - not fn1 => - cons(xlNoSuchFile(eb, str, lno,ufos,fn),Rest s) - not PROBE_-FILE fn1 => - cons(xlCannotRead(eb, str, lno,ufos,fn1),Rest s) - incActive?(fn1,ufos) => - cons(xlFileCycle (eb, str, lno,ufos,fn1),Rest s) - Includee := - incLude(eb+info.1,incFileInput fn1,0, - cons(fn1,ufos), cons(Top,states)) - cons( - xlOK(eb,str,lno,ufos.0), - incAppend(Includee, Rest s)) - - info.2 = '"console" => - Skipping? state => cons(xlSkip(eb,str,lno,ufos.0), Rest s) - Head := - incLude(eb+info.1,incConsoleInput(),0, - cons('"console",ufos),cons(Top,states) ) - Tail := Rest s - - n := incNConsoles ufos - if n > 0 then - Head := cons(xlConActive(eb, str, lno,ufos,n),Head) - Tail := - cons(xlConStill (eb, str, lno,ufos,n),Tail) - - Head := cons (xlConsole(eb, str, lno,ufos), Head) - cons(xlOK(eb,str,lno,ufos.0),incAppend(Head,Tail)) - - info.2 = '"fin" => - Skipping? state => - cons(xlSkippingFin(eb, str, lno,ufos), Rest s) - not Top? state => - cons(xlPrematureFin(eb, str, lno,ufos), StreamNil) - cons(xlOK(eb,str,lno,ufos.0), StreamNil) - - info.2 = '"assert" => - Skipping? state => - cons(xlSkippingFin(eb, str, lno,ufos), Rest s) - assertCond(str, info) - cons(xlOK(eb,str,lno,ufos.0), incAppend(Includee, Rest s)) - - info.2 = '"if" => - s1 := - Skipping? state => IfSkipToEnd - if ifCond(str,info) then IfKeepPart else IfSkipPart - cons(xlOK(eb,str,lno,ufos.0), - incLude(eb,CDR ss,lno,ufos,cons(s1,states))) - info.2 = '"elseif" => - not If? state and not Elseif? state => - cons(xlIfSyntax(eb, str,lno,ufos,info,states), - StreamNil) - - if SkipEnd? state or KeepPart? state or SkipPart? state - then - s1:=if SkipPart? state - then - pred := ifCond(str,info) - if pred - then ElseifKeepPart - else ElseifSkipPart - else ElseifSkipToEnd - cons(xlOK(eb,str,lno,ufos.0), - incLude(eb,CDR ss,lno,ufos,cons(s1,rest states))) - else - cons(xlIfBug(eb, str, lno,ufos), StreamNil) - - info.2 = '"else" => - not If? state and not Elseif? state => - cons(xlIfSyntax(eb, str,lno,ufos,info,states), - StreamNil) - if SkipEnd? state or KeepPart? state or SkipPart? state - then - s1 :=if SkipPart? state - then ElseKeepPart - else ElseSkipToEnd - cons(xlOK(eb,str,lno,ufos.0), - incLude(eb,CDR ss,lno,ufos,cons(s1,rest states))) - else - cons(xlIfBug(eb, str, lno,ufos), StreamNil) - - info.2 = '"endif" => - Top? state => - cons(xlIfSyntax(eb, str,lno,ufos,info,states), - StreamNil) - cons(xlOK(eb,str,lno,ufos.0), - incLude(eb,CDR ss,lno,ufos,rest states)) - - cons(xlCmdBug(eb, str, lno,ufos), StreamNil) - ---% Message handling for the source includer --- SMW June 88 - -inclHandleError(pos, [key, args]) == - ncSoftError(pos, key, args) -inclHandleWarning(pos, [key, args]) == - ncSoftError(pos, key,args) -inclHandleBug(pos, [key, args]) == - ncBug(key, args) -inclHandleSay(pos, [key, args]) == - ncSoftError(pos, key, args) - -inclmsgSay str == - ['S2CI0001, [%id str]] -inclmsgPrematureEOF ufo == - ['S2CI0002, [%origin ufo]] -inclmsgPrematureFin ufo == - ['S2CI0003, [%origin ufo]] -inclmsgFileCycle(ufos,fn) == - flist := [porigin n for n in reverse ufos] - f1 := porigin fn - cycle := [:[:[n,'"==>"] for n in flist], f1] - ['S2CI0004, [%id cycle, %id f1]] -inclmsgConsole () == - ['S2CI0005, []] -inclmsgConActive n == - ['S2CI0006, [%id n]] -inclmsgConStill n == - ['S2CI0007, [%id n]] -inclmsgFinSkipped() == - ['S2CI0008, []] -inclmsgIfSyntax(ufo,found,context) == - found := CONCAT('")", found) - ['S2CI0009, [%id found, %id context, %origin ufo]] -inclmsgNoSuchFile fn == - ['S2CI0010, [%fname fn]] -inclmsgCannotRead fn == - ['S2CI0011, [%fname fn]] -inclmsgIfBug() == - ['S2CB0002, []] -inclmsgCmdBug() == - ['S2CB0003, []] - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/patches.lisp.pamphlet b/src/interp/patches.lisp.pamphlet index 82961a1e..a825922c 100644 --- a/src/interp/patches.lisp.pamphlet +++ b/src/interp/patches.lisp.pamphlet @@ -300,8 +300,6 @@ previous definition. #+:AKCL (proclaim '(ftype (function (t) t) identity)) #+:AKCL (defun identity (x) x) -(setq identity #'identity) ;to make LispVM code for handling constants to work - (|initializeTimedNames| |$interpreterTimedNames| |$interpreterTimedClasses|) (defun |rebuild| (filemode) diff --git a/src/interp/posit.boot b/src/interp/posit.boot new file mode 100644 index 00000000..b9c546e4 --- /dev/null +++ b/src/interp/posit.boot @@ -0,0 +1,220 @@ +-- 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 +-- 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. + +import '"sys-macros" +import '"astr" + +)package "BOOT" + +poNoPosition() == $nopos +pfNoPosition() == poNoPosition() + +poNoPosition? pos == EQCAR(pos,'noposition) +pfNoPosition? pos == poNoPosition? pos + +pfSourceText pf == + lnString poGetLineObject pfPosn pf + +pfPosOrNopos pf == + poIsPos? (pos := pfSourcePosition pf) => pos + poNoPosition() + +poIsPos? pos == + PAIRP pos and PAIRP CAR pos and LENGTH CAR pos = 5 + +lnCreate(extBl, st, gNo, :optFileStuff) == + lNo := + num := IFCAR optFileStuff => num + 0 + fN := IFCAR IFCDR optFileStuff + [extBl, st, gNo, lNo, fN] + +lnString lineObject == + lineObject.1 + +lnExtraBlanks lineObject == + lineObject.0 + +lnGlobalNum lineObject == + lineObject.2 + +lnSetGlobalNum(lineObject, num) == + lineObject.2 := num + +lnLocalNum lineObject == + lineObject.3 + +lnFileName lineObject == + (fN := lnFileName? lineObject) => fN + ncBug('"there is no file name in %1", [lineObject] ) + +lnFileName? lineObject == + NOT PAIRP (fN := lineObject.4) => NIL + fN + +lnPlaceOfOrigin lineObject == + lineObject.4 + +lnImmediate? lineObject == + not lnFileName? lineObject + +poGetLineObject posn == + CAR posn +pfGetLineObject posn == poGetLineObject posn + +pfSourceToken form == + if pfLeaf? form + then pfLeafToken form + else if null pfParts form + then 'NoToken + else pfSourceToken(pfFirst form) + +--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 ==> + +pfPosn pf == pfSourcePosition pf + +pfSourcePosition form == + --null form => pfNoPosition() + pfLeaf? form => pfLeafPosition form + parts := pfParts form + pos := $nopos + for p in parts while poNoPosition? pos repeat + pos := pfSourcePosition p + pos + +pfSourcePositions form == + if pfLeaf? form + then + a:=tokPosn form + if null a + then nil + else [a] + else pfSourcePositionlist pfParts form + +pfSourcePositionlist x== + if null x + then nil + else APPEND(pfSourcePositions first x,pfSourcePositionlist rest x) + + +poCharPosn posn == CDR posn +pfCharPosn posn == poCharPosn posn + +poLinePosn posn == + posn => lnLocalNum poGetLineObject posn --VECP posn => + CDAR posn +pfLinePosn posn == poLinePosn posn + +poGlobalLinePosn posn == + posn => lnGlobalNum poGetLineObject posn + ncBug('"old style pos objects have no global positions",[]) +pfGlobalLinePosn posn == poGlobalLinePosn posn + +poFileName posn == + posn => lnFileName poGetLineObject posn + CAAR posn +pfFileName posn == poFileName posn + +poFileName? posn == + posn = ['noposition] => NIL + posn => lnFileName? poGetLineObject posn + CAAR posn +pfFileName? posn == poFileName? posn + +poPlaceOfOrigin posn == + lnPlaceOfOrigin poGetLineObject posn +pfPlaceOfOrigin posn == poPlaceOfOrigin posn + +poNopos? posn == + posn = ['noposition] +pfNopos? posn == poNopos? posn +poPosImmediate? txp== + poNopos? txp => NIL + lnImmediate? poGetLineObject txp +pfPosImmediate? txp == poPosImmediate? txp + +poImmediate? txp== + lnImmediate? poGetLineObject txp +pfImmediate? txp == poImmediate? txp + + +compareposns(a,b)== + c:=poGlobalLinePosn a + d:=poGlobalLinePosn b + if c=d then poCharPosn a>=poCharPosn b else c>=d + +pfPrintSrcLines(pf) == + lines := pfSourcePositions pf + lno := 0 + for l in lines repeat + line := car l + if lno < lnGlobalNum(line) then + FORMAT(true, '" ~A~%", lnString line) + lno := lnGlobalNum(line) + diff --git a/src/interp/posit.boot.pamphlet b/src/interp/posit.boot.pamphlet deleted file mode 100644 index 72adfa0c..00000000 --- a/src/interp/posit.boot.pamphlet +++ /dev/null @@ -1,200 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp posit.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\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" - -poNoPosition() == $nopos -pfNoPosition() == poNoPosition() - -poNoPosition? pos == EQCAR(pos,'noposition) -pfNoPosition? pos == poNoPosition? pos - -pfSourceText pf == - lnString poGetLineObject pfPosn pf - -pfPosOrNopos pf == - poIsPos? (pos := pfSourcePosition pf) => pos - poNoPosition() - -poIsPos? pos == - PAIRP pos and PAIRP CAR pos and LENGTH CAR pos = 5 - -lnCreate(extBl, st, gNo, :optFileStuff) == - lNo := - num := IFCAR optFileStuff => num - 0 - fN := IFCAR IFCDR optFileStuff - [extBl, st, gNo, lNo, fN] - -lnString lineObject == - lineObject.1 - -lnExtraBlanks lineObject == - lineObject.0 - -lnGlobalNum lineObject == - lineObject.2 - -lnSetGlobalNum(lineObject, num) == - lineObject.2 := num - -lnLocalNum lineObject == - lineObject.3 - -lnFileName lineObject == - (fN := lnFileName? lineObject) => fN - ncBug('"there is no file name in %1", [lineObject] ) - -lnFileName? lineObject == - NOT PAIRP (fN := lineObject.4) => NIL - fN - -lnPlaceOfOrigin lineObject == - lineObject.4 - -lnImmediate? lineObject == - not lnFileName? lineObject - -poGetLineObject posn == - CAR posn -pfGetLineObject posn == poGetLineObject posn - -pfSourceToken form == - if pfLeaf? form - then pfLeafToken form - else if null pfParts form - then 'NoToken - else pfSourceToken(pfFirst form) - -pfPosn pf == pfSourcePosition pf - -pfSourcePosition form == - --null form => pfNoPosition() - pfLeaf? form => pfLeafPosition form - parts := pfParts form - pos := $nopos - for p in parts while poNoPosition? pos repeat - pos := pfSourcePosition p - pos - -pfSourcePositions form == - if pfLeaf? form - then - a:=tokPosn form - if null a - then nil - else [a] - else pfSourcePositionlist pfParts form - -pfSourcePositionlist x== - if null x - then nil - else APPEND(pfSourcePositions first x,pfSourcePositionlist rest x) - - -poCharPosn posn == CDR posn -pfCharPosn posn == poCharPosn posn - -poLinePosn posn == - posn => lnLocalNum poGetLineObject posn --VECP posn => - CDAR posn -pfLinePosn posn == poLinePosn posn - -poGlobalLinePosn posn == - posn => lnGlobalNum poGetLineObject posn - ncBug('"old style pos objects have no global positions",[]) -pfGlobalLinePosn posn == poGlobalLinePosn posn - -poFileName posn == - posn => lnFileName poGetLineObject posn - CAAR posn -pfFileName posn == poFileName posn - -poFileName? posn == - posn = ['noposition] => NIL - posn => lnFileName? poGetLineObject posn - CAAR posn -pfFileName? posn == poFileName? posn - -poPlaceOfOrigin posn == - lnPlaceOfOrigin poGetLineObject posn -pfPlaceOfOrigin posn == poPlaceOfOrigin posn - -poNopos? posn == - posn = ['noposition] -pfNopos? posn == poNopos? posn -poPosImmediate? txp== - poNopos? txp => NIL - lnImmediate? poGetLineObject txp -pfPosImmediate? txp == poPosImmediate? txp - -poImmediate? txp== - lnImmediate? poGetLineObject txp -pfImmediate? txp == poImmediate? txp - - -compareposns(a,b)== - c:=poGlobalLinePosn a - d:=poGlobalLinePosn b - if c=d then poCharPosn a>=poCharPosn b else c>=d - -pfPrintSrcLines(pf) == - lines := pfSourcePositions pf - lno := 0 - for l in lines repeat - line := car l - if lno < lnGlobalNum(line) then - FORMAT(true, '" ~A~%", lnString line) - lno := lnGlobalNum(line) - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/ptrees.boot.pamphlet b/src/interp/ptrees.boot.pamphlet index 43471476..dea41bdc 100644 --- a/src/interp/ptrees.boot.pamphlet +++ b/src/interp/ptrees.boot.pamphlet @@ -64,44 +64,6 @@ THE PFORM DATA STRUCTURE )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) diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot index a22234c8..a3f37223 100644 --- a/src/interp/sys-constants.boot +++ b/src/interp/sys-constants.boot @@ -538,3 +538,6 @@ $leaveMode == $EmptyMode ++ $noEnv == nil + +++ +IDENTITY == function IDENTITY -- cgit v1.2.3