1 (in-package #:cl-nl.parser)
3 ; Ok, after thinking about this a little, the parser is completely contextual
4 ; based on what has come before. We can't do a contextless parsing, like we
5 ; could in other languages, due to amiguity about reporters vs reporter tasks
7 ; So, for instance, we could have:
9 ; x + y => (x (task +) y)
10 ; So the definition of "+" is completely dependent on the nature of x
12 ; The goal of this parser should be to turn in the amiguous lexed ast representing
13 ; NetLogo into an unambigious S-expression, and nothing more, so things like
14 ; expectation of commands being the first symbol is not be necessary until later
16 ; In general, the parser will:
17 ; * Parse the structure of the lexed output first
18 ; * Parse the structure of the individual expressions (finding ('s and ['s and doing the right thing)
19 ; * Coalate things into an unambigious expressions
20 ; * Then we're done, let someone else make it evaluatable
21 ; - We don't really care if things are commands or reporters right now
23 (defparameter *prims* nil)
25 (defun prim-name (prim) (getf prim :name))
26 (defun prim-num-args (prim) (length (getf prim :args)))
27 (defun prim-args (prim) (getf prim :args))
29 (defun find-prim (symb) (find symb *prims* :key #'prim-name))
31 ; Make this only as complicated as it needs to be, letting it grow
32 ; as we take on more and more of the language
33 (defun parse (lexed-ast)
36 ((numberp (car lexed-ast)) (cons (coerce (car lexed-ast) 'double-float) (parse (cdr lexed-ast))))
37 ((eql :[ (car lexed-ast)) (parse-block (cdr lexed-ast)))
38 ((and (symbolp (car lexed-ast)) (find-prim (car lexed-ast)))
40 ((prim (find-prim (car lexed-ast)))
41 (num-args (prim-num-args prim))
42 (parsed-remainder (parse (cdr lexed-ast))))
49 (butlast parsed-remainder (- (length parsed-remainder) num-args))))
50 (nthcdr num-args parsed-remainder))))
51 (t (error "Couldn't parse ~S" lexed-ast))))
53 (defun help-arg (arg-type arg)
56 (if (not (and (consp arg) (eql 'block (car arg))))
57 (error "Required a block, but found a ~A" arg)
58 (cons :command-block (cdr arg))))
61 (defun parse-block (tokens)
62 (multiple-value-bind (in-block after-block) (find-closing-bracket tokens)
67 (parse after-block))))
69 (defun find-closing-bracket (tokens &optional (depth 0))
71 ((not tokens) (error "Failed to find a matching closing bracket"))
72 ((and (eql :] (car tokens)) (= depth 0)) (values nil (cdr tokens)))
73 (t (multiple-value-bind
74 (in-block after-block)
75 (find-closing-bracket (cdr tokens) (case (car tokens) (:[ (1+ depth)) (:] (1- depth)) (t depth)))
76 (values (cons (car tokens) in-block) after-block)))))
78 (defmacro defprim (name args)
80 (list :name ,name :args ',args)
83 ; This list of prims will get combined with the mapping to actual code later
84 ; Current list of argument types we accept:
89 (defprim :ask (:agentset :command-block))
90 (defprim :crt (:number))
91 (defprim :fd (:number))
92 (defprim :random-float (:number))