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.
+ :string, or t for wildcard. For optional arguments, ARG can be a list of the form
+ (ARG :optional) where ARG is one of the aforementioned values.
The need for a parser between the lexer and the transpiler is because NetLogo
needs two passes to turn into something that can be used. This is the only entry
: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)
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))))
+ (half-parsed-remainder
+ (parse-internal (cdr lexed-ast) :remaining-args (append args (list :done-with-args))))
(breakpoint (or
(position-if (lambda (form) (or (not (listp form)) (not (eql :arg (car form))))) half-parsed-remainder)
(length half-parsed-remainder)))
(already-parsed-limbo-forms
(subseq half-parsed-remainder breakpoint (min (length args) (length half-parsed-remainder))))
+ (num-optional-forms (- (length args) breakpoint))
(middle-forms
(cons
(if
(prim-is-infix prim)
- (reconfigure-due-to-precedence prev-item prim (mapcar #'cadr (subseq half-parsed-remainder 0 breakpoint)))
+ ; There's a potential bug here about infix operators with optional forms, where the first item is optional
+ ; I don't consider that super likely though...
+ (append
+ (reconfigure-due-to-precedence prev-item prim (mapcar #'cadr (subseq half-parsed-remainder 0 breakpoint)))
+ (loop :repeat num-optional-forms :collect :optional))
(cons
(prim-name prim)
- (mapcar #'cadr (subseq half-parsed-remainder 0 breakpoint))))
- already-parsed-limbo-forms)))
+ (append
+ (mapcar #'cadr (subseq half-parsed-remainder 0 breakpoint))
+ (loop :repeat num-optional-forms :collect :optional)))) ; we save the place for optionals for the transpiler
+ already-parsed-limbo-forms)));)
+ (let
+ ((arg-at-bp (nth breakpoint args)))
+ (when (and arg-at-bp (or (not (listp arg-at-bp)) (not (find :optional arg-at-bp))))
+ (error "Stopped collecting arguments, but non optional arguments remain")))
(append
(butlast middle-forms)
(parse-internal
(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 :green () 10)
(defprim :white () 10)
+; booleans
+(defprim :true () 10)
+(defprim :false () 10)
+
(defstructureprim :globals)
(defstructureprim :breed)
(defstructureprim :turtles-own)