+; Because prims are used both at generation time and later at runtime, certain things in
+; them must be escaped a little bit more, such as wrapping the whole thing in a list
+; primitive. This way, the output of these things looks like halfway decent lisp,
+; and everything works nicely. We don't want any <FUNC #> showing up or anything
+(defun munge-prim (prim)
+ (let
+ ((copied (copy-list prim)))
+ (when (getf copied :args) (setf (getf copied :args) `(quote ,(getf copied :args))))
+ `(list ,@copied)))
+
+(defun netlogo-callback-body (prims)
+ `(eval
+ (clnl-transpiler:transpile
+ (clnl-parser:parse
+ (clnl-lexer:lex ,(intern "NETLOGO-CODE" *model-package*))
+ (list ,@(mapcar #'munge-prim prims)))
+ (list ,@(mapcar #'munge-prim prims)))))
+
+(defun create-world-call (model globals code-ast)
+ `(clnl-nvm:create-world
+ :dims ',(clnl-model:world-dimensions model)
+ :globals (list
+ ,@(mapcar
+ (lambda (pair)
+ `(list ,(car pair) (lambda () ,(intern (string-upcase (car pair)) *model-package*))))
+ globals))
+ :turtles-own-vars ',(clnl-code-parser:turtles-own-vars code-ast)
+ :patches-own-vars ',(clnl-code-parser:patches-own-vars code-ast)
+ :breeds ',(clnl-code-parser:breeds code-ast)))
+
+(defun create-proc-body (proc prims)
+ `(,(intern (string-upcase (car proc)) *model-package*) ()
+ ,@(cdr ; remove the progn, cuz it looks nicer
+ (clnl-transpiler:transpile (cadr proc)
+ (mapcar
+ (lambda (prim)
+ (if (getf prim :macro) ; The reason we do this is because with macros, we want to evaluate them in
+ ; this scope while preserving them for the generational purposes below
+ (append (list :macro (eval (getf prim :macro))) prim)
+ prim)) prims)))))
+