(defvar *dynamic-prims* nil)
(defun global->prim (global) (list :name global))
+(defun breed->prims (breed-list)
+ (let
+ ((plural-name (symbol-name (car breed-list))))
+ (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)))))
(defun parse (lexed-ast &optional external-globals)
"PARSE LEXED-AST &optional EXTERNAL-GLOBALS => AST
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
- ((*dynamic-prims* (mapcar #'global->prim external-globals)))
+ ((*dynamic-prims*
+ (append
+ (mapcar #'global->prim external-globals)
+ (procedures->prims lexed-ast))))
(parse-internal lexed-ast)))
+(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)))))
+
(defun parse-internal (lexed-ast)
(cond
((not lexed-ast) nil)
(multiple-value-bind (in-list after-list) (find-closing-bracket (cddr lexed-ast))
(cons
(list (car lexed-ast) (cons :list-literal in-list))
- (parse-internal after-list))))
+ (let
+ ((*dynamic-prims* (append (breed->prims in-list) *dynamic-prims*)))
+ (parse-internal after-list)))))
(defun find-closing-bracket (tokens)
(cond
Returns the globals that get declared in the code."
(mapcar
- (lambda (global) (list (symbol-name global) 0d0))
+ (lambda (global) (list (intern (symbol-name global) clnl:*model-package*) 0d0))
(cdr (second (find :globals code-parsed-ast :key #'car)))))