\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)
                  (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|)
            (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|)
            (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
        (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|)
        (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)
        (LET ((|bfVar#1| (- |ns| 1)) (|i| 0))
          (LOOP
            (COND
              ((> |i| |bfVar#1|) (RETURN NIL))
              ('T
               (PROGN
                 (SETQ |d| (|shoeOrdToNum| (ELT |s| |i|)))
                 (SETQ |ival| (+ (* 10 |ival|) |d|)))))
            (SETQ |i| (+ |i| 1))))
        |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| "")
        (LET ((|bfVar#2| (- (SIZE |u|) 1)) (|j| 0))
          (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)
                          (LET ((|bfVar#3| (- |ls| 1)) (|k| 1))
                            (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))))
                          (COND (|eql| (SETQ |s1| |s|) T) (#1# NIL))))))))
            (SETQ |j| (+ |j| 1))))
        |s1|))))

(DEFUN |shoePunctuation| (|c|)
  (PROG () (RETURN (EQL (ELT |shoePun| |c|) 1))))

@

\end{document}