; 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
; 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
- `(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*))))
+ "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."
- (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))))))))
(deflex :initial *nonnewline_white_space_char* (constantly nil))
(deflex :initial "\\n|\\r" (constantly nil))
;(deflex :initial ";.*[\n\r]?" nil)
(deflex :initial *nonnewline_white_space_char* (constantly nil))
(deflex :initial "\\n|\\r" (constantly nil))
;(deflex :initial ";.*[\n\r]?" nil)
-;(deflex :initial (format nil "-?\.?[0-9]~A" *identifier-char*)
-; (lambda (text)
-; (let
-; ((num?
-; (let
-; ((*readtable* (copy-readtable nil))
-; (*read-eval* nil))
-; (read-from-string text))))
-; (if (numberp num?) num? (error "Invalid number")))))
+(deflex :initial (format nil "-?\.?[0-9]~A*" *identifier-char*)
+ (lambda (text)
+ (let
+ ((num?
+ (let
+ ((*readtable* (copy-readtable nil))
+ (*read-eval* nil))
+ (read-from-string text))))
+ (if (numberp num?) num? (error "Invalid number")))))
(deflex :initial (format nil "~A*" *identifier-char*) #'as-symbol)
;(deflex :initial (format nil "\"~A*\"" *string-text*))
(deflex :initial (format nil "~A*" *identifier-char*) #'as-symbol)
;(deflex :initial (format nil "\"~A*\"" *string-text*))