diff options
Diffstat (limited to 'src/interp/bootlex.lisp')
| -rw-r--r-- | src/interp/bootlex.lisp | 111 |
1 files changed, 7 insertions, 104 deletions
diff --git a/src/interp/bootlex.lisp b/src/interp/bootlex.lisp index 328aced3..e932ede3 100644 --- a/src/interp/bootlex.lisp +++ b/src/interp/bootlex.lisp @@ -160,44 +160,19 @@ If you have a . followed by an integer, get a floating point number. Otherwise, get a .. identifier." - (if (not (boot-skip-blanks)) + (if (not (|skipBlankChars|)) nil - (let ((token-type (boot-token-lookahead-type (|currentChar|)))) + (let ((token-type (|tokenLookaheadType| (|currentChar|)))) (case token-type (eof (|tokenInstall| nil '*eof token |$nonblank|)) (escape (|advanceChar!|) - (get-boot-identifier-token token t)) + (|getIdentifier| token t)) (argument-designator (get-argument-designator-token token)) - (id (get-boot-identifier-token token)) + (id (|getIdentifier| token nil)) (num (get-spad-integer-token token)) - (string (get-SPADSTRING-token token)) - (special-char (get-special-token token)) - (t (get-gliph-token token token-type)))))) - -(defun boot-skip-blanks () - (setq |$nonblank| t) - (loop (let ((cc (|currentChar|))) - (if (not cc) (return nil)) - (if (eq (boot-token-lookahead-type cc) 'white) - (progn (setq |$nonblank| nil) (if (not (|advanceChar!|)) (return nil))) - (return t))))) - -(defun boot-token-lookahead-type (char) - "Predicts the kind of token to follow, based on the given initial character." - (cond ((not char) 'eof) - ((char= char #\_) 'escape) - ((and (char= char #\#) (digitp (|nextChar|))) 'argument-designator) - ((digitp char) 'num) - ((and (char= char #\$) $boot - (alpha-char-p (|nextChar|))) 'id) - ((or (char= char #\%) (char= char #\?) - (char= char #\!) (alpha-char-p char)) 'id) - ((char= char #\") 'string) - ((member char - '(#\Space #\Tab #\Return) - :test #'char=) 'white) - ((get (intern (string char)) 'Gliph)) - (t 'special-char))) + (string (|getSpadString| token)) + (special-char (|getSpecial| token)) + (t (|getGliph| token token-type)))))) (defun get-argument-designator-token (token) (|advanceChar!|) @@ -206,78 +181,6 @@ Otherwise, get a .. identifier." 'argument-designator token |$nonblank|)) -(defun get-boot-identifier-token (token &optional (escaped? nil)) - "An identifier consists of an escape followed by any character, a %, ?, -or an alphabetic, followed by any number of escaped characters, digits, -or the chracters ?, !, ' or %" - (prog ((buf (make-adjustable-string 0)) - (default-package NIL)) - (suffix (|currentChar|) buf) - (|advanceChar!|) - id (let ((cur-char (|currentChar|))) - (cond ((char= cur-char #\_) - (if (not (|advanceChar!|)) (go bye)) - (suffix (|currentChar|) buf) - (setq escaped? t) - (if (not (|advanceChar!|)) (go bye)) - (go id)) - ((and (null default-package) - (char= cur-char #\')) - (setq default-package buf) - (setq buf (make-adjustable-string 0)) - (if (not (|advanceChar!|)) (go bye)) - (go id)) - ((or (alpha-char-p cur-char) - (digitp cur-char) - (member cur-char '(#\% #\' #\? #\!) :test #'char=)) - (suffix (|currentChar|) buf) - (if (not (|advanceChar!|)) (go bye)) - (go id)))) - bye (if (and (stringp default-package) - (or (not (find-package default-package)) ;; not a package name - (every #'(lambda (x) (eql x #\')) buf))) ;;token ends with '' - (setq buf (concatenate 'string default-package "'" buf) - default-package nil)) - (setq buf (intern buf (or default-package "BOOT"))) - (return (|tokenInstall| - buf - (if (and (not escaped?) - (member buf |Keywords| :test #'eq)) - 'keyword 'identifier) - token - |$nonblank|)))) - -(defun get-gliph-token (token gliph-list) - (prog ((buf (make-adjustable-string 0))) - (suffix (|currentChar|) buf) - (|advanceChar!|) - loop (setq gliph-list (assoc (intern (string (|currentChar|))) gliph-list)) - (if gliph-list - (progn (suffix (|currentChar|) buf) - (pop gliph-list) - (|advanceChar!|) - (go loop)) - (let ((new-token (intern buf))) - (return (|tokenInstall| (or (get new-token 'renametok) new-token) - 'gliph token |$nonblank|)))))) - -(defun get-SPADSTRING-token (token) - "With TOK=\" and ABC\" on IN-STREAM, extracts and stacks string ABC" - (PROG ((BUF (make-adjustable-string 0))) - (if (char/= (|currentChar|) #\") (RETURN NIL) (|advanceChar!|)) - (loop - (if (char= (|currentChar|) #\") (return nil)) - (SUFFIX (if (char= (|currentChar|) #\_) - (|advanceChar!|) - (|currentChar|)) - BUF) - (if (null (|advanceChar!|)) ;;end of line - (PROGN (|sayBrightly| "Close quote inserted") (RETURN nil))) - ) - (|advanceChar!|) - (return (|tokenInstall| (copy-seq buf) ;should make a simple string - 'spadstring token)))) - ;; -*- Parse an integer number -*- ;; The number may be written in plain format, where the radix ;; is implicitly taken to be 10. Or the spelling can explicitly |