(defun prim-structure-prim (prim) (getf prim :structure-prim))
(defun prim-is-infix (prim) (getf prim :infix))
-(defun find-prim (symb) (find symb *prims* :key #'prim-name))
+(defun find-prim (symb)
+ (or
+ (find symb *prims* :key #'prim-name)
+ (find symb *dynamic-prims* :key #'prim-name)))
; Make this only as complicated as it needs to be, letting it grow
; as we take on more and more of the language
"PARSE LEXED-AST &optional DYNAMIC-PRIMS => AST
DYNAMIC-PRIMS: DYNAMIC-PRIM*
+ DYNAMIC-PRIM: (:name NAME :args ARGS :infix INFIX)
+ ARGS: ARG*
ARGUMENTS AND VALUES:
LEXED-AST: An ambigious ast
AST: An unambigious ast that can be transpiled
- DYNAMIC-PRIM: A prim not statically defined
+ NAME: A symbol in the keyword package
+ INFIX: Boolean denoting whether the prim is infix
+ ARG: A list of symbols denoting the type of argument
DESCRIPTION:
things not statically defined by the NetLogo language, be they user defined
procedures or generated primitives from breed declarations.
+ The possible values for ARG are :agentset, :boolean, :number, :command-block,
+ or t for wildcard.
+
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
point into this module, and should probably remain that way.
(parse-internal (cdr lexed-ast)
:prev-item (coerce (car lexed-ast) 'double-float)
:arg-countdown (when arg-countdown (1- arg-countdown))))
- ((eql (intern "(" (find-package :keyword)) (car lexed-ast)) (parse-parened-expr (cdr lexed-ast) arg-countdown))
- ((eql (intern ")" (find-package :keyword)) (car lexed-ast)) (error "Closing parens has no opening parens"))
+ ((eql (intern "(" :keyword) (car lexed-ast)) (parse-parened-expr (cdr lexed-ast) arg-countdown))
+ ((eql (intern ")" :keyword) (car lexed-ast)) (error "Closing parens has no opening parens"))
+ ((eql :let (car lexed-ast)) (parse-let (cdr lexed-ast) arg-countdown))
((eql :[ (car lexed-ast)) (parse-block (cdr lexed-ast) arg-countdown))
(prim
(when (prim-structure-prim prim)
(parse-prim prim lexed-ast nil arg-countdown))
(t (error "Couldn't parse ~S" lexed-ast))))))))
+(defun parse-let (lexed-ast arg-countdown)
+ (when (not (keywordp (car lexed-ast))) (error "Needed a keyword for let"))
+ (let*
+ ((half-parsed-remainder (parse-internal (cdr lexed-ast) :arg-countdown 1)))
+ (let
+ ((*dynamic-prims* (cons (list :name (car lexed-ast)) *dynamic-prims*)))
+ (parse-internal
+ (cdr half-parsed-remainder)
+ :arg-countdown (when arg-countdown (1- arg-countdown))
+ :prev-item (list :let (car lexed-ast) (car half-parsed-remainder))))))
+
(defun parse-prim (prim lexed-ast prev-item arg-countdown)
(let*
((num-args (- (prim-num-args prim) (if (prim-is-infix prim) 1 0)))
(butlast half-parsed-remainder (- (length half-parsed-remainder) num-args))))))))
(defun help-arg (arg-type arg)
- (case arg-type
- (:command-block
+ (cond
+ ((eql arg-type :command-block)
(if (not (and (consp arg) (eql 'block (car arg))))
(error "Required a block, but found a ~A" arg)
(cons :command-block (cdr arg))))
- (:reporter-block
+ ((eql arg-type :reporter-block)
(if (not (and (consp arg) (eql 'block (car arg))))
(error "Required a block, but found a ~A" arg)
(cons :reporter-block (cdr arg))))
- (:list
+ ((or (eql arg-type :list) (and (listp arg-type) (find :list arg-type)))
(if (and (consp arg) (eql 'block (car arg)))
(cons :list-literal (cdr arg))
arg))
(defun find-closing-paren (tokens &optional (depth 0))
(cond
((not tokens) (error "Failed to find a matching closing bracket"))
- ((and (eql (intern ")" (find-package :keyword)) (car tokens)) (= depth 0)) (values nil (cdr tokens)))
+ ((and (eql (intern ")" :keyword) (car tokens)) (= depth 0)) (values nil (cdr tokens)))
(t (multiple-value-bind
(in-block after-block)
(find-closing-paren
(cdr tokens)
(cond
- ((eql (intern "(" (find-package :keyword)) (car tokens)) (1+ depth))
- ((eql (intern ")" (find-package :keyword)) (car tokens)) (1- depth)) (t depth)))
+ ((eql (intern "(" :keyword) (car tokens)) (1+ depth))
+ ((eql (intern ")" :keyword) (car tokens)) (1- depth)) (t depth)))
(values (cons (car tokens) in-block) after-block)))))
(defmacro defprim (name args &optional infix)
(defprim :clear-all ())
(defprim :crt (:number))
(defprim :color ())
-(defprim :count ())
+(defprim :count (:agentset))
(defprim :die ())
(defprim :display ())
(defprim :with (:reporter-block))
(defprim :fd (:number))
(defprim :hatch (:number :command-block))
-(defprim :let (t t))
+; (defprim :let (t t)) ; keeping this here, commented out, to note that it has special processing
(defprim :if (:boolean :command-block))
+(defprim :if-else (:boolean :command-block :command-block))
(defprim :ifelse (:boolean :command-block :command-block))
(defprim :label ())
(defprim :label-color ())
(defprim :not (:boolean))
(defprim :nobody ())
-(defprim :one-of (t))
+(defprim :one-of ((:agentset :list)))
+(defprim :of (:reporter-block :agentset) :infix)
(defprim :patches ())
(defprim :pcolor ())
(defprim :random (:number))
(defprim :size ())
(defprim :stop ())
(defprim :tick ())
+(defprim :ticks ())
(defprim :turtles ())
+(defprim :who ())
; colors
(defprim :black ())
(defstructureprim :patches-own)
(defstructureprim :to)
(defstructureprim :to-report)
-
-; Placeholder prims that should be populated in dynamic prims
-
-; Generated by globals/widgets
-(defprim :grass ())
-(defprim :initial-number-sheep ())
-(defprim :initial-number-wolves ())
-(defprim :sheep-gain-from-food ())
-(defprim :wolf-gain-from-food ())
-(defprim :sheep-reproduce ())
-(defprim :wolf-reproduce ())
-(defprim :grass? ())
-(defprim :grass-regrowth-time ())
-(defprim :show-energy? ())
-
-; Generated by procedures
-(defprim :move ())
-(defprim :eat-grass ())
-(defprim :reproduce-sheep ())
-(defprim :reproduce-wolves ())
-(defprim :catch-sheep ())
-(defprim :death ())
-(defprim :grow-grass ())
-(defprim :display-labels ())
-
-; Generated by *-own
-(defprim :countdown ())
-(defprim :energy ())
-
-; Generated by a let
-(defprim :prey ())
-
-; Generated by breeds
-(defprim :sheep ())
-(defprim :wolves ())
-(defprim :create-sheep (:number :command-block)) ; look at me not have to do optionals yet
-(defprim :sheep-here ())
-(defprim :create-wolves (:number :command-block))
projects / clnl / blobdiff