(defvar *dynamic-prims* nil)
(defun global->prim (global)
- (list :name global :type :reporter :macro `(lambda () ',(intern (symbol-name global) clnl:*model-package*))))
+ (list
+ :name global
+ :type :reporter
+ :precedence 10
+ :macro `(lambda () ',(intern (symbol-name global) clnl:*model-package*))))
+
+(defun own->prim (symb)
+ (list :name symb :type :reporter :precedence 10 :macro `(lambda () '(clnl-nvm:agent-value ,symb))))
(defun breed->prims (breed-list)
- (let
- ((plural-name (symbol-name (car breed-list))))
+ (let*
+ ((plural (car breed-list))
+ (plural-name (symbol-name plural)))
(list
- (list :name (car breed-list))
- (list :name (intern (format nil "~A-HERE" plural-name) :keyword))
- (list :name (intern (format nil "CREATE-~A" plural-name) :keyword) :args '(:number :command-block)))))
+ (list :name plural :type :reporter :precedence 10 :macro `(lambda () ,plural))
+ (list
+ :name (intern (format nil "~A-HERE" plural-name) :keyword)
+ :type :reporter
+ :precedence 10
+ :macro `(lambda () '(clnl-nvm:turtles-here ,plural)))
+ (list
+ :name (intern (format nil "CREATE-~A" plural-name) :keyword)
+ :type :command
+ :args '(:number (:command-block :optional))
+ :precedence 0
+ :macro `(lambda (num &optional command-block)
+ `(clnl-nvm:create-turtles ,num ,,plural ,command-block))))))
(defun parse (lexed-ast &optional external-globals)
"PARSE LEXED-AST &optional EXTERNAL-GLOBALS => AST, PRIMS
(let*
((*dynamic-prims*
(append
- (mapcar #'global->prim external-globals)
- (procedures->prims lexed-ast)))
+ (mapcar #'global->prim (mapcar #'car external-globals))
+ (procedures->prims lexed-ast)
+ (clnl-extensions:load-extension :cli)))
(parsed (parse-internal lexed-ast)))
(values
(butlast parsed)
- (last parsed))))
+ (car (last parsed)))))
(defun procedures->prims (lexed-ast)
(cond
((not lexed-ast) nil)
; We'll need argument handling here sometime :)
- ((eql :to (car lexed-ast)) (cons (list :name (cadr lexed-ast)) (procedures->prims (cdr lexed-ast))))
+ ((eql :to (car lexed-ast))
+ (cons
+ (list
+ :name (cadr lexed-ast)
+ :type :command
+ :precedence 0
+ :func `(function ,(intern (symbol-name (cadr lexed-ast)) clnl:*model-package*)))
+ (procedures->prims (cddr lexed-ast))))
(t (procedures->prims (cdr lexed-ast)))))
(defun parse-internal (lexed-ast)
(cond
- ((not lexed-ast) *dynamic-prims*)
+ ((not lexed-ast)
+ (list *dynamic-prims*))
((eql :to (car lexed-ast)) (parse-procedure lexed-ast))
((find (car lexed-ast) '(:globals :turtles-own :patches-own))
(parse-with-unevaluated-list lexed-ast))
(cons
(list (car lexed-ast) (cons :list-literal in-list))
(let
- ((*dynamic-prims* (append (mapcar #'global->prim in-list) *dynamic-prims*)))
+ ((*dynamic-prims*
+ (append
+ (mapcar
+ (case (car lexed-ast)
+ (:globals #'global->prim)
+ (:turtles-own #'own->prim)
+ (:patches-own #'own->prim)
+ (t #'global->prim))
+ in-list) *dynamic-prims*)))
(parse-internal after-list)))))
(defun parse-breed (lexed-ast)
(values (cons (car tokens) in-block) after-block)))))
(defun globals (code-parsed-ast)
- "GLOBALS MODEL => GLOBALS
+ "GLOBALS CODE-PARSED-AST => GLOBALS
GLOBALS: GLOBAL*
ARGUMENTS AND VALUES:
- MODEL: An ast as created by clnl-code-parse:parse
+ CODE-PARSED-AST: An ast as created by clnl-code-parse:parse
GLOBAL: A symbol interned in :keyword
DESCRIPTION:
(mapcar
(lambda (global) (list (intern (symbol-name global) :keyword) 0d0))
(cdr (second (find :globals code-parsed-ast :key #'car)))))
+
+(defun turtles-own-vars (code-parsed-ast)
+ "TURTLES-OWN-VARS CODE-PARSED-AST => TURTLES-OWN-VARS
+
+ TURTLES-OWN-VARS: TURTLES-OWN-VAR*
+
+ARGUMENTS AND VALUES:
+
+ CODE-PARSED-AST: An ast as created by clnl-code-parse:parse
+ TURTLES-OWN-VAR: A symbol interned in :keyword
+
+DESCRIPTION:
+
+ Returns the turtles own variables that get declared in the code."
+ (cdr (second (find :turtles-own code-parsed-ast :key #'car))))
+
+(defun patches-own-vars (code-parsed-ast)
+ "PATCHES-OWN-VARS CODE-PARSED-AST => PATCHES-OWN-VARS
+
+ PATCHES-OWN-VARS: PATCHES-OWN-VAR*
+
+ARGUMENTS AND VALUES:
+
+ CODE-PARSED-AST: An ast as created by clnl-code-parse:parse
+ PATCHES-OWN-VAR: A symbol interned in :keyword
+
+DESCRIPTION:
+
+ Returns the turtles own variables that get declared in the code."
+ (cdr (second (find :patches-own code-parsed-ast :key #'car))))
+
+(defun breeds (code-parsed-ast)
+ "BREEDS CODE-PARSED-AST => BREEDS
+
+ BREEDS: BREED*
+
+ARGUMENTS AND VALUES:
+
+ CODE-PARSED-AST: An ast as created by clnl-code-parse:parse
+ BREED: A symbol interned in :keyword
+
+DESCRIPTION:
+
+ Returns the breeds that get declared in the code."
+ (mapcar #'cadadr (remove :breed code-parsed-ast :test-not #'equal :key #'car)))
+
+(defun procedures (code-parsed-ast)
+ "PROCEDURES CODE-PARSED-AST => PROCEDURES
+
+ PROCEDURES: PROCEDURE*
+ PROCEDURE: (NAME BODY)
+
+ARGUMENTS AND VALUES:
+
+ CODE-PARSED-AST: An ast as created by clnl-code-parse:parse
+ NAME: A symbol interned in :keyword
+ BODY: A list of lexed forms
+
+DESCRIPTION:
+
+ Returns the procedures that were defined in the code. These can
+ then be translated into common lisp by using mapcar on the BODY, and
+ set to some function defined by NAME"
+ (mapcar
+ (lambda (proc) (cdr proc))
+ (remove-if-not (lambda (form) (find (car form) '(:to :to-report))) code-parsed-ast)))