X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;f=src%2Fmain%2Flex.lisp;h=d39ab5922e1545134b3eaaa262c41179b0eb4cc2;hb=5c8699f151207953f4029e0fc6c488afce99f756;hp=93343e66e6afc7a730832128ccabd46f24ae775e;hpb=1ae8c7a0199a4955708c7f5d7a286a12782b5fd2;p=clnl diff --git a/src/main/lex.lisp b/src/main/lex.lisp index 93343e6..d39ab59 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,51 @@ (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) + "LEX TEXT => AST + +ARGUMENTS AND VALUES: + + TEXT: Some NetLogo code + AST: An ambigious AST that can later be parsed + +DESCRIPTION: + + LEX lexes NetLogo code. + + LEX checks for some things, in as much as it can without knowing anything + about some of the backgrounds of NetLogo. However, it does the first pass + with as much as it can." (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 +69,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)