diff options
Diffstat (limited to 'src/boot/scanner.boot.pamphlet')
| -rw-r--r-- | src/boot/scanner.boot.pamphlet | 1175 |
1 files changed, 1175 insertions, 0 deletions
diff --git a/src/boot/scanner.boot.pamphlet b/src/boot/scanner.boot.pamphlet new file mode 100644 index 00000000..b98ed289 --- /dev/null +++ b/src/boot/scanner.boot.pamphlet @@ -0,0 +1,1175 @@ +\documentclass{article} +\usepackage{axiom} + +\title{\File{src/boot/scanner.boot} Pamphlet} +\author{The Axiom Team} + +\begin{document} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject + +\section{License} + +<<license>>= +-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- All rights reserved. +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- - Redistributions of source code must retain the above copyright +-- notice, this list of conditions and the following disclaimer. +-- +-- - Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in +-- the documentation and/or other materials provided with the +-- distribution. +-- +-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the +-- names of its contributors may be used to endorse or promote products +-- derived from this software without specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +@ + +<<*>>= +<<license>> + +module '"boot-lexer" +import '"tokens" +import '"includer" + +)package "BOOTTRAN" + +-- converts X to double-float. +double x == + FLOAT(x, 1.0) + +dqUnit s==(a:=[s];CONS(a,a)) + +dqAppend(x,y)== + if null x + then y + else if null y + then x + else + RPLACD (CDR x,CAR y) + RPLACD (x, CDR y) + x + +dqConcat ld== + if null ld + then nil + else if null rest ld + then first ld + else dqAppend(first ld,dqConcat rest ld) + +dqToList s==if null s then nil else CAR s + +shoeConstructToken(ln,lp,b,n)==[b.0,b.1,:cons(lp,n)] +shoeTokType x== CAR x +shoeTokPart x== CADR x +shoeTokPosn x== CDDR x +shoeTokConstruct(x,y,z)==[x,y,:z] + +shoeNextLine(s)== + if bStreamNull s + then false + else + $linepos:=s + $f:= CAR s + $r:= CDR s + $ln:=CAR $f + $n:=STRPOSL('" ",$ln,0,true) + $sz :=# $ln + null $n => true + QENUM($ln,$n)=shoeTAB => + a:=MAKE_-FULL_-CVEC (7-REM($n,8) ,'" ") + $ln.$n:='" ".0 + $ln:=CONCAT(a,$ln) + s1:=cons(cons($ln,CDR $f),$r) + shoeNextLine s1 + true + +shoeLineToks(s)== + $f: local:=nil + $r:local :=nil + $ln:local :=nil + $n:local:=nil + $sz:local := nil + $floatok:local:=true + $linepos:local:=s + not shoeNextLine s => CONS(nil,nil) + null $n => shoeLineToks $r + fst:=QENUM($ln,0) + EQL(fst,shoeCLOSEPAREN)=> + command:=shoeLine? $ln=> + dq:=dqUnit shoeConstructToken + ($ln,$linepos,shoeLeafLine command,0) + cons([dq],$r) + command:=shoeLisp? $ln=> shoeLispToken($r,command) + command:=shoePackage? $ln=> + -- z:=car shoeBiteOff command + a:=CONCAT('"(IN-PACKAGE ",command,'")") + dq:=dqUnit shoeConstructToken + ($ln,$linepos,shoeLeafLisp a,0) + cons([dq],$r) + shoeLineToks $r + toks:=[] + while $n<$sz repeat toks:=dqAppend(toks,shoeToken()) + null toks => shoeLineToks $r + cons([toks],$r) + +shoeLispToken(s,string)== + string:= + # string=0 or EQL(QENUM(string,0),QENUM('";",0))=> '"" + string + ln:=$ln + linepos:=$linepos + [r,:st]:=shoeAccumulateLines(s,string) + dq:=dqUnit shoeConstructToken(ln,linepos,shoeLeafLisp st,0) + cons([dq],r) + +shoeAccumulateLines(s,string)== + not shoeNextLine s => CONS(s,string) + null $n => shoeAccumulateLines($r,string) + # $ln=0 => shoeAccumulateLines($r,string) + fst:=QENUM($ln,0) + EQL(fst,shoeCLOSEPAREN)=> + command:=shoeLisp? $ln + command and #command>0 => + EQL(QENUM(command,0),QENUM('";",0))=> + shoeAccumulateLines($r,string) + a:=STRPOS('";",command,0,nil) + a=> + shoeAccumulateLines($r, + CONCAT(string,SUBSTRING(command,0,a-1))) + shoeAccumulateLines($r,CONCAT(string,command)) + shoeAccumulateLines($r,string) + CONS(s,string) + +-- returns true if token t is closing `parenthesis'. +shoeCloser t == + MEMQ(shoeKeyWord t, '(CPAREN CBRACK)) + +shoeToken () == + ln:=$ln + c:=QENUM($ln,$n) + linepos:=$linepos + n:=$n + ch:=$ln.$n + b:= + shoeStartsComment() => + shoeComment() + [] + shoeStartsNegComment() => + shoeNegComment() + [] + c=shoeLispESCAPE => + shoeLispEscape() + shoePunctuation c => shoePunct () + shoeStartsId ch => shoeWord (false) + c=shoeSPACE => + shoeSpace () + [] + c = shoeSTRING_CHAR => shoeString () + shoeDigit ch => shoeNumber () + c=shoeESCAPE => shoeEscape() + c=shoeTAB => + $n:=$n+1 + [] + shoeError () + null b => nil + dqUnit shoeConstructToken(ln,linepos,b,n) + +-- to pair badge and badgee +shoeLeafId x== ["ID",INTERN x] + +shoeLeafKey x==["KEY",shoeKeyWord x] + +shoeLeafInteger x==["INTEGER",shoeIntValue x] + +shoeLeafFloat(a,w,e)== + b:=shoeIntValue CONCAT(a,w) + c:= double b * EXPT(double 10, e-#w) + ["FLOAT",c] + +shoeLeafString x == ["STRING",x] + +shoeLeafLisp x == ["LISP",x] +shoeLeafLispExp x == ["LISPEXP",x] + +shoeLeafLine x == ["LINE",x] + +shoeLeafComment x == ["COMMENT", x] + +shoeLeafNegComment x== ["NEGCOMMENT", x] + +shoeLeafError x == ["ERROR",x] + +shoeLeafSpaces x == ["SPACES",x] + +shoeLispEscape()== + $n:=$n+1 + if $n>=$sz + then + SoftShoeError(cons($linepos,$n),'"lisp escape error") + shoeLeafError ($ln.$n) + else + a:=shoeReadLispString($ln,$n) + null a => + SoftShoeError(cons($linepos,$n),'"lisp escape error") + shoeLeafError ($ln.$n) + [exp,n]:=a + null n => + $n:= $sz + shoeLeafLispExp exp + $n:=n + shoeLeafLispExp exp +shoeEscape()== + $n:=$n+1 + a:=shoeEsc() + if a then shoeWord true else nil + +shoeEsc()== + if $n>=$sz + then if shoeNextLine($r) + then + while null $n repeat shoeNextLine($r) + shoeEsc() + false + else false + else + n1:=STRPOSL('" ",$ln,$n,true) + if null n1 + then + shoeNextLine($r) + while null $n repeat shoeNextLine($r) + shoeEsc() + false + else true + +shoeStartsComment()== + if $n<$sz + then + if QENUM($ln,$n)=shoePLUSCOMMENT + then + www:=$n+1 + if www>=$sz + then false + else QENUM($ln,www) = shoePLUSCOMMENT + else false + else false + +shoeStartsNegComment()== + if $n< $sz + then + if QENUM($ln,$n)=shoeMINUSCOMMENT + then + www:=$n+1 + if www>=$sz + then false + else QENUM($ln,www) = shoeMINUSCOMMENT + else false + else false + +shoeNegComment()== + n:=$n + $n:=$sz + shoeLeafNegComment SUBSTRING($ln,n,nil) + +shoeComment()== + n:=$n + $n:=$sz + shoeLeafComment SUBSTRING($ln,n,nil) + +shoePunct()== + sss:=shoeMatch($ln,$n) + $n:=$n+#sss + shoeKeyTr sss + +shoeKeyTr w== + if EQ(shoeKeyWord w,"DOT") + then if $floatok + then shoePossFloat(w) + else shoeLeafKey w + else + $floatok:=not shoeCloser w + shoeLeafKey w + +shoePossFloat (w)== + if $n>=$sz or not shoeDigit $ln.$n + then shoeLeafKey w + else + w:=shoeInteger() + shoeExponent('"0",w) + + +shoeSpace()== + n:=$n + $n:=STRPOSL('" ",$ln,$n,true) + $floatok:=true + if null $n + then + shoeLeafSpaces 0 + $n:= # $ln + else shoeLeafSpaces ($n-n) + +shoeString()== + $n:=$n+1 + $floatok:=false + shoeLeafString shoeS () + +shoeS()== + if $n>=$sz + then + SoftShoeError(cons($linepos,$n),'"quote added") + '"" + else + n:=$n + strsym :=STRPOS ('"_"",$ln,$n,nil) or $sz + escsym:=STRPOS ('"__" + ,$ln,$n,nil) or $sz + mn:=MIN(strsym,escsym) + if mn=$sz + then + $n:=$sz + SoftShoeError(cons($linepos,$n),'"quote added") + SUBSTRING($ln,n,nil) + else if mn=strsym + then + $n:=mn+1 + SUBSTRING($ln,n,mn-n) + else + str:=SUBSTRING($ln,n,mn-n) + $n:=mn+1 + a:=shoeEsc() + b:=if a + then + str:=CONCAT(str,$ln.$n) + $n:=$n+1 + shoeS() + else shoeS() + CONCAT(str,b) + + + + +shoeIdEnd(line,n)== + while n<#line and shoeIdChar line.n repeat n:=n+1 + n + + +shoeDigit x== DIGIT_-CHAR_-P x + +shoeW(b)== + n1:=$n + $n:=$n+1 + l:=$sz + endid:=shoeIdEnd($ln,$n) + if endid=l or QENUM($ln,endid)^=shoeESCAPE + then + $n:=endid + [b,SUBSTRING($ln,n1,endid-n1)] + else + str:=SUBSTRING($ln,n1,endid-n1) + $n:=endid+1 + a:=shoeEsc() + bb:=if a + then shoeW(true) + else [b,'""] -- escape finds space or newline + [bb.0 or b,CONCAT(str,bb.1)] + +shoeWord(esp) == + aaa:=shoeW(false) + w:=aaa.1 + $floatok:=false + if esp or aaa.0 + then shoeLeafId w + else if shoeKeyWordP w + then + $floatok:=true + shoeLeafKey w + else shoeLeafId w + +shoeInteger()==shoeInteger1(false) + +shoeInteger1(zro) == + n:=$n + l:= $sz + while $n<l and shoeDigit($ln.$n) repeat $n:=$n+1 + if $n=l or QENUM($ln,$n)^=shoeESCAPE + then if n=$n and zro + then '"0" + else SUBSTRING($ln,n,$n-n) + else + str:=SUBSTRING($ln,n,$n-n) + $n:=$n+1 + a:=shoeEsc() + bb:=shoeInteger1(zro) + CONCAT(str,bb) + +shoeIntValue(s) == + ns := #s + ival := 0 + for i in 0..ns-1 repeat + d := shoeOrdToNum ELT(s,i) + ival := 10*ival + d + ival + +shoeNumber() == + a := shoeInteger() + if $n>=$sz + then shoeLeafInteger a + else + if $floatok and QENUM($ln,$n)=shoeDOT + then + n:=$n + $n:=$n+1 + if $n<$sz and QENUM($ln,$n)=shoeDOT + then + $n:=n + shoeLeafInteger a + else + w:=shoeInteger1(true) + shoeExponent(a,w) + else shoeLeafInteger a + +shoeExponent(a,w)== + if $n>=$sz + then shoeLeafFloat(a,w,0) + else + n:=$n + c:=QENUM($ln,$n) + if c=shoeEXPONENT1 or c=shoeEXPONENT2 + then + $n:=$n+1 + if $n>=$sz + then + $n:=n + shoeLeafFloat(a,w,0) + else if shoeDigit($ln.$n) + then + e:=shoeInteger() + e:=shoeIntValue e + shoeLeafFloat(a,w,e) + else + c1:=QENUM($ln,$n) + if c1=shoePLUSCOMMENT or c1=shoeMINUSCOMMENT + then + $n:=$n+1 + if $n>=$sz + then + $n:=n + shoeLeafFloat(a,w,0) + else + if shoeDigit($ln.$n) + then + e:=shoeInteger() + e:=shoeIntValue e + shoeLeafFloat(a,w, + (if c1=shoeMINUSCOMMENT then MINUS e else e)) + else + $n:=n + shoeLeafFloat(a,w,0) + else shoeLeafFloat(a,w,0) + +shoeError()== + n:=$n + $n:=$n+1 + SoftShoeError(cons($linepos,n), + CONCAT( '"The character whose number is ", + STRINGIMAGE QENUM($ln,n),'" is not a Boot character")) + shoeLeafError ($ln.n) + +shoeOrdToNum x== DIGIT_-CHAR_-P x + +shoeKeyWord st == GETHASH(st,shoeKeyTable) + +shoeKeyWordP st == not null GETHASH(st,shoeKeyTable) + +shoeMatch(l,i)==shoeSubStringMatch(l,shoeDict,i) + +shoeSubStringMatch (l,d,i)== + h:= QENUM(l, i) + u:=ELT(d,h) + ll:=SIZE l + done:=false + s1:='"" + for j in 0.. SIZE u - 1 while not done repeat + s:=ELT(u,j) + ls:=SIZE s + done:=if ls+i > ll + then false + else + eql:= true + for k in 1..ls-1 while eql repeat + eql:= EQL(QENUM(s,k),QENUM(l,k+i)) + if eql + then + s1:=s + true + else false + s1 + +shoePunctuation c== shoePun.c =1 + +@ +<<scanner.clisp>>= +(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-lexer")) + +(IMPORT-MODULE "tokens") + +(IMPORT-MODULE "includer") + +(IN-PACKAGE "BOOTTRAN") + +(DEFUN |double| (|x|) (PROG () (RETURN (FLOAT |x| 1.0)))) + +(DEFUN |dqUnit| (|s|) + (PROG (|a|) (RETURN (PROGN (SETQ |a| (LIST |s|)) (CONS |a| |a|))))) + +(DEFUN |dqAppend| (|x| |y|) + (PROG () + (RETURN + (COND + ((NULL |x|) |y|) + ((NULL |y|) |x|) + ('T (RPLACD (CDR |x|) (CAR |y|)) (RPLACD |x| (CDR |y|)) |x|))))) + +(DEFUN |dqConcat| (|ld|) + (PROG () + (RETURN + (COND + ((NULL |ld|) NIL) + ((NULL (CDR |ld|)) (CAR |ld|)) + ('T (|dqAppend| (CAR |ld|) (|dqConcat| (CDR |ld|)))))))) + +(DEFUN |dqToList| (|s|) + (PROG () (RETURN (COND ((NULL |s|) NIL) ('T (CAR |s|)))))) + +(DEFUN |shoeConstructToken| (|ln| |lp| |b| |n|) + (PROG () + (RETURN (CONS (ELT |b| 0) (CONS (ELT |b| 1) (CONS |lp| |n|)))))) + +(DEFUN |shoeTokType| (|x|) (PROG () (RETURN (CAR |x|)))) + +(DEFUN |shoeTokPart| (|x|) (PROG () (RETURN (CADR |x|)))) + +(DEFUN |shoeTokPosn| (|x|) (PROG () (RETURN (CDDR |x|)))) + +(DEFUN |shoeTokConstruct| (|x| |y| |z|) + (PROG () (RETURN (CONS |x| (CONS |y| |z|))))) + +(DEFUN |shoeNextLine| (|s|) + (PROG (|s1| |a|) + (DECLARE (SPECIAL |$sz| |$n| |$ln| |$r| |$f| |$linepos|)) + (RETURN + (COND + ((|bStreamNull| |s|) NIL) + ('T (SETQ |$linepos| |s|) (SETQ |$f| (CAR |s|)) + (SETQ |$r| (CDR |s|)) (SETQ |$ln| (CAR |$f|)) + (SETQ |$n| (STRPOSL " " |$ln| 0 T)) + (SETQ |$sz| (LENGTH |$ln|)) + (COND + ((NULL |$n|) T) + ((EQUAL (QENUM |$ln| |$n|) |shoeTAB|) + (PROGN + (SETQ |a| (MAKE-FULL-CVEC (- 7 (REM |$n| 8)) " ")) + (SETF (ELT |$ln| |$n|) (ELT " " 0)) + (SETQ |$ln| (CONCAT |a| |$ln|)) + (SETQ |s1| (CONS (CONS |$ln| (CDR |$f|)) |$r|)) + (|shoeNextLine| |s1|))) + ('T T))))))) + +(DEFUN |shoeLineToks| (|s|) + (PROG (|$linepos| |$floatok| |$sz| |$n| |$ln| |$r| |$f| |toks| |a| + |dq| |command| |fst|) + (DECLARE (SPECIAL |$floatok| |$f| |$sz| |$linepos| |$ln| |$r| |$n|)) + (RETURN + (PROGN + (SETQ |$f| NIL) + (SETQ |$r| NIL) + (SETQ |$ln| NIL) + (SETQ |$n| NIL) + (SETQ |$sz| NIL) + (SETQ |$floatok| T) + (SETQ |$linepos| |s|) + (COND + ((NULL (|shoeNextLine| |s|)) (CONS NIL NIL)) + ((NULL |$n|) (|shoeLineToks| |$r|)) + (#0='T + (PROGN + (SETQ |fst| (QENUM |$ln| 0)) + (COND + ((EQL |fst| |shoeCLOSEPAREN|) + (COND + ((SETQ |command| (|shoeLine?| |$ln|)) + (PROGN + (SETQ |dq| + (|dqUnit| + (|shoeConstructToken| |$ln| |$linepos| + (|shoeLeafLine| |command|) 0))) + (CONS (LIST |dq|) |$r|))) + ((SETQ |command| (|shoeLisp?| |$ln|)) + (|shoeLispToken| |$r| |command|)) + ((SETQ |command| (|shoePackage?| |$ln|)) + (PROGN + (SETQ |a| (CONCAT "(IN-PACKAGE " |command| ")")) + (SETQ |dq| + (|dqUnit| + (|shoeConstructToken| |$ln| |$linepos| + (|shoeLeafLisp| |a|) 0))) + (CONS (LIST |dq|) |$r|))) + (#0# (|shoeLineToks| |$r|)))) + (#0# + (PROGN + (SETQ |toks| NIL) + ((LAMBDA () + (LOOP + (COND + ((NOT (< |$n| |$sz|)) (RETURN NIL)) + ('T + (SETQ |toks| + (|dqAppend| |toks| (|shoeToken|)))))))) + (COND + ((NULL |toks|) (|shoeLineToks| |$r|)) + (#0# (CONS (LIST |toks|) |$r|))))))))))))) + +(DEFUN |shoeLispToken| (|s| |string|) + (PROG (|dq| |st| |r| |LETTMP#1| |linepos| |ln|) + (DECLARE (SPECIAL |$linepos| |$ln|)) + (RETURN + (PROGN + (SETQ |string| + (COND + ((OR (EQL (LENGTH |string|) 0) + (EQL (QENUM |string| 0) (QENUM ";" 0))) + "") + ('T |string|))) + (SETQ |ln| |$ln|) + (SETQ |linepos| |$linepos|) + (SETQ |LETTMP#1| (|shoeAccumulateLines| |s| |string|)) + (SETQ |r| (CAR |LETTMP#1|)) + (SETQ |st| (CDR |LETTMP#1|)) + (SETQ |dq| + (|dqUnit| + (|shoeConstructToken| |ln| |linepos| + (|shoeLeafLisp| |st|) 0))) + (CONS (LIST |dq|) |r|))))) + +(DEFUN |shoeAccumulateLines| (|s| |string|) + (PROG (|a| |command| |fst|) + (DECLARE (SPECIAL |$ln| |$r| |$n|)) + (RETURN + (COND + ((NULL (|shoeNextLine| |s|)) (CONS |s| |string|)) + ((NULL |$n|) (|shoeAccumulateLines| |$r| |string|)) + ((EQL (LENGTH |$ln|) 0) (|shoeAccumulateLines| |$r| |string|)) + (#0='T + (PROGN + (SETQ |fst| (QENUM |$ln| 0)) + (COND + ((EQL |fst| |shoeCLOSEPAREN|) + (PROGN + (SETQ |command| (|shoeLisp?| |$ln|)) + (COND + ((AND |command| (< 0 (LENGTH |command|))) + (COND + ((EQL (QENUM |command| 0) (QENUM ";" 0)) + (|shoeAccumulateLines| |$r| |string|)) + (#0# + (PROGN + (SETQ |a| (STRPOS ";" |command| 0 NIL)) + (COND + (|a| (|shoeAccumulateLines| |$r| + (CONCAT |string| + (SUBSTRING |command| 0 (- |a| 1))))) + (#0# + (|shoeAccumulateLines| |$r| + (CONCAT |string| |command|)))))))) + (#0# (|shoeAccumulateLines| |$r| |string|))))) + (#0# (CONS |s| |string|))))))))) + +(DEFUN |shoeCloser| (|t|) + (PROG () (RETURN (MEMQ (|shoeKeyWord| |t|) '(CPAREN CBRACK))))) + +(DEFUN |shoeToken| () + (PROG (|b| |ch| |n| |linepos| |c| |ln|) + (DECLARE (SPECIAL |$linepos| |$n| |$ln|)) + (RETURN + (PROGN + (SETQ |ln| |$ln|) + (SETQ |c| (QENUM |$ln| |$n|)) + (SETQ |linepos| |$linepos|) + (SETQ |n| |$n|) + (SETQ |ch| (ELT |$ln| |$n|)) + (SETQ |b| + (COND + ((|shoeStartsComment|) (PROGN (|shoeComment|) NIL)) + ((|shoeStartsNegComment|) + (PROGN (|shoeNegComment|) NIL)) + ((EQUAL |c| |shoeLispESCAPE|) (|shoeLispEscape|)) + ((|shoePunctuation| |c|) (|shoePunct|)) + ((|shoeStartsId| |ch|) (|shoeWord| NIL)) + ((EQUAL |c| |shoeSPACE|) (PROGN (|shoeSpace|) NIL)) + ((EQUAL |c| |shoeSTRINGCHAR|) (|shoeString|)) + ((|shoeDigit| |ch|) (|shoeNumber|)) + ((EQUAL |c| |shoeESCAPE|) (|shoeEscape|)) + ((EQUAL |c| |shoeTAB|) + (PROGN (SETQ |$n| (+ |$n| 1)) NIL)) + (#0='T (|shoeError|)))) + (COND + ((NULL |b|) NIL) + (#0# + (|dqUnit| (|shoeConstructToken| |ln| |linepos| |b| |n|)))))))) + +(DEFUN |shoeLeafId| (|x|) (PROG () (RETURN (LIST 'ID (INTERN |x|))))) + +(DEFUN |shoeLeafKey| (|x|) + (PROG () (RETURN (LIST 'KEY (|shoeKeyWord| |x|))))) + +(DEFUN |shoeLeafInteger| (|x|) + (PROG () (RETURN (LIST 'INTEGER (|shoeIntValue| |x|))))) + +(DEFUN |shoeLeafFloat| (|a| |w| |e|) + (PROG (|c| |b|) + (RETURN + (PROGN + (SETQ |b| (|shoeIntValue| (CONCAT |a| |w|))) + (SETQ |c| + (* (|double| |b|) (EXPT (|double| 10) (- |e| (LENGTH |w|))))) + (LIST 'FLOAT |c|))))) + +(DEFUN |shoeLeafString| (|x|) (PROG () (RETURN (LIST 'STRING |x|)))) + +(DEFUN |shoeLeafLisp| (|x|) (PROG () (RETURN (LIST 'LISP |x|)))) + +(DEFUN |shoeLeafLispExp| (|x|) (PROG () (RETURN (LIST 'LISPEXP |x|)))) + +(DEFUN |shoeLeafLine| (|x|) (PROG () (RETURN (LIST 'LINE |x|)))) + +(DEFUN |shoeLeafComment| (|x|) (PROG () (RETURN (LIST 'COMMENT |x|)))) + +(DEFUN |shoeLeafNegComment| (|x|) + (PROG () (RETURN (LIST 'NEGCOMMENT |x|)))) + +(DEFUN |shoeLeafError| (|x|) (PROG () (RETURN (LIST 'ERROR |x|)))) + +(DEFUN |shoeLeafSpaces| (|x|) (PROG () (RETURN (LIST 'SPACES |x|)))) + +(DEFUN |shoeLispEscape| () + (PROG (|n| |exp| |a|) + (DECLARE (SPECIAL |$ln| |$linepos| |$sz| |$n|)) + (RETURN + (PROGN + (SETQ |$n| (+ |$n| 1)) + (COND + ((NOT (< |$n| |$sz|)) + (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error") + (|shoeLeafError| (ELT |$ln| |$n|))) + ('T (SETQ |a| (|shoeReadLispString| |$ln| |$n|)) + (COND + ((NULL |a|) + (PROGN + (|SoftShoeError| (CONS |$linepos| |$n|) + "lisp escape error") + (|shoeLeafError| (ELT |$ln| |$n|)))) + (#0='T + (PROGN + (SETQ |exp| (CAR |a|)) + (SETQ |n| (CADR |a|)) + (COND + ((NULL |n|) + (PROGN (SETQ |$n| |$sz|) (|shoeLeafLispExp| |exp|))) + (#0# + (PROGN (SETQ |$n| |n|) (|shoeLeafLispExp| |exp|))))))))))))) + +(DEFUN |shoeEscape| () + (PROG (|a|) + (DECLARE (SPECIAL |$n|)) + (RETURN + (PROGN + (SETQ |$n| (+ |$n| 1)) + (SETQ |a| (|shoeEsc|)) + (COND (|a| (|shoeWord| T)) ('T NIL)))))) + +(DEFUN |shoeEsc| () + (PROG (|n1|) + (DECLARE (SPECIAL |$ln| |$r| |$sz| |$n|)) + (RETURN + (COND + ((NOT (< |$n| |$sz|)) + (COND + ((|shoeNextLine| |$r|) + ((LAMBDA () + (LOOP + (COND + (|$n| (RETURN NIL)) + (#0='T (|shoeNextLine| |$r|)))))) + (|shoeEsc|) NIL) + (#1='T NIL))) + (#1# (SETQ |n1| (STRPOSL " " |$ln| |$n| T)) + (COND + ((NULL |n1|) (|shoeNextLine| |$r|) + ((LAMBDA () + (LOOP + (COND + (|$n| (RETURN NIL)) + (#0# (|shoeNextLine| |$r|)))))) + (|shoeEsc|) NIL) + (#1# T))))))) + +(DEFUN |shoeStartsComment| () + (PROG (|www|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (COND + ((< |$n| |$sz|) + (COND + ((EQUAL (QENUM |$ln| |$n|) |shoePLUSCOMMENT|) + (SETQ |www| (+ |$n| 1)) + (COND + ((NOT (< |www| |$sz|)) NIL) + (#0='T (EQUAL (QENUM |$ln| |www|) |shoePLUSCOMMENT|)))) + (#0# NIL))) + (#0# NIL))))) + +(DEFUN |shoeStartsNegComment| () + (PROG (|www|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (COND + ((< |$n| |$sz|) + (COND + ((EQUAL (QENUM |$ln| |$n|) |shoeMINUSCOMMENT|) + (SETQ |www| (+ |$n| 1)) + (COND + ((NOT (< |www| |$sz|)) NIL) + (#0='T (EQUAL (QENUM |$ln| |www|) |shoeMINUSCOMMENT|)))) + (#0# NIL))) + (#0# NIL))))) + +(DEFUN |shoeNegComment| () + (PROG (|n|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (PROGN + (SETQ |n| |$n|) + (SETQ |$n| |$sz|) + (|shoeLeafNegComment| (SUBSTRING |$ln| |n| NIL)))))) + +(DEFUN |shoeComment| () + (PROG (|n|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (PROGN + (SETQ |n| |$n|) + (SETQ |$n| |$sz|) + (|shoeLeafComment| (SUBSTRING |$ln| |n| NIL)))))) + +(DEFUN |shoePunct| () + (PROG (|sss|) + (DECLARE (SPECIAL |$n| |$ln|)) + (RETURN + (PROGN + (SETQ |sss| (|shoeMatch| |$ln| |$n|)) + (SETQ |$n| (+ |$n| (LENGTH |sss|))) + (|shoeKeyTr| |sss|))))) + +(DEFUN |shoeKeyTr| (|w|) + (PROG () + (DECLARE (SPECIAL |$floatok|)) + (RETURN + (COND + ((EQ (|shoeKeyWord| |w|) 'DOT) + (COND + (|$floatok| (|shoePossFloat| |w|)) + (#0='T (|shoeLeafKey| |w|)))) + (#0# (SETQ |$floatok| (NULL (|shoeCloser| |w|))) + (|shoeLeafKey| |w|)))))) + +(DEFUN |shoePossFloat| (|w|) + (PROG () + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (COND + ((OR (NOT (< |$n| |$sz|)) + (NULL (|shoeDigit| (ELT |$ln| |$n|)))) + (|shoeLeafKey| |w|)) + ('T (SETQ |w| (|shoeInteger|)) (|shoeExponent| "0" |w|)))))) + +(DEFUN |shoeSpace| () + (PROG (|n|) + (DECLARE (SPECIAL |$floatok| |$ln| |$n|)) + (RETURN + (PROGN + (SETQ |n| |$n|) + (SETQ |$n| (STRPOSL " " |$ln| |$n| T)) + (SETQ |$floatok| T) + (COND + ((NULL |$n|) (|shoeLeafSpaces| 0) (SETQ |$n| (LENGTH |$ln|))) + ('T (|shoeLeafSpaces| (- |$n| |n|)))))))) + +(DEFUN |shoeString| () + (PROG () + (DECLARE (SPECIAL |$floatok| |$n|)) + (RETURN + (PROGN + (SETQ |$n| (+ |$n| 1)) + (SETQ |$floatok| NIL) + (|shoeLeafString| (|shoeS|)))))) + +(DEFUN |shoeS| () + (PROG (|b| |a| |str| |mn| |escsym| |strsym| |n|) + (DECLARE (SPECIAL |$ln| |$linepos| |$sz| |$n|)) + (RETURN + (COND + ((NOT (< |$n| |$sz|)) + (|SoftShoeError| (CONS |$linepos| |$n|) "quote added") "") + (#0='T (SETQ |n| |$n|) + (SETQ |strsym| (OR (STRPOS "\"" |$ln| |$n| NIL) |$sz|)) + (SETQ |escsym| (OR (STRPOS "_" |$ln| |$n| NIL) |$sz|)) + (SETQ |mn| (MIN |strsym| |escsym|)) + (COND + ((EQUAL |mn| |$sz|) (SETQ |$n| |$sz|) + (|SoftShoeError| (CONS |$linepos| |$n|) "quote added") + (SUBSTRING |$ln| |n| NIL)) + ((EQUAL |mn| |strsym|) (SETQ |$n| (+ |mn| 1)) + (SUBSTRING |$ln| |n| (- |mn| |n|))) + (#0# (SETQ |str| (SUBSTRING |$ln| |n| (- |mn| |n|))) + (SETQ |$n| (+ |mn| 1)) (SETQ |a| (|shoeEsc|)) + (SETQ |b| + (COND + (|a| (SETQ |str| (CONCAT |str| (ELT |$ln| |$n|))) + (SETQ |$n| (+ |$n| 1)) (|shoeS|)) + (#0# (|shoeS|)))) + (CONCAT |str| |b|)))))))) + +(DEFUN |shoeIdEnd| (|line| |n|) + (PROG () + (RETURN + (PROGN + ((LAMBDA () + (LOOP + (COND + ((NOT (AND (< |n| (LENGTH |line|)) + (|shoeIdChar| (ELT |line| |n|)))) + (RETURN NIL)) + ('T (SETQ |n| (+ |n| 1))))))) + |n|)))) + +(DEFUN |shoeDigit| (|x|) (PROG () (RETURN (DIGIT-CHAR-P |x|)))) + +(DEFUN |shoeW| (|b|) + (PROG (|bb| |a| |str| |endid| |l| |n1|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (PROGN + (SETQ |n1| |$n|) + (SETQ |$n| (+ |$n| 1)) + (SETQ |l| |$sz|) + (SETQ |endid| (|shoeIdEnd| |$ln| |$n|)) + (COND + ((OR (EQUAL |endid| |l|) + (NOT (EQUAL (QENUM |$ln| |endid|) |shoeESCAPE|))) + (SETQ |$n| |endid|) + (LIST |b| (SUBSTRING |$ln| |n1| (- |endid| |n1|)))) + (#0='T (SETQ |str| (SUBSTRING |$ln| |n1| (- |endid| |n1|))) + (SETQ |$n| (+ |endid| 1)) (SETQ |a| (|shoeEsc|)) + (SETQ |bb| (COND (|a| (|shoeW| T)) (#0# (LIST |b| "")))) + (LIST (OR (ELT |bb| 0) |b|) (CONCAT |str| (ELT |bb| 1))))))))) + +(DEFUN |shoeWord| (|esp|) + (PROG (|w| |aaa|) + (DECLARE (SPECIAL |$floatok|)) + (RETURN + (PROGN + (SETQ |aaa| (|shoeW| NIL)) + (SETQ |w| (ELT |aaa| 1)) + (SETQ |$floatok| NIL) + (COND + ((OR |esp| (ELT |aaa| 0)) (|shoeLeafId| |w|)) + ((|shoeKeyWordP| |w|) (SETQ |$floatok| T) + (|shoeLeafKey| |w|)) + ('T (|shoeLeafId| |w|))))))) + +(DEFUN |shoeInteger| () (PROG () (RETURN (|shoeInteger1| NIL)))) + +(DEFUN |shoeInteger1| (|zro|) + (PROG (|bb| |a| |str| |l| |n|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (PROGN + (SETQ |n| |$n|) + (SETQ |l| |$sz|) + ((LAMBDA () + (LOOP + (COND + ((NOT (AND (< |$n| |l|) (|shoeDigit| (ELT |$ln| |$n|)))) + (RETURN NIL)) + ('T (SETQ |$n| (+ |$n| 1))))))) + (COND + ((OR (EQUAL |$n| |l|) + (NOT (EQUAL (QENUM |$ln| |$n|) |shoeESCAPE|))) + (COND + ((AND (EQUAL |n| |$n|) |zro|) "0") + (#0='T (SUBSTRING |$ln| |n| (- |$n| |n|))))) + (#0# (SETQ |str| (SUBSTRING |$ln| |n| (- |$n| |n|))) + (SETQ |$n| (+ |$n| 1)) (SETQ |a| (|shoeEsc|)) + (SETQ |bb| (|shoeInteger1| |zro|)) (CONCAT |str| |bb|))))))) + +(DEFUN |shoeIntValue| (|s|) + (PROG (|d| |ival| |ns|) + (RETURN + (PROGN + (SETQ |ns| (LENGTH |s|)) + (SETQ |ival| 0) + ((LAMBDA (|bfVar#1| |i|) + (LOOP + (COND + ((> |i| |bfVar#1|) (RETURN NIL)) + ('T + (PROGN + (SETQ |d| (|shoeOrdToNum| (ELT |s| |i|))) + (SETQ |ival| (+ (* 10 |ival|) |d|))))) + (SETQ |i| (+ |i| 1)))) + (- |ns| 1) 0) + |ival|)))) + +(DEFUN |shoeNumber| () + (PROG (|w| |n| |a|) + (DECLARE (SPECIAL |$ln| |$floatok| |$sz| |$n|)) + (RETURN + (PROGN + (SETQ |a| (|shoeInteger|)) + (COND + ((NOT (< |$n| |$sz|)) (|shoeLeafInteger| |a|)) + ((AND |$floatok| (EQUAL (QENUM |$ln| |$n|) |shoeDOT|)) + (SETQ |n| |$n|) (SETQ |$n| (+ |$n| 1)) + (COND + ((AND (< |$n| |$sz|) (EQUAL (QENUM |$ln| |$n|) |shoeDOT|)) + (SETQ |$n| |n|) (|shoeLeafInteger| |a|)) + (#0='T (SETQ |w| (|shoeInteger1| T)) + (|shoeExponent| |a| |w|)))) + (#0# (|shoeLeafInteger| |a|))))))) + +(DEFUN |shoeExponent| (|a| |w|) + (PROG (|c1| |e| |c| |n|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (COND + ((NOT (< |$n| |$sz|)) (|shoeLeafFloat| |a| |w| 0)) + (#0='T (SETQ |n| |$n|) (SETQ |c| (QENUM |$ln| |$n|)) + (COND + ((OR (EQUAL |c| |shoeEXPONENT1|) + (EQUAL |c| |shoeEXPONENT2|)) + (SETQ |$n| (+ |$n| 1)) + (COND + ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|) + (|shoeLeafFloat| |a| |w| 0)) + ((|shoeDigit| (ELT |$ln| |$n|)) + (SETQ |e| (|shoeInteger|)) + (SETQ |e| (|shoeIntValue| |e|)) + (|shoeLeafFloat| |a| |w| |e|)) + (#0# (SETQ |c1| (QENUM |$ln| |$n|)) + (COND + ((OR (EQUAL |c1| |shoePLUSCOMMENT|) + (EQUAL |c1| |shoeMINUSCOMMENT|)) + (SETQ |$n| (+ |$n| 1)) + (COND + ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|) + (|shoeLeafFloat| |a| |w| 0)) + ((|shoeDigit| (ELT |$ln| |$n|)) + (SETQ |e| (|shoeInteger|)) + (SETQ |e| (|shoeIntValue| |e|)) + (|shoeLeafFloat| |a| |w| + (COND + ((EQUAL |c1| |shoeMINUSCOMMENT|) (- |e|)) + (#0# |e|)))) + (#0# (SETQ |$n| |n|) (|shoeLeafFloat| |a| |w| 0)))))))) + (#0# (|shoeLeafFloat| |a| |w| 0)))))))) + +(DEFUN |shoeError| () + (PROG (|n|) + (DECLARE (SPECIAL |$ln| |$linepos| |$n|)) + (RETURN + (PROGN + (SETQ |n| |$n|) + (SETQ |$n| (+ |$n| 1)) + (|SoftShoeError| (CONS |$linepos| |n|) + (CONCAT "The character whose number is " + (STRINGIMAGE (QENUM |$ln| |n|)) + " is not a Boot character")) + (|shoeLeafError| (ELT |$ln| |n|)))))) + +(DEFUN |shoeOrdToNum| (|x|) (PROG () (RETURN (DIGIT-CHAR-P |x|)))) + +(DEFUN |shoeKeyWord| (|st|) + (PROG () (RETURN (GETHASH |st| |shoeKeyTable|)))) + +(DEFUN |shoeKeyWordP| (|st|) + (PROG () (RETURN (NULL (NULL (GETHASH |st| |shoeKeyTable|)))))) + +(DEFUN |shoeMatch| (|l| |i|) + (PROG () (RETURN (|shoeSubStringMatch| |l| |shoeDict| |i|)))) + +(DEFUN |shoeSubStringMatch| (|l| |d| |i|) + (PROG (|eql| |ls| |s| |s1| |done| |ll| |u| |h|) + (RETURN + (PROGN + (SETQ |h| (QENUM |l| |i|)) + (SETQ |u| (ELT |d| |h|)) + (SETQ |ll| (SIZE |l|)) + (SETQ |done| NIL) + (SETQ |s1| "") + ((LAMBDA (|bfVar#2| |j|) + (LOOP + (COND + ((OR (> |j| |bfVar#2|) |done|) (RETURN NIL)) + (#0='T + (PROGN + (SETQ |s| (ELT |u| |j|)) + (SETQ |ls| (SIZE |s|)) + (SETQ |done| + (COND + ((< |ll| (+ |ls| |i|)) NIL) + (#1='T (SETQ |eql| T) + ((LAMBDA (|bfVar#3| |k|) + (LOOP + (COND + ((OR (> |k| |bfVar#3|) (NOT |eql|)) + (RETURN NIL)) + (#0# + (SETQ |eql| + (EQL (QENUM |s| |k|) + (QENUM |l| (+ |k| |i|)))))) + (SETQ |k| (+ |k| 1)))) + (- |ls| 1) 1) + (COND (|eql| (SETQ |s1| |s|) T) (#1# NIL)))))))) + (SETQ |j| (+ |j| 1)))) + (- (SIZE |u|) 1) 0) + |s1|)))) + +(DEFUN |shoePunctuation| (|c|) + (PROG () (RETURN (EQL (ELT |shoePun| |c|) 1)))) + +@ + +\end{document} |