X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;f=src%2Fmain%2Flex.lisp;h=b0ef2f1d1a591c8b6940093e09c83e52120fcdc5;hb=471de83db1aee70065808cbc061867e3320bf4b7;hp=93343e66e6afc7a730832128ccabd46f24ae775e;hpb=1ae8c7a0199a4955708c7f5d7a286a12782b5fd2;p=clnl diff --git a/src/main/lex.lisp b/src/main/lex.lisp index 93343e6..b0ef2f1 100644 --- a/src/main/lex.lisp +++ b/src/main/lex.lisp @@ -1,4 +1,4 @@ -(in-package #:cl-nl.lexer) +(in-package #:clnl-lexer) ; I played around with using #'read for netlogo code, which would have been neat. ; However, it provides too many instances where people could inject CL code @@ -13,36 +13,37 @@ (defmacro deflex (state match &optional func) (let ((scanner (gensym))) - `(let - ((,scanner (when (stringp ,match) (cl-ppcre:create-scanner ,match)))) - (pushnew - (list - (lambda (state text) - (and - (eql ,state state) - (or - (and (symbolp text) (eql text ,match)) - (and ,scanner - (stringp text) - (multiple-value-bind (start end) (cl-ppcre:scan ,scanner text) - (and start end (= 0 start) (/= 0 end))))))) - (lambda (text) (second (multiple-value-list (cl-ppcre:scan ,scanner text)))) - ,(or func #'as-symbol)) - *lexes*)))) + `(let + ((,scanner (when (stringp ,match) (cl-ppcre:create-scanner ,match)))) + (pushnew + (list + (lambda (state text) + (and + (eql ,state state) + (or + (and (symbolp text) (eql text ,match)) + (and + ,scanner + (stringp text) + (multiple-value-bind (start end) (cl-ppcre:scan ,scanner text) + (and start end (= 0 start) (/= 0 end))))))) + (lambda (text) (second (multiple-value-list (cl-ppcre:scan ,scanner text)))) + ,(or func #'as-symbol)) + *lexes*)))) (defun lex (text) (if (string= "" text) - (let - ((lex (find-if (lambda (f) (funcall f *state* :eof)) *lexes* :key #'car))) - (when lex (list (funcall (third lex) :eof)))) - (let - ((lex (find-if (lambda (f) (funcall f *state* text)) *lexes* :key #'car))) - (when (not lex) (error "Can't lex this: ~S" text)) - (let - ((val (funcall (third lex) (subseq text 0 (funcall (cadr lex) text))))) - (if val - (cons val (lex (subseq text (funcall (cadr lex) text)))) - (lex (subseq text (funcall (cadr lex) text)))))))) + (let + ((lex (find-if (lambda (f) (funcall f *state* :eof)) *lexes* :from-end t :key #'car))) + (when lex (list (funcall (third lex) :eof)))) + (let + ((lex (find-if (lambda (f) (funcall f *state* text)) *lexes* :from-end t :key #'car))) + (when (not lex) (error "Can't lex this: ~S" text)) + (let + ((val (funcall (third lex) (subseq text 0 (funcall (cadr lex) text))))) + (if val + (cons val (lex (subseq text (funcall (cadr lex) text)))) + (lex (subseq text (funcall (cadr lex) text)))))))) (defun set-state (new-state) (setf *state* new-state)) @@ -54,7 +55,7 @@ (defvar *letter* "\\w") (defvar *digit* "\\d") ;(defparameter *identifier-char* "[\\w\\d_\\.?=\*!<>:#\+/%\$\^\'&-]") -(defvar *identifier-char* "[\\w\\d]") +(defvar *identifier-char* "[\\w\\d-.]") ;(defvar *extension-literal-depth* 0) ;(defstruct extension-literal text)