diff --git a/changelog b/changelog index f474e77..e840c7b 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20090823 tpd src/axiom-website/patches.html 20090823.04.tpd.patch +20090823 tpd src/interp/Makefile move incl.boot to incl.lisp +20090823 tpd src/interp/incl.lisp added, rewritten from incl.boot +20090823 tpd src/interp/incl.boot removed, rewritten to incl.lisp 20090823 tpd src/axiom-website/patches.html 20090823.03.tpd.patch 20090823 tpd src/interp/Makefile move i-util.boot to i-util.lisp 20090823 tpd src/interp/i-util.lisp added, rewritten from i-util.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index d5c28b8..32fbc3a 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1852,5 +1852,7 @@ src/interp/Makefile stop building DOCFILES
i-toplev.lisp rewrite from boot to lisp
20090823.03.tpd.patch i-util.lisp rewrite from boot to lisp
+20090823.03.tpd.patch +incl.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index b88e0e0..8857a7b 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -4717,44 +4717,26 @@ ${DOC}/topics.boot.dvi: ${IN}/topics.boot.pamphlet @ -\subsection{incl.boot} +\subsection{incl.lisp} <>= -${OUT}/incl.${O}: ${MID}/incl.clisp - @ echo 504 making ${OUT}/incl.${O} from ${MID}/incl.clisp - @ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/incl.clisp"' \ - ':output-file "${OUT}/incl.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/incl.clisp"' \ - ':output-file "${OUT}/incl.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi - -@ -<>= -${MID}/incl.clisp: ${IN}/incl.boot.pamphlet - @ echo 505 making ${MID}/incl.clisp from ${IN}/incl.boot.pamphlet - @ (cd ${MID} ; \ - ${TANGLE} ${IN}/incl.boot.pamphlet >incl.boot ; \ +${OUT}/incl.${O}: ${MID}/incl.lisp + @ echo 136 making ${OUT}/incl.${O} from ${MID}/incl.lisp + @ ( cd ${MID} ; \ if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "${MID}/incl.boot") (${BYE}))' \ - | ${BOOTSYS} ; \ + echo '(progn (compile-file "${MID}/incl.lisp"' \ + ':output-file "${OUT}/incl.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (boottran::boottocl "${MID}/incl.boot") (${BYE}))' \ - | ${BOOTSYS} >${TMP}/trace ; \ - fi ; \ - rm incl.boot ) + echo '(progn (compile-file "${MID}/incl.lisp"' \ + ':output-file "${OUT}/incl.${O}") (${BYE}))' | ${DEPSYS} \ + >${TMP}/trace ; \ + fi ) @ -<>= -${DOC}/incl.boot.dvi: ${IN}/incl.boot.pamphlet - @echo 506 making ${DOC}/incl.boot.dvi from ${IN}/incl.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/incl.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} incl.boot ; \ - rm -f ${DOC}/incl.boot.pamphlet ; \ - rm -f ${DOC}/incl.boot.tex ; \ - rm -f ${DOC}/incl.boot ) +<>= +${MID}/incl.lisp: ${IN}/incl.lisp.pamphlet + @ echo 137 making ${MID}/incl.lisp from ${IN}/incl.lisp.pamphlet + @ (cd ${MID} ; \ + ${TANGLE} ${IN}/incl.lisp.pamphlet >incl.lisp ) @ @@ -6294,8 +6276,7 @@ clean: <> <> -<> -<> +<> <> <> diff --git a/src/interp/incl.boot.pamphlet b/src/interp/incl.boot.pamphlet deleted file mode 100644 index 89c4a56..0000000 --- a/src/interp/incl.boot.pamphlet +++ /dev/null @@ -1,283 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp incl.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" - -incStringStream s== - incRenumber incLude(0,incRgen s,0,['"strings"] ,[Top]) - -incFile fn== - incRenumber incLude(0,incRgen OPEN fn,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) - -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 - - --% 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/incl.lisp.pamphlet b/src/interp/incl.lisp.pamphlet new file mode 100644 index 0000000..66faf7a --- /dev/null +++ b/src/interp/incl.lisp.pamphlet @@ -0,0 +1,683 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp incl.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= + +(IN-PACKAGE "BOOT") + +;incStringStream s== +; incRenumber incLude(0,incRgen s,0,['"strings"] ,[Top]) + +(DEFUN |incStringStream| (|s|) + (PROG () + (RETURN + (|incRenumber| + (|incLude| 0 (|incRgen| |s|) 0 (LIST "strings") (LIST |Top|)))))) + +;incFile fn== +; incRenumber incLude(0,incRgen OPEN fn,0,[fn],[Top]) + +(DEFUN |incFile| (|fn|) + (PROG () + (RETURN + (|incRenumber| + (|incLude| 0 (|incRgen| (OPEN |fn|)) 0 (LIST |fn|) + (LIST |Top|)))))) + +;incFileInput fn == incRgen MAKE_-INSTREAM fn + +(DEFUN |incFileInput| (|fn|) + (PROG () (RETURN (|incRgen| (MAKE-INSTREAM |fn|))))) + +;incConsoleInput () == incRgen MAKE_-INSTREAM 0 +(DEFUN |incConsoleInput| () + (PROG () (RETURN (|incRgen| (MAKE-INSTREAM 0))))) + +;incLine(eb, str, gno, lno, ufo) == +; ln := lnCreate(eb,str,gno,lno,ufo) +; CONS(CONS(ln,1), str) + +(DEFUN |incLine| (|eb| |str| |gno| |lno| |ufo|) + (PROG (|ln|) + (RETURN + (PROGN + (SETQ |ln| (|lnCreate| |eb| |str| |gno| |lno| |ufo|)) + (CONS (CONS |ln| 1) |str|))))) + +;incPos f == CAR f + +(DEFUN |incPos| (|f|) (PROG () (RETURN (CAR |f|)))) + +;incRenumberItem(f, i) == +; l := CAAR f +; lnSetGlobalNum(l, i) +; f + +(DEFUN |incRenumberItem| (|f| |i|) + (PROG (|l|) + (RETURN + (PROGN (SETQ |l| (CAAR |f|)) (|lnSetGlobalNum| |l| |i|) |f|)))) + +;incRenumberLine(xl, gno) == +; l := incRenumberItem(xl.0, gno) +; incHandleMessage xl +; l + +(DEFUN |incRenumberLine| (|xl| |gno|) + (PROG (|l|) + (RETURN + (PROGN + (SETQ |l| (|incRenumberItem| (ELT |xl| 0) |gno|)) + (|incHandleMessage| |xl|) + |l|)))) + +;incRenumber ssx == incZip (function incRenumberLine, ssx, incIgen 0) + +(DEFUN |incRenumber| (|ssx|) + (PROG () + (RETURN (|incZip| #'|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 + +(DEFUN |incPrefix?| (|prefix| |start| |whole|) + (PROG (|good|) + (RETURN + (COND + ((< (- (LENGTH |whole|) |start|) (LENGTH |prefix|)) NIL) + ('T + (PROGN + (SETQ |good| T) + ((LAMBDA (|bfVar#1| |i| |j|) + (LOOP + (COND + ((OR (> |i| |bfVar#1|) (NOT |good|)) (RETURN NIL)) + ('T + (SETQ |good| + (EQUAL (ELT |prefix| |i|) (ELT |whole| |j|))))) + (SETQ |i| (+ |i| 1)) + (SETQ |j| (+ |j| 1)))) + (- (LENGTH |prefix|) 1) 0 |start|) + |good|)))))) + +;incCommand?(s) == #s > 0 and s.0 = char ")" + +(DEFUN |incCommand?| (|s|) + (PROG () + (RETURN + (AND (< 0 (LENGTH |s|)) (EQUAL (ELT |s| 0) (|char| '|)|)))))) + +;incCommands := +; ['"say" , _ +; '"include", _ +; '"console", _ +; '"fin" , _ +; '"assert" , _ +; '"if" , _ +; '"elseif" , _ +; '"else" , _ +; '"endif" ] + +(EVAL-WHEN (EVAL LOAD) + (SETQ |incCommands| + (LIST "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] + +(DEFUN |incClassify| (|s|) + (PROG (|p1| |bad| |eb| |n| |i|) + (RETURN + (COND + ((NULL (|incCommand?| |s|)) (LIST NIL 0 "")) + ('T + (PROGN + (SETQ |i| 1) + (SETQ |n| (LENGTH |s|)) + ((LAMBDA () + (LOOP + (COND + ((NOT (AND (< |i| |n|) + (EQUAL (ELT |s| |i|) (|char| '| |)))) + (RETURN NIL)) + ('T (SETQ |i| (+ |i| 1))))))) + (COND + ((NOT (< |i| |n|)) (LIST T 0 "other")) + ('T + (PROGN + (SETQ |eb| (COND ((EQL |i| 1) 0) ('T |i|))) + (SETQ |bad| T) + ((LAMBDA (|bfVar#2| |p|) + (LOOP + (COND + ((OR (ATOM |bfVar#2|) + (PROGN (SETQ |p| (CAR |bfVar#2|)) NIL) + (NOT |bad|)) + (RETURN NIL)) + ('T + (COND + ((|incPrefix?| |p| |i| |s|) + (IDENTITY + (PROGN + (SETQ |bad| NIL) + (SETQ |p1| |p|))))))) + (SETQ |bfVar#2| (CDR |bfVar#2|)))) + |incCommands| NIL) + (COND + (|bad| (LIST T 0 "other")) + ('T (LIST T |eb| |p1|)))))))))))) + +;incCommandTail(s, info) == +; start := (info.1 = 0 => 1; info.1) +; incDrop(start+#info.2+1, s) + +(DEFUN |incCommandTail| (|s| |info|) + (PROG (|start|) + (RETURN + (PROGN + (SETQ |start| + (COND ((EQL (ELT |info| 1) 0) 1) ('T (ELT |info| 1)))) + (|incDrop| (+ (+ |start| (LENGTH (ELT |info| 2))) 1) |s|))))) + +;incDrop(n, b) == +; n >= #b => "" +; SUBSTRING(b,n,nil) + +(DEFUN |incDrop| (|n| |b|) + (PROG () + (RETURN + (COND + ((NOT (< |n| (LENGTH |b|))) '||) + ('T (SUBSTRING |b| |n| NIL)))))) + +;inclFname(s, info) == incFileName incCommandTail(s, info) + +(DEFUN |inclFname| (|s| |info|) + (PROG () (RETURN (|incFileName| (|incCommandTail| |s| |info|))))) + +;incTrunc (n,x)== +; if #x>n +; then SUBSTRING(x,0,n) +; else x + +(DEFUN |incTrunc| (|n| |x|) + (PROG () + (RETURN + (COND ((< |n| (LENGTH |x|)) (SUBSTRING |x| 0 |n|)) ('T |x|))))) + +;incFileName x == first incBiteOff x + +(DEFUN |incFileName| (|x|) + (PROG () (RETURN (CAR (|incBiteOff| |x|))))) + +;fileNameStrings fn==[PNAME(fn.0),PNAME(fn.1),PNAME(fn.2)] + +(DEFUN |fileNameStrings| (|fn|) + (PROG () + (RETURN + (LIST (PNAME (ELT |fn| 0)) (PNAME (ELT |fn| 1)) + (PNAME (ELT |fn| 2)))))) + +;ifCond(s, info) == +; word := MakeSymbol StringTrim(incCommandTail(s, info), WhiteSpaceCset) +; ListMemberQ?(word, $inclAssertions) + +(DEFUN |ifCond| (|s| |info|) + (PROG (|word|) + (DECLARE (SPECIAL |$inclAssertions|)) + (RETURN + (PROGN + (SETQ |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] + +(DEFUN |assertCond| (|s| |info|) + (PROG (|word|) + (DECLARE (SPECIAL |$inclAssertions|)) + (RETURN + (PROGN + (SETQ |word| + (|MakeSymbol| + (|StringTrim| (|incCommandTail| |s| |info|) + |WhiteSpaceCset|))) + (COND + ((NULL (|ListMemberQ?| |word| |$inclAssertions|)) + (SETQ |$inclAssertions| (CONS |word| |$inclAssertions|)))))))) + +;incActive?(fn,ufos)==MEMBER(fn,ufos) + +(DEFUN |incActive?| (|fn| |ufos|) + (PROG () (RETURN (MEMBER |fn| |ufos|)))) + +;incNConsoles ufos== +; a:=MEMBER('"console",ufos) +; if a then 1+incNConsoles CDR a else 0 + +(DEFUN |incNConsoles| (|ufos|) + (PROG (|a|) + (RETURN + (PROGN + (SETQ |a| (MEMBER "console" |ufos|)) + (COND (|a| (+ 1 (|incNConsoles| (CDR |a|)))) ('T 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) + +(DEFUN |incHandleMessage| (|xl|) + (PROG () + (RETURN + (COND + ((EQ (ELT (ELT |xl| 1) 1) '|none|) 0) + ((EQ (ELT (ELT |xl| 1) 1) '|error|) + (|inclHandleError| (|incPos| (ELT |xl| 0)) + (ELT (ELT |xl| 1) 0))) + ((EQ (ELT (ELT |xl| 1) 1) '|warning|) + (|inclHandleWarning| (|incPos| (ELT |xl| 0)) + (ELT (ELT |xl| 1) 0))) + ((EQ (ELT (ELT |xl| 1) 1) '|say|) + (|inclHandleSay| (|incPos| (ELT |xl| 0)) (ELT (ELT |xl| 1) 0))) + ('T + (|inclHandleBug| (|incPos| (ELT |xl| 0)) (ELT (ELT |xl| 1) 0))))))) + +;xlOK(eb, str, lno, ufo) == +; [incLine(eb, str, -1, lno, ufo), [NIL, "none"]] + +(DEFUN |xlOK| (|eb| |str| |lno| |ufo|) + (PROG () + (RETURN + (LIST (|incLine| |eb| |str| (- 1) |lno| |ufo|) + (LIST NIL '|none|))))) + +;xlOK1(eb, str,str1, lno, ufo) == +; [incLine1(eb, str,str1, -1, lno, ufo), [NIL, "none"]] + +(DEFUN |xlOK1| (|eb| |str| |str1| |lno| |ufo|) + (PROG () + (RETURN + (LIST (|incLine1| |eb| |str| |str1| (- 1) |lno| |ufo|) + (LIST NIL '|none|))))) + +;incLine1(eb, str,str1, gno, lno, ufo) == +; ln := lnCreate(eb,str,gno,lno,ufo) +; CONS(CONS(ln,1), str1) + +(DEFUN |incLine1| (|eb| |str| |str1| |gno| |lno| |ufo|) + (PROG (|ln|) + (RETURN + (PROGN + (SETQ |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"]] + +(DEFUN |xlSkip| (|eb| |str| |lno| |ufo|) + (PROG () + (RETURN + (PROGN + (SETQ |str| (CONCAT "-- Omitting:" |str|)) + (LIST (|incLine| |eb| |str| (- 1) |lno| |ufo|) + (LIST NIL '|none|)))))) + +;xlMsg(eb, str, lno, ufo, mess) == +; [incLine(eb, str, -1, lno, ufo), mess] + +(DEFUN |xlMsg| (|eb| |str| |lno| |ufo| |mess|) + (PROG () + (RETURN (LIST (|incLine| |eb| |str| (- 1) |lno| |ufo|) |mess|)))) + +;xlPrematureEOF(eb, str, lno, ufos) == +; xlMsg(eb, str, lno,ufos.0, +; [inclmsgPrematureEOF(ufos.0),"error"]) + +(DEFUN |xlPrematureEOF| (|eb| |str| |lno| |ufos|) + (PROG () + (RETURN + (|xlMsg| |eb| |str| |lno| (ELT |ufos| 0) + (LIST (|inclmsgPrematureEOF| (ELT |ufos| 0)) '|error|))))) + +;xlPrematureFin(eb, str, lno, ufos) == +; xlMsg(eb, str, lno,ufos.0, +; [inclmsgPrematureFin(ufos.0),"error"]) + +(DEFUN |xlPrematureFin| (|eb| |str| |lno| |ufos|) + (PROG () + (RETURN + (|xlMsg| |eb| |str| |lno| (ELT |ufos| 0) + (LIST (|inclmsgPrematureFin| (ELT |ufos| 0)) '|error|))))) + +;xlFileCycle(eb, str, lno, ufos, fn) == +; xlMsg(eb, str, lno,ufos.0, +; [inclmsgFileCycle(ufos,fn),"error"]) + +(DEFUN |xlFileCycle| (|eb| |str| |lno| |ufos| |fn|) + (PROG () + (RETURN + (|xlMsg| |eb| |str| |lno| (ELT |ufos| 0) + (LIST (|inclmsgFileCycle| |ufos| |fn|) '|error|))))) + +;xlNoSuchFile(eb, str, lno, ufos, fn) == +; xlMsg(eb, str, lno,ufos.0, +; [inclmsgNoSuchFile(fn), "error"]) + +(DEFUN |xlNoSuchFile| (|eb| |str| |lno| |ufos| |fn|) + (PROG () + (RETURN + (|xlMsg| |eb| |str| |lno| (ELT |ufos| 0) + (LIST (|inclmsgNoSuchFile| |fn|) '|error|))))) + +;xlCannotRead(eb, str, lno, ufos, fn) == +; xlMsg(eb, str, lno,ufos.0, +; [inclmsgCannotRead(fn), "error"]) + +(DEFUN |xlCannotRead| (|eb| |str| |lno| |ufos| |fn|) + (PROG () + (RETURN + (|xlMsg| |eb| |str| |lno| (ELT |ufos| 0) + (LIST (|inclmsgCannotRead| |fn|) '|error|))))) + +;xlConsole(eb, str, lno, ufos) == +; xlMsg(eb, str, lno,ufos.0, +; [inclmsgConsole(),"say"]) + +(DEFUN |xlConsole| (|eb| |str| |lno| |ufos|) + (PROG () + (RETURN + (|xlMsg| |eb| |str| |lno| (ELT |ufos| 0) + (LIST (|inclmsgConsole|) '|say|))))) + +;xlConActive(eb, str, lno, ufos, n) == +; xlMsg(eb, str, lno,ufos.0, +; [inclmsgConActive(n),"warning"]) + +(DEFUN |xlConActive| (|eb| |str| |lno| |ufos| |n|) + (PROG () + (RETURN + (|xlMsg| |eb| |str| |lno| (ELT |ufos| 0) + (LIST (|inclmsgConActive| |n|) '|warning|))))) + +;xlConStill(eb, str, lno, ufos, n) == +; xlMsg(eb, str, lno,ufos.0, +; [inclmsgConStill(n), "say"]) + +(DEFUN |xlConStill| (|eb| |str| |lno| |ufos| |n|) + (PROG () + (RETURN + (|xlMsg| |eb| |str| |lno| (ELT |ufos| 0) + (LIST (|inclmsgConStill| |n|) '|say|))))) + +;xlSkippingFin(eb, str, lno, ufos) == +; xlMsg(eb, str, lno,ufos.0, +; [inclmsgFinSkipped(),"warning"]) + +(DEFUN |xlSkippingFin| (|eb| |str| |lno| |ufos|) + (PROG () + (RETURN + (|xlMsg| |eb| |str| |lno| (ELT |ufos| 0) + (LIST (|inclmsgFinSkipped|) '|warning|))))) + +;xlIfBug(eb, str, lno, ufos) == +; xlMsg(eb, str, lno,ufos.0, +; [inclmsgIfBug(), "bug"]) + +(DEFUN |xlIfBug| (|eb| |str| |lno| |ufos|) + (PROG () + (RETURN + (|xlMsg| |eb| |str| |lno| (ELT |ufos| 0) + (LIST (|inclmsgIfBug|) '|bug|))))) + +;xlCmdBug(eb, str, lno, ufos) == +; xlMsg(eb, str, lno,ufos.0, +; [inclmsgCmdBug(), "bug"]) + +(DEFUN |xlCmdBug| (|eb| |str| |lno| |ufos|) + (PROG () + (RETURN + (|xlMsg| |eb| |str| |lno| (ELT |ufos| 0) + (LIST (|inclmsgCmdBug|) '|bug|))))) + +;xlSay(eb, str, lno, ufos, x) == +; xlMsg(eb, str, lno,ufos.0, +; [inclmsgSay(x), "say"]) + +(DEFUN |xlSay| (|eb| |str| |lno| |ufos| |x|) + (PROG () + (RETURN + (|xlMsg| |eb| |str| |lno| (ELT |ufos| 0) + (LIST (|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"]) +(DEFUN |xlIfSyntax| (|eb| |str| |lno| |ufos| |info| |sts|) + (PROG (|context| |found| |st|) + (RETURN + (PROGN + (SETQ |st| (ELT |sts| 0)) + (SETQ |found| (ELT |info| 2)) + (SETQ |context| + (COND + ((|Top?| |st|) '|not in an )if...)endif|) + ((|Else?| |st|) '|after an )else|) + ('T '|but can't figure out where|))) + (|xlMsg| |eb| |str| |lno| (ELT |ufos| 0) + (LIST (|inclmsgIfSyntax| (ELT |ufos| 0) |found| + |context|) + '|error|)))))) + +; --% This is it +; +; --% Message handling for the source includer +;-- SMW June 88 +; +;inclHandleError(pos, [key, args]) == +; ncSoftError(pos, key, args) + +(DEFUN |inclHandleError| (|pos| |bfVar#3|) + (PROG (|args| |key|) + (RETURN + (PROGN + (SETQ |key| (CAR |bfVar#3|)) + (SETQ |args| (CADR |bfVar#3|)) + (|ncSoftError| |pos| |key| |args|))))) + +;inclHandleWarning(pos, [key, args]) == +; ncSoftError(pos, key,args) + +(DEFUN |inclHandleWarning| (|pos| |bfVar#4|) + (PROG (|args| |key|) + (RETURN + (PROGN + (SETQ |key| (CAR |bfVar#4|)) + (SETQ |args| (CADR |bfVar#4|)) + (|ncSoftError| |pos| |key| |args|))))) + +;inclHandleBug(pos, [key, args]) == +; ncBug(key, args) + +(DEFUN |inclHandleBug| (|pos| |bfVar#5|) + (PROG (|args| |key|) + (RETURN + (PROGN + (SETQ |key| (CAR |bfVar#5|)) + (SETQ |args| (CADR |bfVar#5|)) + (|ncBug| |key| |args|))))) + +;inclHandleSay(pos, [key, args]) == +; ncSoftError(pos, key, args) + +(DEFUN |inclHandleSay| (|pos| |bfVar#6|) + (PROG (|args| |key|) + (RETURN + (PROGN + (SETQ |key| (CAR |bfVar#6|)) + (SETQ |args| (CADR |bfVar#6|)) + (|ncSoftError| |pos| |key| |args|))))) + +;inclmsgSay str == +; ['S2CI0001, [%id str]] + +(DEFUN |inclmsgSay| (|str|) + (PROG () (RETURN (LIST 'S2CI0001 (LIST (|%id| |str|)))))) + +;inclmsgPrematureEOF ufo == +; ['S2CI0002, [%origin ufo]] + +(DEFUN |inclmsgPrematureEOF| (|ufo|) + (PROG () (RETURN (LIST 'S2CI0002 (LIST (|%origin| |ufo|)))))) + +;inclmsgPrematureFin ufo == +; ['S2CI0003, [%origin ufo]] + +(DEFUN |inclmsgPrematureFin| (|ufo|) + (PROG () (RETURN (LIST 'S2CI0003 (LIST (|%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]] + +(DEFUN |inclmsgFileCycle| (|ufos| |fn|) + (PROG (|cycle| |f1| |flist|) + (RETURN + (PROGN + (SETQ |flist| + ((LAMBDA (|bfVar#8| |bfVar#7| |n|) + (LOOP + (COND + ((OR (ATOM |bfVar#7|) + (PROGN (SETQ |n| (CAR |bfVar#7|)) NIL)) + (RETURN (NREVERSE |bfVar#8|))) + ('T + (SETQ |bfVar#8| (CONS (|porigin| |n|) |bfVar#8|)))) + (SETQ |bfVar#7| (CDR |bfVar#7|)))) + NIL (REVERSE |ufos|) NIL)) + (SETQ |f1| (|porigin| |fn|)) + (SETQ |cycle| + (APPEND ((LAMBDA (|bfVar#10| |bfVar#9| |n|) + (LOOP + (COND + ((OR (ATOM |bfVar#9|) + (PROGN + (SETQ |n| (CAR |bfVar#9|)) + NIL)) + (RETURN (NREVERSE |bfVar#10|))) + ('T + (SETQ |bfVar#10| + (APPEND (REVERSE (LIST |n| "==>")) + |bfVar#10|)))) + (SETQ |bfVar#9| (CDR |bfVar#9|)))) + NIL |flist| NIL) + (CONS |f1| NIL))) + (LIST 'S2CI0004 (LIST (|%id| |cycle|) (|%id| |f1|))))))) + +;inclmsgConsole () == +; ['S2CI0005, []] + +(DEFUN |inclmsgConsole| () (PROG () (RETURN (LIST 'S2CI0005 NIL)))) + +;inclmsgConActive n == +; ['S2CI0006, [%id n]] + +(DEFUN |inclmsgConActive| (|n|) + (PROG () (RETURN (LIST 'S2CI0006 (LIST (|%id| |n|)))))) + +;inclmsgConStill n == +; ['S2CI0007, [%id n]] + +(DEFUN |inclmsgConStill| (|n|) + (PROG () (RETURN (LIST 'S2CI0007 (LIST (|%id| |n|)))))) + +;inclmsgFinSkipped() == +; ['S2CI0008, []] + +(DEFUN |inclmsgFinSkipped| () (PROG () (RETURN (LIST 'S2CI0008 NIL)))) + +;inclmsgIfSyntax(ufo,found,context) == +; found := CONCAT('")", found) +; ['S2CI0009, [%id found, %id context, %origin ufo]] + +(DEFUN |inclmsgIfSyntax| (|ufo| |found| |context|) + (PROG () + (RETURN + (PROGN + (SETQ |found| (CONCAT ")" |found|)) + (LIST 'S2CI0009 + (LIST (|%id| |found|) (|%id| |context|) + (|%origin| |ufo|))))))) + +;inclmsgNoSuchFile fn == +; ['S2CI0010, [%fname fn]] + +(DEFUN |inclmsgNoSuchFile| (|fn|) + (PROG () (RETURN (LIST 'S2CI0010 (LIST (|%fname| |fn|)))))) + +;inclmsgCannotRead fn == +; ['S2CI0011, [%fname fn]] + +(DEFUN |inclmsgCannotRead| (|fn|) + (PROG () (RETURN (LIST 'S2CI0011 (LIST (|%fname| |fn|)))))) + +;inclmsgIfBug() == +; ['S2CB0002, []] + +(DEFUN |inclmsgIfBug| () (PROG () (RETURN (LIST 'S2CB0002 NIL)))) + +;inclmsgCmdBug() == +; ['S2CB0003, []] + +(DEFUN |inclmsgCmdBug| () (PROG () (RETURN (LIST 'S2CB0003 NIL)))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}