Initial population.

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}