; other things
(defvar *dynamic-prims* nil)
-(defun global->prim (global) (list :name global))
+
+(defun global->prim (global)
+ (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
+ "PARSE LEXED-AST &optional EXTERNAL-GLOBALS => AST, PRIMS
ARGUMENTS AND VALUES:
LEXED-AST: An ambigious ast
EXTERNAL-GLOBALS: A list of symbols in keyword package
AST: An unambigious ast that represents the code block of a model
+ PRIMS: Primitives that can be sent to the parser and transpiler
DESCRIPTION:
PARSE takes a ambigious LEXED-AST and converts it to an unambigious one.
+ It also returns the primitives that are defined in the code file, including
+ ones generated from the EXTERNAL-GLOBALS, that can then be passed to both
+ the parser and the transpiler.
EXTERNAL-GLOBALS is a list of symbols representing global variables that
are not defined within the code. Normally these come from widgets defined
Rather, the ast that's returned can be queried with other functions included
in the CLNL-CODE-PARSER package to tease out necessary information. Some of
those things will involve code blocks that can then be transpiled."
- (let
+ (let*
((*dynamic-prims*
(append
- (mapcar #'global->prim external-globals)
- (procedures->prims lexed-ast))))
- (parse-internal 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)
+ (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-to-prims (cdr lexed-ast))))
- (t (procedures-to-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) nil)
+ ((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
- GLOBAL: A symbol interned in clnl:*model-package*
+ CODE-PARSED-AST: An ast as created by clnl-code-parse:parse
+ GLOBAL: A symbol interned in :keyword
DESCRIPTION:
Returns the globals that get declared in the code."
(mapcar
- (lambda (global) (list (symbol-name global) 0d0))
+ (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)))
projects / clnl / blobdiff