Initial population.

1 files changed, 565 insertions, 0 deletions

diff --git a/src/interp/scan.boot.pamphlet b/src/interp/scan.boot.pamphlet
new file mode 100644
index 00000000..cd117672
--- /dev/null
+++ b/src/interp/scan.boot.pamphlet
@@ -0,0 +1,565 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp scan.boot}
+\author{The Axiom Team}
+\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>>
+
+)package "BOOT"
+
+-- Scanner
+
+--  lineoftoks  bites off a token-dq from a line-stream
+--  returning the token-dq and the rest of the line-stream
+
+scanIgnoreLine(ln,n)==
+    if null n
+    then n
+    else
+       fst:=QENUM(ln,0)
+       if EQ(fst,CLOSEPAREN)
+       then if incPrefix?('"command",1,ln)
+            then true
+            else nil
+       else n
+
+nextline(s)==
+     if npNull s
+     then false
+     else
+       $f:= CAR s
+       $r:= CDR s
+       $ln := CDR $f
+       $linepos:=CAAR $f
+       $n:=STRPOSL('" ",$ln,0,true)-- spaces at beginning
+       $sz :=# $ln
+       true
+
+
+lineoftoks(s)==
+   $f: local:=nil
+   $r:local :=nil
+   $ln:local :=nil
+   $linepos:local:=nil
+   $n:local:=nil
+   $sz:local := nil
+   $floatok:local:=true
+   if not nextline s
+   then CONS(nil,nil)
+   else
+     if null scanIgnoreLine($ln,$n) -- line of spaces or starts ) or >
+     then cons(nil,$r)
+     else
+      toks:=[]
+      a:= incPrefix?('"command",1,$ln)
+      a =>
+                 $ln:=SUBSTRING($ln,8,nil)
+                 b:= dqUnit constoken($ln,$linepos,["command",$ln],0)
+                 cons([[b,s]],$r)
+
+      while $n<$sz repeat toks:=dqAppend(toks,scanToken())
+      if null toks
+      then cons([],$r)
+      else cons([[toks,s]],$r)
+
+
+scanToken () ==
+      ln:=$ln
+      c:=QENUM($ln,$n)
+      linepos:=$linepos
+      n:=$n
+      ch:=$ln.$n
+      b:=
+            startsComment?()          =>
+                           scanComment()
+                           []
+            startsNegComment?()       =>
+                           scanNegComment()
+                           []
+            c= QUESTION               =>
+                               $n:=$n+1
+                               lfid '"?"
+            punctuation? c            => scanPunct ()
+            startsId? ch              => scanWord  (false)
+            c=SPACE                   =>
+                           scanSpace ()
+                           []
+            c = STRING_CHAR           => scanString ()
+            digit? ch                 => scanNumber ()
+            c=ESCAPE                  => scanEscape()
+            scanError ()
+      null b => nil
+      dqUnit constoken(ln,linepos,b,n+lnExtraBlanks linepos)
+
+-- to pair badge and badgee
+
+-- lfid x== ["id",INTERN x]
+lfid x== ["id",INTERN(x, '"BOOT")]
+
+lfkey x==["key",keyword x]
+
+lfinteger x==
+           ["integer",x]
+--     if EQUAL(x,'"0")
+--     then ["id",INTERN x]
+--     else if EQUAL(x,'"1")
+--          then ["id",INTERN x]
+--          else ["integer",x]
+
+lfrinteger (r,x)==["integer",CONCAT (r,CONCAT('"r",x))]
+--lfrfloat(a,w,v)==["rfloat",CONCAT(a,'"r.",v)]
+lffloat(a,w,e)==["float",CONCAT(a,'".",w,'"e",e)]
+lfstring x==if #x=1 then ["char",x] else ["string",x]
+lfcomment x== ["comment", x]
+lfnegcomment x== ["negcomment", x]
+lferror x==["error",x]
+lfspaces x==["spaces",x]
+
+constoken(ln,lp,b,n)==
+--  [b.0,b.1,cons(lp,n)]
+       a:=cons(b.0,b.1)
+       ncPutQ(a,"posn",cons(lp,n))
+       a
+
+scanEscape()==
+         $n:=$n+1
+         a:=scanEsc()
+         if a then scanWord true else nil
+
+scanEsc()==
+     if $n>=$sz
+     then if nextline($r)
+          then
+             while null $n repeat nextline($r)
+             scanEsc()
+             false
+          else false
+     else
+           n1:=STRPOSL('" ",$ln,$n,true)
+           if null n1
+           then if nextline($r)
+                then
+                  while null $n repeat nextline($r)
+                  scanEsc()
+                  false
+                else false
+           else
+                if $n=n1
+                then true
+                else if QENUM($ln,n1)=ESCAPE
+                     then
+                       $n:=n1+1
+                       scanEsc()
+                       false
+                     else
+                       $n:=n1
+                       startsNegComment?() or startsComment?() =>
+                                 nextline($r)
+                                 scanEsc()
+                                 false
+                       false
+
+startsComment?()==
+    if $n<$sz
+    then
+         if QENUM($ln,$n)=PLUSCOMMENT
+         then
+            www:=$n+1
+            if www>=$sz
+            then false
+            else QENUM($ln,www) = PLUSCOMMENT
+          else false
+    else false
+
+startsNegComment?()==
+    if $n< $sz
+    then
+         if QENUM($ln,$n)=MINUSCOMMENT
+         then
+            www:=$n+1
+            if www>=$sz
+            then false
+            else QENUM($ln,www) = MINUSCOMMENT
+          else false
+    else false
+
+scanNegComment()==
+      n:=$n
+      $n:=$sz
+      lfnegcomment SUBSTRING($ln,n,nil)
+
+scanComment()==
+      n:=$n
+      $n:=$sz
+      lfcomment SUBSTRING($ln,n,nil)
+
+
+scanPunct()==
+            sss:=subMatch($ln,$n)
+            a:= # sss
+            if a=0
+            then
+               scanError()
+            else
+               $n:=$n+a
+               scanKeyTr sss
+
+scanKeyTr w==
+       if EQ(keyword w,"DOT")
+       then if $floatok
+            then scanPossFloat(w)
+            else lfkey w
+       else
+            $floatok:=not scanCloser? w
+            lfkey w
+
+scanPossFloat (w)==
+     if $n>=$sz or not digit? $ln.$n
+     then lfkey w
+     else
+       w:=spleI(function digit?)
+       scanExponent('"0",w)
+
+scanCloser:=[")","}","]","|)","|}","|]"]
+
+scanCloser? w== MEMQ(keyword w,scanCloser)
+
+scanSpace()==
+           n:=$n
+           $n:=STRPOSL('" ",$ln,$n,true)
+           if null $n then $n:=# $ln
+           $floatok:=true
+           lfspaces ($n-n)
+
+scanString()==
+            $n:=$n+1
+            $floatok:=false
+            lfstring scanS ()
+
+scanS()==
+   if $n>=$sz
+   then
+     ncSoftError(cons($linepos,lnExtraBlanks $linepos+$n),"S2CN0001",[])
+     '""
+   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
+                 ncSoftError(cons($linepos,lnExtraBlanks $linepos+$n),
+                         "S2CN0001",[])
+                 SUBSTRING($ln,n,nil)
+           else if mn=strsym
+                then
+                   $n:=mn+1
+                   SUBSTRING($ln,n,mn-n)
+                else     --escape is found first
+                  str:=SUBSTRING($ln,n,mn-n)-- before escape
+                  $n:=mn+1
+                  a:=scanEsc() -- case of end of line when false
+                  b:=if a
+                     then
+                       str:=CONCAT(str,scanTransform($ln.$n))
+                       $n:=$n+1
+                       scanS()
+                      else scanS()
+                  CONCAT(str,b)
+scanTransform x==x
+
+--idChar? x== scanLetter x or DIGITP x or MEMQ(x,'(_? _%))
+
+--scanLetter x==
+--   if not CHARP x
+--   then false
+--   else STRPOSL(scanTrTable,x,0,NIL)
+
+posend(line,n)==
+     while n<#line and idChar? line.n repeat n:=n+1
+     n
+
+--numend(line,n)==
+--     while n<#line and digit? line.n repeat n:=n+1
+--     n
+
+--startsId? x==  scanLetter x or MEMQ(x,'(_? _%))
+digit? x== DIGITP x
+
+scanW(b)==             -- starts pointing to first char
+       n1:=$n         -- store starting character position
+       $n:=$n+1          -- the first character is not tested
+       l:=$sz
+       endid:=posend($ln,$n)
+       if endid=l or QENUM($ln,endid)^=ESCAPE
+       then -- not escaped
+           $n:=endid
+           [b,SUBSTRING($ln,n1,endid-n1)]   -- l overflows
+       else -- escape and endid^=l
+           str:=SUBSTRING($ln,n1,endid-n1)
+           $n:=endid+1
+           a:=scanEsc()
+           bb:=if a -- escape nonspace
+               then scanW(true)
+               else
+                  if $n>=$sz
+                  then [b,'""]
+                  else
+                    if idChar?($ln.$n)
+                    then scanW(b)
+                    else [b,'""]
+           [bb.0 or b,CONCAT(str,bb.1)]
+
+scanWord(esp) ==
+          aaa:=scanW(false)
+          w:=aaa.1
+          $floatok:=false
+          if esp or aaa.0
+          then lfid w
+          else if keyword? w
+               then
+                  $floatok:=true
+                  lfkey w
+               else lfid  w
+
+
+
+spleI(dig)==spleI1(dig,false)
+spleI1(dig,zro) ==
+       n:=$n
+       l:= $sz
+       while $n<l and FUNCALL(dig,($ln.$n)) repeat $n:=$n+1
+       if $n=l or QENUM($ln,$n)^=ESCAPE
+       then if n=$n and zro
+            then '"0"
+            else SUBSTRING($ln,n,$n-n)
+       else  -- escaped
+             str:=SUBSTRING($ln,n,$n-n)
+             $n:=$n+1
+             a:=scanEsc()
+             bb:=spleI1(dig,zro)-- escape, anyno spaces are ignored
+             CONCAT(str,bb)
+
+scanCheckRadix(r,w)==
+       ns:=#w
+       done:=false
+       for i in 0..ns-1  repeat
+         a:=rdigit? w.i
+         if null a or a>=r
+         then  ncSoftError(cons($linepos,lnExtraBlanks $linepos+$n-ns+i),
+                    "S2CN0002", [w.i])
+
+scanNumber() ==
+       a := spleI(function digit?)
+       if $n>=$sz
+       then lfinteger a
+       else
+         if QENUM($ln,$n)^=RADIX_CHAR
+         then
+           if $floatok and QENUM($ln,$n)=DOT
+           then
+             n:=$n
+             $n:=$n+1
+             if  $n<$sz and QENUM($ln,$n)=DOT
+             then
+               $n:=n
+               lfinteger a
+             else
+               w:=spleI1(function digit?,true)
+               scanExponent(a,w)
+           else lfinteger a
+         else
+             $n:=$n+1
+             w:=spleI1(function rdigit?,true)
+             scanCheckRadix(PARSE_-INTEGER a,w)
+             if $n>=$sz
+             then
+                lfrinteger(a,w)
+             else if QENUM($ln,$n)=DOT
+                  then
+                    n:=$n
+                    $n:=$n+1
+                    if  $n<$sz and QENUM($ln,$n)=DOT
+                    then
+                       $n:=n
+                       lfrinteger(a,w)
+                    else
+                    --$n:=$n+1
+                      v:=spleI1(function rdigit?,true)
+                      scanCheckRadix(PARSE_-INTEGER a,v)
+                      scanExponent(CONCAT(a,'"r",w),v)
+                  else lfrinteger(a,w)
+
+scanExponent(a,w)==
+     if $n>=$sz
+     then lffloat(a,w,'"0")
+     else
+        n:=$n
+        c:=QENUM($ln,$n)
+        if c=EXPONENT1 or c=EXPONENT2
+        then
+           $n:=$n+1
+           if $n>=$sz
+           then
+             $n:=n
+             lffloat(a,w,'"0")
+           else if digit?($ln.$n)
+                then
+                  e:=spleI(function digit?)
+                  lffloat(a,w,e)
+                else
+                  c1:=QENUM($ln,$n)
+                  if c1=PLUSCOMMENT or c1=MINUSCOMMENT
+                  then
+                    $n:=$n+1
+                    if $n>=$sz
+                    then
+                      $n:=n
+                      lffloat(a,w,'"0")
+                    else
+                      if digit?($ln.$n)
+                      then
+                        e:=spleI(function digit?)
+                        lffloat(a,w,
+                          (if c1=MINUSCOMMENT then CONCAT('"-",e)else e))
+                      else
+                        $n:=n
+                        lffloat(a,w,'"0")
+        else lffloat(a,w,'"0")
+
+rdigit? x==
+   STRPOS(x,'"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",0,nil)
+
+scanError()==
+      n:=$n
+      $n:=$n+1
+      ncSoftError(cons($linepos,lnExtraBlanks $linepos+$n),
+         "S2CN0003",[$ln.n])
+      lferror ($ln.n)
+
+
+keyword st   == HGET(scanKeyTable,st)
+
+keyword? st  ==  not null HGET(scanKeyTable,st)
+
+scanInsert(s,d) ==
+      l := #s
+      h := QENUM(s,0)
+      u := ELT(d,h)
+      n := #u
+      k:=0
+      while l <= #(ELT(u,k)) repeat
+          k:=k+1
+      v := MAKE_-VEC(n+1)
+      for i in 0..k-1 repeat VEC_-SETELT(v,i,ELT(u,i))
+      VEC_-SETELT(v,k,s)
+      for i in k..n-1 repeat VEC_-SETELT(v,i+1,ELT(u,i))
+      VEC_-SETELT(d,h,v)
+      s
+
+subMatch(l,i)==substringMatch(l,scanDict,i)
+
+substringMatch (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
+
+
+scanKeyTableCons()==
+   KeyTable:=MAKE_-HASHTABLE("CVEC",true)
+   for st in scanKeyWords repeat
+      HPUT(KeyTable,CAR st,CADR st)
+   KeyTable
+
+scanDictCons()==
+      l:= HKEYS scanKeyTable
+      d :=
+          a:=MAKE_-VEC(256)
+          b:=MAKE_-VEC(1)
+          VEC_-SETELT(b,0,MAKE_-CVEC 0)
+          for i in 0..255 repeat VEC_-SETELT(a,i,b)
+          a
+      for s in l repeat scanInsert(s,d)
+      d
+
+
+scanPunCons()==
+    listing := HKEYS scanKeyTable
+    a:=MAKE_-BVEC 256
+--  SETSIZE(a,256)
+    for i in 0..255 repeat BVEC_-SETELT(a,i,0)
+    for k in listing repeat
+       if not startsId? k.0
+       then BVEC_-SETELT(a,QENUM(k,0),1)
+    a
+
+
+
+punctuation? c== scanPun.c=1
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}