diff --git a/changelog b/changelog index 065364e..4aaf408 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20090825 tpd src/axiom-website/patches.html 20090826.01.tpd.patch +20090825 tpd src/interp/Makefile move scan.boot to scan.lisp +20090825 tpd src/interp/scan.lisp added, rewritten from scan.boot +20090825 tpd src/interp/scan.boot removed, rewritten to scan.lisp 20090825 tpd src/axiom-website/patches.html 20090825.05.tpd.patch 20090825 tpd src/interp/Makefile move rulesets.boot to rulesets.lisp 20090825 tpd src/interp/rulesets.lisp added, rewritten from rulesets.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index adf18f5..a7d12a1 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1896,5 +1896,7 @@ nruntime.lisp,ptrop.lisp rewrite from boot to lisp
record.lisp rewrite from boot to lisp
20090825.05.tpd.patch rulesets.lisp rewrite from boot to lisp
+20090826.01.tpd.patch +scan.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 712e741..f6e8b51 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -4523,44 +4523,26 @@ ${MID}/incl.lisp: ${IN}/incl.lisp.pamphlet @ -\subsection{scan.boot} +\subsection{scan.lisp} <>= -${OUT}/scan.${O}: ${MID}/scan.clisp - @ echo 507 making ${OUT}/scan.${O} from ${MID}/scan.clisp - @ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/scan.clisp"' \ +${OUT}/scan.${O}: ${MID}/scan.lisp + @ echo 136 making ${OUT}/scan.${O} from ${MID}/scan.lisp + @ ( cd ${MID} ; \ + if [ -z "${NOISE}" ] ; then \ + echo '(progn (compile-file "${MID}/scan.lisp"' \ ':output-file "${OUT}/scan.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/scan.clisp"' \ + echo '(progn (compile-file "${MID}/scan.lisp"' \ ':output-file "${OUT}/scan.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ - fi + fi ) @ -<>= -${MID}/scan.clisp: ${IN}/scan.boot.pamphlet - @ echo 508 making ${MID}/scan.clisp from ${IN}/scan.boot.pamphlet +<>= +${MID}/scan.lisp: ${IN}/scan.lisp.pamphlet + @ echo 137 making ${MID}/scan.lisp from ${IN}/scan.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/scan.boot.pamphlet >scan.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boottran::boottocl "${MID}/scan.boot") (${BYE}))' \ - | ${BOOTSYS} ; \ - else \ - echo '(progn (boottran::boottocl "${MID}/scan.boot") (${BYE}))' \ - | ${BOOTSYS} >${TMP}/trace ; \ - fi ; \ - rm scan.boot ) - -@ -<>= -${DOC}/scan.boot.dvi: ${IN}/scan.boot.pamphlet - @echo 509 making ${DOC}/scan.boot.dvi from ${IN}/scan.boot.pamphlet - @(cd ${DOC} ; \ - cp ${IN}/scan.boot.pamphlet ${DOC} ; \ - ${DOCUMENT} ${NOISE} scan.boot ; \ - rm -f ${DOC}/scan.boot.pamphlet ; \ - rm -f ${DOC}/scan.boot.tex ; \ - rm -f ${DOC}/scan.boot ) + ${TANGLE} ${IN}/scan.lisp.pamphlet >scan.lisp ) @ @@ -6115,8 +6097,7 @@ clean: <> <> -<> -<> +<> <> <> diff --git a/src/interp/scan.boot.pamphlet b/src/interp/scan.boot.pamphlet deleted file mode 100644 index cd11767..0000000 --- a/src/interp/scan.boot.pamphlet +++ /dev/null @@ -1,565 +0,0 @@ -\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} -<>= --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --- All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS --- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED --- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A --- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER --- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, --- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, --- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR --- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF --- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING --- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - -)package "BOOT" - --- 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=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} diff --git a/src/interp/scan.lisp.pamphlet b/src/interp/scan.lisp.pamphlet new file mode 100644 index 0000000..8983f08 --- /dev/null +++ b/src/interp/scan.lisp.pamphlet @@ -0,0 +1,1172 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp scan.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= +(IN-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 + +(DEFUN |scanIgnoreLine| (|ln| |n|) + (PROG (|fst|) + (RETURN + (COND + ((NULL |n|) |n|) + ('T (SETQ |fst| (QENUM |ln| 0)) + (COND + ((EQ |fst| CLOSEPAREN) + (COND ((|incPrefix?| "command" 1 |ln|) T) ('T NIL))) + ('T |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 + +(DEFUN |nextline| (|s|) + (PROG () + (DECLARE (SPECIAL |$sz| |$n| |$linepos| |$ln| |$r| |$f|)) + (RETURN + (COND + ((|npNull| |s|) NIL) + ('T (SETQ |$f| (CAR |s|)) (SETQ |$r| (CDR |s|)) + (SETQ |$ln| (CDR |$f|)) (SETQ |$linepos| (CAAR |$f|)) + (SETQ |$n| (STRPOSL " " |$ln| 0 T)) + (SETQ |$sz| (LENGTH |$ln|)) T))))) + +;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) + +(DEFUN |lineoftoks| (|s|) + (PROG (|$floatok| |$sz| |$n| |$linepos| |$ln| |$r| |$f| |b| |a| + |toks|) + (DECLARE (SPECIAL |$floatok| |$f| |$sz| |$linepos| |$r| |$n| |$ln|)) + (RETURN + (PROGN + (SETQ |$f| NIL) + (SETQ |$r| NIL) + (SETQ |$ln| NIL) + (SETQ |$linepos| NIL) + (SETQ |$n| NIL) + (SETQ |$sz| NIL) + (SETQ |$floatok| T) + (COND + ((NULL (|nextline| |s|)) (CONS NIL NIL)) + ((NULL (|scanIgnoreLine| |$ln| |$n|)) (CONS NIL |$r|)) + ('T (SETQ |toks| NIL) + (SETQ |a| (|incPrefix?| "command" 1 |$ln|)) + (COND + (|a| (PROGN + (SETQ |$ln| (SUBSTRING |$ln| 8 NIL)) + (SETQ |b| + (|dqUnit| + (|constoken| |$ln| |$linepos| + (LIST '|command| |$ln|) 0))) + (CONS (LIST (LIST |b| |s|)) |$r|))) + ('T + (PROGN + ((LAMBDA () + (LOOP + (COND + ((NOT (< |$n| |$sz|)) (RETURN NIL)) + ('T + (SETQ |toks| (|dqAppend| |toks| (|scanToken|)))))))) + (COND + ((NULL |toks|) (CONS NIL |$r|)) + ('T (CONS (LIST (LIST |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) + +(DEFUN |scanToken| () + (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 + ((|startsComment?|) (PROGN (|scanComment|) NIL)) + ((|startsNegComment?|) (PROGN (|scanNegComment|) NIL)) + ((EQUAL |c| QUESTION) + (PROGN (SETQ |$n| (+ |$n| 1)) (|lfid| "?"))) + ((|punctuation?| |c|) (|scanPunct|)) + ((|startsId?| |ch|) (|scanWord| NIL)) + ((EQUAL |c| SPACE) (PROGN (|scanSpace|) NIL)) + ((EQUAL |c| STRINGCHAR) (|scanString|)) + ((|digit?| |ch|) (|scanNumber|)) + ((EQUAL |c| ESCAPE) (|scanEscape|)) + ('T (|scanError|)))) + (COND + ((NULL |b|) NIL) + ('T + (|dqUnit| + (|constoken| |ln| |linepos| |b| + (+ |n| (|lnExtraBlanks| |linepos|)))))))))) + +;-- to pair badge and badgee +; +;-- lfid x== ["id",INTERN x] +;lfid x== ["id",INTERN(x, '"BOOT")] + +(DEFUN |lfid| (|x|) + (PROG () (RETURN (LIST '|id| (INTERN |x| "BOOT"))))) + +;lfkey x==["key",keyword x] + +(DEFUN |lfkey| (|x|) (PROG () (RETURN (LIST '|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] + +(DEFUN |lfinteger| (|x|) (PROG () (RETURN (LIST '|integer| |x|)))) + +;lfrinteger (r,x)==["integer",CONCAT (r,CONCAT('"r",x))] + +(DEFUN |lfrinteger| (|r| |x|) + (PROG () (RETURN (LIST '|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)] + +(DEFUN |lffloat| (|a| |w| |e|) + (PROG () (RETURN (LIST '|float| (CONCAT |a| "." |w| "e" |e|))))) + +;lfstring x==if #x=1 then ["char",x] else ["string",x] + +(DEFUN |lfstring| (|x|) + (PROG () + (RETURN + (COND + ((EQL (LENGTH |x|) 1) (LIST '|char| |x|)) + ('T (LIST '|string| |x|)))))) + +;lfcomment x== ["comment", x] + +(DEFUN |lfcomment| (|x|) (PROG () (RETURN (LIST '|comment| |x|)))) + +;lfnegcomment x== ["negcomment", x] + +(DEFUN |lfnegcomment| (|x|) + (PROG () (RETURN (LIST '|negcomment| |x|)))) + +;lferror x==["error",x] + +(DEFUN |lferror| (|x|) (PROG () (RETURN (LIST '|error| |x|)))) + +;lfspaces x==["spaces",x] + +(DEFUN |lfspaces| (|x|) (PROG () (RETURN (LIST '|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 + +(DEFUN |constoken| (|ln| |lp| |b| |n|) + (PROG (|a|) + (RETURN + (PROGN + (SETQ |a| (CONS (ELT |b| 0) (ELT |b| 1))) + (|ncPutQ| |a| '|posn| (CONS |lp| |n|)) + |a|)))) + +;scanEscape()== +; $n:=$n+1 +; a:=scanEsc() +; if a then scanWord true else nil + +(DEFUN |scanEscape| () + (PROG (|a|) + (DECLARE (SPECIAL |$n|)) + (RETURN + (PROGN + (SETQ |$n| (+ |$n| 1)) + (SETQ |a| (|scanEsc|)) + (COND (|a| (|scanWord| T)) ('T 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 + +(DEFUN |scanEsc| () + (PROG (|n1|) + (DECLARE (SPECIAL |$ln| |$r| |$sz| |$n|)) + (RETURN + (COND + ((NOT (< |$n| |$sz|)) + (COND + ((|nextline| |$r|) + ((LAMBDA () + (LOOP + (COND (|$n| (RETURN NIL)) ('T (|nextline| |$r|)))))) + (|scanEsc|) NIL) + ('T NIL))) + ('T (SETQ |n1| (STRPOSL " " |$ln| |$n| T)) + (COND + ((NULL |n1|) + (COND + ((|nextline| |$r|) + ((LAMBDA () + (LOOP + (COND (|$n| (RETURN NIL)) ('T (|nextline| |$r|)))))) + (|scanEsc|) NIL) + ('T NIL))) + ((EQUAL |$n| |n1|) T) + ((EQUAL (QENUM |$ln| |n1|) ESCAPE) (SETQ |$n| (+ |n1| 1)) + (|scanEsc|) NIL) + ('T (SETQ |$n| |n1|) + (COND + ((OR (|startsNegComment?|) (|startsComment?|)) + (PROGN (|nextline| |$r|) (|scanEsc|) NIL)) + ('T NIL))))))))) + +;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 + +(DEFUN |startsComment?| () + (PROG (|www|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (COND + ((< |$n| |$sz|) + (COND + ((EQUAL (QENUM |$ln| |$n|) PLUSCOMMENT) + (SETQ |www| (+ |$n| 1)) + (COND + ((NOT (< |www| |$sz|)) NIL) + ('T (EQUAL (QENUM |$ln| |www|) PLUSCOMMENT)))) + ('T NIL))) + ('T NIL))))) + +;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 + +(DEFUN |startsNegComment?| () + (PROG (|www|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (COND + ((< |$n| |$sz|) + (COND + ((EQUAL (QENUM |$ln| |$n|) MINUSCOMMENT) + (SETQ |www| (+ |$n| 1)) + (COND + ((NOT (< |www| |$sz|)) NIL) + ('T (EQUAL (QENUM |$ln| |www|) MINUSCOMMENT)))) + ('T NIL))) + ('T NIL))))) + +;scanNegComment()== +; n:=$n +; $n:=$sz +; lfnegcomment SUBSTRING($ln,n,nil) + +(DEFUN |scanNegComment| () + (PROG (|n|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (PROGN + (SETQ |n| |$n|) + (SETQ |$n| |$sz|) + (|lfnegcomment| (SUBSTRING |$ln| |n| NIL)))))) + +;scanComment()== +; n:=$n +; $n:=$sz +; lfcomment SUBSTRING($ln,n,nil) + +(DEFUN |scanComment| () + (PROG (|n|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (PROGN + (SETQ |n| |$n|) + (SETQ |$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 + +(DEFUN |scanPunct| () + (PROG (|a| |sss|) + (DECLARE (SPECIAL |$n| |$ln|)) + (RETURN + (PROGN + (SETQ |sss| (|subMatch| |$ln| |$n|)) + (SETQ |a| (LENGTH |sss|)) + (COND + ((EQL |a| 0) (|scanError|)) + ('T (SETQ |$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 + +(DEFUN |scanKeyTr| (|w|) + (PROG () + (DECLARE (SPECIAL |$floatok|)) + (RETURN + (COND + ((EQ (|keyword| |w|) 'DOT) + (COND (|$floatok| (|scanPossFloat| |w|)) ('T (|lfkey| |w|)))) + ('T (SETQ |$floatok| (NULL (|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) + +(DEFUN |scanPossFloat| (|w|) + (PROG () + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (COND + ((OR (NOT (< |$n| |$sz|)) (NULL (|digit?| (ELT |$ln| |$n|)))) + (|lfkey| |w|)) + ('T (SETQ |w| (|spleI| #'|digit?|)) (|scanExponent| "0" |w|)))))) + +;scanCloser:=[")","}","]","|)","|}","|]"] + +(EVAL-WHEN (EVAL LOAD) + (SETQ |scanCloser| (LIST '|)| '} '] '|\|)| '|\|}| '|\|]|))) + +;scanCloser? w== MEMQ(keyword w,scanCloser) + +(DEFUN |scanCloser?| (|w|) + (PROG () (RETURN (MEMQ (|keyword| |w|) |scanCloser|)))) + +;scanSpace()== +; n:=$n +; $n:=STRPOSL('" ",$ln,$n,true) +; if null $n then $n:=# $ln +; $floatok:=true +; lfspaces ($n-n) + +(DEFUN |scanSpace| () + (PROG (|n|) + (DECLARE (SPECIAL |$floatok| |$ln| |$n|)) + (RETURN + (PROGN + (SETQ |n| |$n|) + (SETQ |$n| (STRPOSL " " |$ln| |$n| T)) + (COND ((NULL |$n|) (SETQ |$n| (LENGTH |$ln|)))) + (SETQ |$floatok| T) + (|lfspaces| (- |$n| |n|)))))) + +;scanString()== +; $n:=$n+1 +; $floatok:=false +; lfstring scanS () + +(DEFUN |scanString| () + (PROG () + (DECLARE (SPECIAL |$floatok| |$n|)) + (RETURN + (PROGN + (SETQ |$n| (+ |$n| 1)) + (SETQ |$floatok| NIL) + (|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) + +(DEFUN |scanS| () + (PROG (|b| |a| |str| |mn| |escsym| |strsym| |n|) + (DECLARE (SPECIAL |$ln| |$linepos| |$sz| |$n|)) + (RETURN + (COND + ((NOT (< |$n| |$sz|)) + (|ncSoftError| + (CONS |$linepos| (+ (|lnExtraBlanks| |$linepos|) |$n|)) + 'S2CN0001 NIL) + "") + ('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|) + (|ncSoftError| + (CONS |$linepos| (+ (|lnExtraBlanks| |$linepos|) |$n|)) + 'S2CN0001 NIL) + (SUBSTRING |$ln| |n| NIL)) + ((EQUAL |mn| |strsym|) (SETQ |$n| (+ |mn| 1)) + (SUBSTRING |$ln| |n| (- |mn| |n|))) + ('T (SETQ |str| (SUBSTRING |$ln| |n| (- |mn| |n|))) + (SETQ |$n| (+ |mn| 1)) (SETQ |a| (|scanEsc|)) + (SETQ |b| + (COND + (|a| (SETQ |str| + (CONCAT |str| + (|scanTransform| + (ELT |$ln| |$n|)))) + (SETQ |$n| (+ |$n| 1)) (|scanS|)) + ('T (|scanS|)))) + (CONCAT |str| |b|)))))))) + +;scanTransform x==x + +(DEFUN |scanTransform| (|x|) (PROG () (RETURN |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 + +(DEFUN |posend| (|line| |n|) + (PROG () + (RETURN + (PROGN + ((LAMBDA () + (LOOP + (COND + ((NOT (AND (< |n| (LENGTH |line|)) + (|idChar?| (ELT |line| |n|)))) + (RETURN NIL)) + ('T (SETQ |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 + +(DEFUN |digit?| (|x|) (PROG () (RETURN (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)] + +(DEFUN |scanW| (|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| (|posend| |$ln| |$n|)) + (COND + ((OR (EQUAL |endid| |l|) + (NOT (EQUAL (QENUM |$ln| |endid|) ESCAPE))) + (SETQ |$n| |endid|) + (LIST |b| (SUBSTRING |$ln| |n1| (- |endid| |n1|)))) + ('T (SETQ |str| (SUBSTRING |$ln| |n1| (- |endid| |n1|))) + (SETQ |$n| (+ |endid| 1)) (SETQ |a| (|scanEsc|)) + (SETQ |bb| + (COND + (|a| (|scanW| T)) + ((NOT (< |$n| |$sz|)) (LIST |b| "")) + ((|idChar?| (ELT |$ln| |$n|)) (|scanW| |b|)) + ('T (LIST |b| "")))) + (LIST (OR (ELT |bb| 0) |b|) (CONCAT |str| (ELT |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 + +(DEFUN |scanWord| (|esp|) + (PROG (|w| |aaa|) + (DECLARE (SPECIAL |$floatok|)) + (RETURN + (PROGN + (SETQ |aaa| (|scanW| NIL)) + (SETQ |w| (ELT |aaa| 1)) + (SETQ |$floatok| NIL) + (COND + ((OR |esp| (ELT |aaa| 0)) (|lfid| |w|)) + ((|keyword?| |w|) (SETQ |$floatok| T) (|lfkey| |w|)) + ('T (|lfid| |w|))))))) + +;spleI(dig)==spleI1(dig,false) + +(DEFUN |spleI| (|dig|) (PROG () (RETURN (|spleI1| |dig| NIL)))) + +;spleI1(dig,zro) == +; n:=$n +; l:= $sz +; while $n=r +; then ncSoftError(cons($linepos,lnExtraBlanks $linepos+$n-ns+i), +; "S2CN0002", [w.i]) + +(DEFUN |scanCheckRadix| (|r| |w|) + (PROG (|a| |done| |ns|) + (DECLARE (SPECIAL |$n| |$linepos|)) + (RETURN + (PROGN + (SETQ |ns| (LENGTH |w|)) + (SETQ |done| NIL) + ((LAMBDA (|bfVar#1| |i|) + (LOOP + (COND + ((> |i| |bfVar#1|) (RETURN NIL)) + ('T + (PROGN + (SETQ |a| (|rdigit?| (ELT |w| |i|))) + (COND + ((OR (NULL |a|) (NOT (< |a| |r|))) + (|ncSoftError| + (CONS |$linepos| + (+ (- (+ (|lnExtraBlanks| |$linepos|) + |$n|) + |ns|) + |i|)) + 'S2CN0002 (LIST (ELT |w| |i|)))))))) + (SETQ |i| (+ |i| 1)))) + (- |ns| 1) 0))))) + +;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) + +(DEFUN |scanNumber| () + (PROG (|v| |w| |n| |a|) + (DECLARE (SPECIAL |$floatok| |$ln| |$sz| |$n|)) + (RETURN + (PROGN + (SETQ |a| (|spleI| #'|digit?|)) + (COND + ((NOT (< |$n| |$sz|)) (|lfinteger| |a|)) + ((NOT (EQUAL (QENUM |$ln| |$n|) RADIXCHAR)) + (COND + ((AND |$floatok| (EQUAL (QENUM |$ln| |$n|) DOT)) + (SETQ |n| |$n|) (SETQ |$n| (+ |$n| 1)) + (COND + ((AND (< |$n| |$sz|) (EQUAL (QENUM |$ln| |$n|) DOT)) + (SETQ |$n| |n|) (|lfinteger| |a|)) + ('T (SETQ |w| (|spleI1| #'|digit?| T)) + (|scanExponent| |a| |w|)))) + ('T (|lfinteger| |a|)))) + ('T (SETQ |$n| (+ |$n| 1)) + (SETQ |w| (|spleI1| #'|rdigit?| T)) + (|scanCheckRadix| (PARSE-INTEGER |a|) |w|) + (COND + ((NOT (< |$n| |$sz|)) (|lfrinteger| |a| |w|)) + ((EQUAL (QENUM |$ln| |$n|) DOT) (SETQ |n| |$n|) + (SETQ |$n| (+ |$n| 1)) + (COND + ((AND (< |$n| |$sz|) (EQUAL (QENUM |$ln| |$n|) DOT)) + (SETQ |$n| |n|) (|lfrinteger| |a| |w|)) + ('T (SETQ |v| (|spleI1| #'|rdigit?| T)) + (|scanCheckRadix| (PARSE-INTEGER |a|) |v|) + (|scanExponent| (CONCAT |a| "r" |w|) |v|)))) + ('T (|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") + +(DEFUN |scanExponent| (|a| |w|) + (PROG (|c1| |e| |c| |n|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (COND + ((NOT (< |$n| |$sz|)) (|lffloat| |a| |w| "0")) + ('T (SETQ |n| |$n|) (SETQ |c| (QENUM |$ln| |$n|)) + (COND + ((OR (EQUAL |c| EXPONENT1) (EQUAL |c| EXPONENT2)) + (SETQ |$n| (+ |$n| 1)) + (COND + ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|) + (|lffloat| |a| |w| "0")) + ((|digit?| (ELT |$ln| |$n|)) + (SETQ |e| (|spleI| #'|digit?|)) (|lffloat| |a| |w| |e|)) + ('T (SETQ |c1| (QENUM |$ln| |$n|)) + (COND + ((OR (EQUAL |c1| PLUSCOMMENT) + (EQUAL |c1| MINUSCOMMENT)) + (SETQ |$n| (+ |$n| 1)) + (COND + ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|) + (|lffloat| |a| |w| "0")) + ((|digit?| (ELT |$ln| |$n|)) + (SETQ |e| (|spleI| #'|digit?|)) + (|lffloat| |a| |w| + (COND + ((EQUAL |c1| MINUSCOMMENT) (CONCAT "-" |e|)) + ('T |e|)))) + ('T (SETQ |$n| |n|) (|lffloat| |a| |w| "0")))))))) + ('T (|lffloat| |a| |w| "0")))))))) + +;rdigit? x== +; STRPOS(x,'"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",0,nil) + +(DEFUN |rdigit?| (|x|) + (PROG () + (RETURN (STRPOS |x| "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" 0 NIL)))) + +;scanError()== +; n:=$n +; $n:=$n+1 +; ncSoftError(cons($linepos,lnExtraBlanks $linepos+$n), +; "S2CN0003",[$ln.n]) +; lferror ($ln.n) + +(DEFUN |scanError| () + (PROG (|n|) + (DECLARE (SPECIAL |$ln| |$linepos| |$n|)) + (RETURN + (PROGN + (SETQ |n| |$n|) + (SETQ |$n| (+ |$n| 1)) + (|ncSoftError| + (CONS |$linepos| (+ (|lnExtraBlanks| |$linepos|) |$n|)) + 'S2CN0003 (LIST (ELT |$ln| |n|))) + (|lferror| (ELT |$ln| |n|)))))) + +;keyword st == HGET(scanKeyTable,st) + +(DEFUN |keyword| (|st|) (PROG () (RETURN (HGET |scanKeyTable| |st|)))) + +;keyword? st == not null HGET(scanKeyTable,st) + +(DEFUN |keyword?| (|st|) + (PROG () (RETURN (NULL (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 + +(DEFUN |scanInsert| (|s| |d|) + (PROG (|v| |k| |n| |u| |h| |l|) + (RETURN + (PROGN + (SETQ |l| (LENGTH |s|)) + (SETQ |h| (QENUM |s| 0)) + (SETQ |u| (ELT |d| |h|)) + (SETQ |n| (LENGTH |u|)) + (SETQ |k| 0) + ((LAMBDA () + (LOOP + (COND + ((< (LENGTH (ELT |u| |k|)) |l|) (RETURN NIL)) + ('T (SETQ |k| (+ |k| 1))))))) + (SETQ |v| (MAKE-VEC (+ |n| 1))) + ((LAMBDA (|bfVar#2| |i|) + (LOOP + (COND + ((> |i| |bfVar#2|) (RETURN NIL)) + ('T (VEC-SETELT |v| |i| (ELT |u| |i|)))) + (SETQ |i| (+ |i| 1)))) + (- |k| 1) 0) + (VEC-SETELT |v| |k| |s|) + ((LAMBDA (|bfVar#3| |i|) + (LOOP + (COND + ((> |i| |bfVar#3|) (RETURN NIL)) + ('T (VEC-SETELT |v| (+ |i| 1) (ELT |u| |i|)))) + (SETQ |i| (+ |i| 1)))) + (- |n| 1) |k|) + (VEC-SETELT |d| |h| |v|) + |s|)))) + +;subMatch(l,i)==substringMatch(l,scanDict,i) + +(DEFUN |subMatch| (|l| |i|) + (PROG () (RETURN (|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 + +(DEFUN |substringMatch| (|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#4| |j|) + (LOOP + (COND + ((OR (> |j| |bfVar#4|) |done|) (RETURN NIL)) + ('T + (PROGN + (SETQ |s| (ELT |u| |j|)) + (SETQ |ls| (SIZE |s|)) + (SETQ |done| + (COND + ((< |ll| (+ |ls| |i|)) NIL) + ('T (SETQ |eql| T) + ((LAMBDA (|bfVar#5| |k|) + (LOOP + (COND + ((OR (> |k| |bfVar#5|) (NOT |eql|)) + (RETURN NIL)) + ('T + (SETQ |eql| + (EQL (QENUM |s| |k|) + (QENUM |l| (+ |k| |i|)))))) + (SETQ |k| (+ |k| 1)))) + (- |ls| 1) 1) + (COND (|eql| (SETQ |s1| |s|) T) ('T NIL)))))))) + (SETQ |j| (+ |j| 1)))) + (- (SIZE |u|) 1) 0) + |s1|)))) + +;scanKeyTableCons()== +; KeyTable:=MAKE_-HASHTABLE("CVEC",true) +; for st in scanKeyWords repeat +; HPUT(KeyTable,CAR st,CADR st) +; KeyTable + +(DEFUN |scanKeyTableCons| () + (PROG (|KeyTable|) + (RETURN + (PROGN + (SETQ |KeyTable| (MAKE-HASHTABLE 'CVEC T)) + ((LAMBDA (|bfVar#6| |st|) + (LOOP + (COND + ((OR (ATOM |bfVar#6|) + (PROGN (SETQ |st| (CAR |bfVar#6|)) NIL)) + (RETURN NIL)) + ('T (HPUT |KeyTable| (CAR |st|) (CADR |st|)))) + (SETQ |bfVar#6| (CDR |bfVar#6|)))) + |scanKeyWords| NIL) + |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 + +(DEFUN |scanDictCons| () + (PROG (|d| |b| |a| |l|) + (RETURN + (PROGN + (SETQ |l| (HKEYS |scanKeyTable|)) + (SETQ |d| + (PROGN + (SETQ |a| (MAKE-VEC 256)) + (SETQ |b| (MAKE-VEC 1)) + (VEC-SETELT |b| 0 (MAKE-CVEC 0)) + ((LAMBDA (|i|) + (LOOP + (COND + ((> |i| 255) (RETURN NIL)) + ('T (VEC-SETELT |a| |i| |b|))) + (SETQ |i| (+ |i| 1)))) + 0) + |a|)) + ((LAMBDA (|bfVar#7| |s|) + (LOOP + (COND + ((OR (ATOM |bfVar#7|) + (PROGN (SETQ |s| (CAR |bfVar#7|)) NIL)) + (RETURN NIL)) + ('T (|scanInsert| |s| |d|))) + (SETQ |bfVar#7| (CDR |bfVar#7|)))) + |l| NIL) + |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 + +(DEFUN |scanPunCons| () + (PROG (|a| |listing|) + (RETURN + (PROGN + (SETQ |listing| (HKEYS |scanKeyTable|)) + (SETQ |a| (MAKE-BVEC 256)) + ((LAMBDA (|i|) + (LOOP + (COND + ((> |i| 255) (RETURN NIL)) + ('T (BVEC-SETELT |a| |i| 0))) + (SETQ |i| (+ |i| 1)))) + 0) + ((LAMBDA (|bfVar#8| |k|) + (LOOP + (COND + ((OR (ATOM |bfVar#8|) + (PROGN (SETQ |k| (CAR |bfVar#8|)) NIL)) + (RETURN NIL)) + ('T + (COND + ((NULL (|startsId?| (ELT |k| 0))) + (BVEC-SETELT |a| (QENUM |k| 0) 1))))) + (SETQ |bfVar#8| (CDR |bfVar#8|)))) + |listing| NIL) + |a|)))) + +;punctuation? c== scanPun.c=1 + +(DEFUN |punctuation?| (|c|) + (PROG () (RETURN (EQL (ELT |scanPun| |c|) 1)))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}