X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;f=src%2Fmain%2Fcode-parse.lisp;h=7d9c42c69a21da7815d34ddd19a663e6f153be0a;hb=82888b4;hp=7cdf2b5b1864ff53ea9483a18464e2b906cc56c4;hpb=18f00de47300789104d94745cd9db874b2071b7e;p=clnl

diff --git a/src/main/code-parse.lisp b/src/main/code-parse.lisp
index 7cdf2b5..7d9c42c 100644
--- a/src/main/code-parse.lisp
+++ b/src/main/code-parse.lisp
@@ -8,6 +8,13 @@
 
 (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
@@ -32,9 +39,19 @@ DESCRIPTION:
   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)
@@ -76,7 +93,9 @@ DESCRIPTION:
  (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
@@ -100,5 +119,5 @@ 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) clnl:*model-package*) 0d0))
   (cdr (second (find :globals code-parsed-ast :key #'car)))))