1 (defpackage #:cl-nl.lexer
5 (in-package #:cl-nl.lexer)
7 ; I played around with using #'read for netlogo code, which would have been neat.
8 ; However, it provides too many instances where people could inject CL code
9 ; and I wanted to prevent that. In the end, writing my own lexer became kind of fun.
11 (defvar *state* :initial)
12 (defvar *states* :extension-literal)
13 (defparameter *lexes* nil)
15 (defun as-symbol (text) (intern (string-upcase text) :keyword))
17 (defmacro deflex (state match &optional func)
21 ((,scanner (when (stringp ,match) (cl-ppcre:create-scanner ,match))))
28 (and (symbolp text) (eql text ,match))
31 (multiple-value-bind (start end) (cl-ppcre:scan ,scanner text)
32 (and start end (= 0 start) (/= 0 end)))))))
33 (lambda (text) (second (multiple-value-list (cl-ppcre:scan ,scanner text))))
34 ,(or func #'as-symbol))
40 ((lex (find-if (lambda (f) (funcall f *state* :eof)) *lexes* :key #'car)))
41 (when lex (list (funcall (third lex) :eof))))
43 ((lex (find-if (lambda (f) (funcall f *state* text)) *lexes* :key #'car)))
44 (when (not lex) (error "Can't lex this: ~S" text))
46 ((val (funcall (third lex) (subseq text 0 (funcall (cadr lex) text)))))
48 (cons val (lex (subseq text (funcall (cadr lex) text))))
49 (lex (subseq text (funcall (cadr lex) text))))))))
51 (defun set-state (new-state)
52 (setf *state* new-state))
54 ; This part is the actual netlogo spec
56 (defvar *string-text* "(\\\"|\\r|\\n|\\t|\\\\|\\[^\"]|[^\r\n\"\\])*")
57 (defvar *nonnewline_white_space_char* "[ \\t\\b\\012]")
58 (defvar *letter* "\\w")
59 (defvar *digit* "\\d")
60 ;(defparameter *identifier-char* "[\\w\\d_\\.?=\*!<>:#\+/%\$\^\'&-]")
61 (defvar *identifier-char* "[\\w\\d]")
63 ;(defvar *extension-literal-depth* 0)
64 ;(defstruct extension-literal text)
66 ;(deflex :initial "{{"
68 ; (set-state :extension-literal)
72 ;(deflex :extension-literal "}}"
74 ; (if (= 0 *extension-literal-depth*)
75 ; (progn (set-state :initial) text)
76 ; (progn (decf *extension-literal-depth*) (as-symbol text)))))
78 ;(deflex :extension-literal "{{"
79 ; (lambda (text) (incf *extension-literal-depth*) text))
81 ;(deflex :extension-literal "\n|\r" (lambda () (error "End of line reached unexpectedly")))
82 ;(deflex :extension-literal :eof (lambda () (error "end of file reached unexpectedly")))
83 ;(deflex :extension-literal ".")
85 (deflex :initial "[,\\{\\}\\[\\]\\(\\)]" #'as-symbol)
86 (deflex :initial *nonnewline_white_space_char* (constantly nil))
87 (deflex :initial "\\n|\\r" (constantly nil))
88 ;(deflex :initial ";.*[\n\r]?" nil)
89 ;(deflex :initial (format nil "-?\.?[0-9]~A" *identifier-char*)
94 ; ((*readtable* (copy-readtable nil))
96 ; (read-from-string text))))
97 ; (if (numberp num?) num? (error "Invalid number")))))
99 (deflex :initial (format nil "~A*" *identifier-char*) #'as-symbol)
100 ;(deflex :initial (format nil "\"~A*\"" *string-text*))
101 ;(deflex :initial (format nil "\"~A*" *string-text*) (lambda (text) (error "Closing double quote is missing")))
102 ;(deflex :initial "." (lambda (text) (error "Non standard character is not allowed")))