(defparameter *dynamic-prims* nil)
(defun prim-name (prim) (getf prim :name))
+(defun prim-precedence (prim) (getf prim :precedence))
(defun prim-args (prim) (getf prim :args))
(defun prim-structure-prim (prim) (getf prim :structure-prim))
(defun prim-is-infix (prim) (getf prim :infix))
"PARSE LEXED-AST &optional DYNAMIC-PRIMS => AST
DYNAMIC-PRIMS: DYNAMIC-PRIM*
- DYNAMIC-PRIM: (:name NAME :args ARGS :infix INFIX)
+ DYNAMIC-PRIM: (:name NAME :args ARGS :infix INFIX :precedence PRECEDENCE)
ARGS: ARG*
ARGUMENTS AND VALUES:
LEXED-AST: An ambigious ast
AST: An unambigious ast that can be transpiled
NAME: A symbol in the keyword package
- INFIX: Boolean denoting whether the prim is infix
+ INFIX: Boolean denoting whether the prim is infix, defaulting to NIL
+ PRECEDENCE: A number, usually 10 for reporters, and 0 for commands
ARG: A list of symbols denoting the type of argument
DESCRIPTION:
DYNAMIC-PRIMS that are passed in are used to avoid compilation errors on
things not statically defined by the NetLogo language, be they user defined
- procedures or generated primitives from breed declarations.
+ procedures or generated primitives from breed declarations. NAME and PRECEDENCE
+ are required for all dynamic prims.
+
+ PRECEDENCE is a number used to calculate the order of operations. Higher numbers
+ have more precedence than lower ones. Generally all commands should have the
+ lowest precedence, and all reporters should have 10 as the precedence.
The possible values for ARG are :agentset, :boolean, :number, :command-block,
or t for wildcard.
Examples are too numerous and varied, but by inserting an output between
the lexer and this code, a good idea of what goes on can be gotten."
+ (when (find nil dynamic-prims :key #'prim-name)
+ (error "All passed in prims must have a name: ~S" (find nil dynamic-prims :key #'prim-name)))
+ (when (find nil dynamic-prims :key #'prim-precedence)
+ (error "All passed in prims must have a precedence: ~S" (find nil dynamic-prims :key #'prim-precedence)))
(let
; could have defined this using the special variable, but didn't to make the
; function definition simpler, as well as the documentation.
:prev-item (coerce (car lexed-ast) 'double-float)
:prev-remaining-arg (car remaining-args)
:remaining-args (cdr remaining-args)))
+ ((and remaining-args
+ (or
+ (eql :token (car remaining-args))
+ (and
+ (listp (car remaining-args))
+ (find :token (car remaining-args))
+ (symbolp (car lexed-ast)))))
+ (parse-internal (cdr lexed-ast)
+ :prev-item (car lexed-ast)
+ :prev-remaining-arg (car remaining-args)
+ :remaining-args (cdr remaining-args)))
((eql (intern "(" :keyword) (car lexed-ast)) (parse-parened-expr (cdr lexed-ast) remaining-args))
((eql (intern ")" :keyword) (car lexed-ast)) (error "Closing parens has no opening parens"))
((eql :let (car lexed-ast)) (parse-let (cdr lexed-ast) remaining-args))
(let*
((half-parsed-remainder (parse-internal (cdr lexed-ast) :remaining-args (list t :done-with-args))))
(let
- ((*dynamic-prims* (cons (list :name (car lexed-ast)) *dynamic-prims*)))
+ ((*dynamic-prims* (cons (list :name (car lexed-ast) :precedence 20) *dynamic-prims*)))
(parse-internal
(cdr half-parsed-remainder)
:remaining-args (cdr remaining-args)
(< 1 (length prev-item))
(keywordp (car x))
(find-prim (car x))
- (getf (find-prim (car x)) :precedence))
+ (prim-precedence (find-prim (car x))))
20)))
(cond
- ((<= (getf prim :precedence) (calculate-precedence prev-item))
+ ((<= (prim-precedence prim) (calculate-precedence prev-item))
(cons
(prim-name prim)
(cons
following-args)))))))
(defun parse-prim (prim lexed-ast prev-item prev-remaining-arg remaining-args)
+ (when (not (prim-precedence prim))
+ (error "Prim must have a precedence! ~A" prim))
+ (when (and (prim-is-infix prim) (eql :token (car (prim-args prim))))
+ (error "Can't have a prim that wants a token in the first position while being infix: ~A" prim))
+ (when
+ (and
+ (< (prim-precedence prim) 20)
+ (find-if (lambda (arg) (or (eql :token arg) (and (listp arg) (find :token arg)))) (prim-args prim)))
+ (error "Can't have a prim that wants a token and has a precedence of less than 20: ~A" prim))
(let*
((args (if (prim-is-infix prim) (cdr (prim-args prim)) (prim-args prim)))
(half-parsed-remainder (parse-internal (cdr lexed-ast) :remaining-args (append args (list :done-with-args))))
(defun help-arg (arg arg-type)
(cond
((not arg-type) arg)
+ ((eql arg-type :token) (list :arg (list :token arg)))
+ ((and (listp arg-type) (find :token arg-type) (symbolp arg)) (list :arg (list :token arg)))
((eql arg-type :command-block)
(if (not (and (consp arg) (eql 'block (car arg))))
(error "Required a block, but found a ~A" arg)
; - :agentset
; - :command-block
; - :boolean
+; - :token (suspends evaluation)
; - t - any type
;
; After the arguments, :infix denotes that it's an :infix operator
(defprim :ca () 0)
(defprim :clear-all () 0)
(defprim :crt (:number (:command-block :optional)) 0)
+(defprim :create-turtles (:number (:command-block :optional)) 0)
(defprim :color () 10)
(defprim :count (:agentset) 10)
(defprim :die () 0)