diff options
author | dos-reis <gdr@axiomatics.org> | 2011-10-07 19:48:11 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-10-07 19:48:11 +0000 |
commit | 16e12e0c3d18a3eb41425be40275236c6df37c40 (patch) | |
tree | 82d380fb5e2e6d0d48f3b918d5aaafa20115f3f9 /src/interp/lexing.boot | |
parent | da334a99fa9e66215133f4cf5fe87a3b78d7084e (diff) | |
download | open-axiom-16e12e0c3d18a3eb41425be40275236c6df37c40.tar.gz |
* interp/lexing.boot: Include sys-macros.
Add more tokenizer functions.
* interp/fnewmeta.lisp: Use them.
* interp/parsing.lisp: Likewise.
* interp/bootlex.lisp: Likewise.
* interp/spad.lisp: Likewise.
(NEXT-BOOT-LINE): Remove.
* interp/metalex.lisp: Remove old lexing routines.
* interp/Makefile.in (lexing.$(FASLEXT)): Adjust dependency.
* boot/tokens.boot: newString is no longer builtin library function.
(shoeDictCons): Use makeString not newString.
* lisp/core.lisp.in (listToString): Fix typo.
Diffstat (limited to 'src/interp/lexing.boot')
-rw-r--r-- | src/interp/lexing.boot | 161 |
1 files changed, 161 insertions, 0 deletions
diff --git a/src/interp/lexing.boot b/src/interp/lexing.boot index f0378625..a9a161c0 100644 --- a/src/interp/lexing.boot +++ b/src/interp/lexing.boot @@ -35,12 +35,112 @@ --% import sys_-utility +import sys_-macros namespace BOOT module lexing --% +--% Line abstract datatype +--% structure Line == +--% Record(buffer: String, curChar: Character, +--% curIdx: SingleInteger, lstIdx: SingleInteger, lineNo: SingleInteger) +--% +makeLine(buf == makeString 0, ch == charByName "Return", + curIdx == 1, lstIdx == 0, no == 0) == + [buf,ch,curIdx,lstIdx,no] + +macro lineBuffer l == + first l + +macro lineCurrentChar l == + second l + +macro lineCurrentIndex l == + third l + +macro lineLastIndex l == + fourth l + +macro lineNumber l == + fifth l + +lineClear! l == + lineBuffer(l) := makeString 0 + lineCurrentChar(l) := charByName "Return" + lineCurrentIndex(l) := 1 + lineLastIndex(l) := 0 + lineNumber(l) := 0 + +++ Sets string to be the next line stored in line +lineNewLine!(s,l,no == nil) == + sz := #s + lineLastIndex(l) := sz - 1 + lineCurrentIndex(l) := 0 + lineCurrentChar(l) := sz > 0 and s.0 or charByName '"Return" + lineBuffer(l) := s + lineNumber(l) := no or (lineNumber l + 1) + +++ Tests if line is empty or positioned past the last character +lineAtEnd? l == + lineCurrentIndex l >= lineLastIndex l + +++ Tests if line is empty or positioned past the last character +linePastEnd? l == + lineCurrentIndex l > lineLastIndex l + +++ Buffer from current index to last index +lineCurrentSegment l == + lineAtEnd? l => makeString 0 + subSequence(lineBuffer l,lineCurrentIndex l,lineLastIndex l) + +lineNextChar l == + lineBuffer(l).(1 + lineCurrentIndex l) + +lineAdvanceChar! l == + n := lineCurrentIndex l + 1 + lineCurrentIndex(l) := n + lineCurrentChar(l) := lineBuffer(l).n + +++ Current input line +$spadLine := makeLine() + +++ List of lines returned from PREPARSE +$lineStack := nil + +nextLine st == + $lineStack = nil => nil + [[n,:l],:$lineStack] := $lineStack + l := strconc(l,'" ") + lineNewLine!(l,$spadLine,n) + SETQ(LINE,l) + $currentLine := l + +++ Current input stream. +IN_-STREAM := 'T + +++ Advances IN-STREAM, invoking Next Line if necessary +advanceChar!() == + repeat + not lineAtEnd? $spadLine => return lineAdvanceChar! $spadLine + nextLine IN_-STREAM => return currentChar() + return nil + +--% + +++ Returns the current character of the line, initially blank for +++ an unread line +currentChar() == + linePastEnd? $spadLine => charByName "Return" + lineCurrentChar $spadLine + +nextChar() == + lineAtEnd? $spadLine => charByName '"Return" + lineNextChar $spadLine + + +--% --% Token abstract datatype. --% Operational semantics: --% structure Token == @@ -138,6 +238,67 @@ makeSymbolOf tok == currentSymbol() == makeSymbolOf currentToken() +tokenStackClear!() == + $validTokens := 0 + tokenInstall(nil,nil,$currentToken,nil) + tokenInstall(nil,nil,$nextToken,nil) + tokenInstall(nil,nil,$priorToken,nil) + +--% +Keywords == [ + "or", "and", "isnt", "is", "when", "where", "forall", "exist", "try", + "has", "with", "add", "case", "in", "by", "pretend", "mod", "finally", + "exquo", "div", "quo", "else", "rem", "then", "suchthat", "catch", "throw", + "if", "iterate", "break", "from", "exit", "leave", "return", + "not", "repeat", "until", "while", "for", "import", "inline" ] + +escapeKeywords(nm,id) == + symbolMember?(id,Keywords) => strconc('"__",nm) + nm + +underscore s == + n := #s - 1 + and/[alphabetic? stringChar(s,i) for i in 0..n] => s + buf := nil + for i in 0..n repeat + c := stringChar(s,i) + if not alphabetic? c then + buf := [char "__",:buf] + buf := [c,:buf] + listToString reverse! buf + +quoteIfString tok == + tok = nil => nil + tt := tokenType tok + tt is 'SPADSTRING => strconc('"_"",underscore tokenSymbol tok,'"_"") + tt is 'NUMBER => formatToString('"~v,'0D",tokenNonblank? tok,tokenSymbol tok) + tt is 'SPECIAL_-CHAR => charString tokenSymbol tok + tt is 'IDENTIFIER => + escapeKeywords(symbolName tokenSymbol tok,tokenSymbol tok) + tokenSymbol tok + +ungetTokens() == + $validTokens = 0 => true + $validTokens = 1 => + cursym := quoteIfString $currentToken + curline := lineCurrentSegment $spadLine + revisedline := strconc(cursym,curline,'" ") + lineNewLine!(revisedline,$spadLine,lineNumber $spadLine) + $nonblank := tokenNonblank? $currentToken + $validTokens := 0 + $validTokens = 2 => + cursym := quoteIfString $currentToken + nextsym := quoteIfString $nextToken + curline := lineCurrentSegment $spadLine + revisedline := strconc((tokenNonblank? $currentToken => '""; '" "), + cursym,(tokenNonblank? $nextToken => '""; '" "),nextsym,curline,'" ") + $nonblank := tokenNonblank? $currentToken + lineNewLine!(revisedline,$spadLine,lineNumber $spadLine) + $validTokens := 0 + coreError '"How many tokens do you think you have?" + + + --% --% Stack abstract datatype. --% Operational semantics: |