Add export to common lisp form, forms

[clnl] / src / main / code-parse.lisp

diff --git a/src/main/code-parse.lisp b/src/main/code-parse.lisp
index 7cdf2b5b1864ff53ea9483a18464e2b906cc56c4..e9b4d770f43e15c29138045f492794824bdc9649 100644 (file)
--- a/src/main/code-parse.lisp
+++ b/src/main/code-parse.lisp
@@ -7,20 +7,34 @@
 ; other things
 
 (defvar *dynamic-prims* nil)
 ; other things
 
 (defvar *dynamic-prims* nil)

-(defun global->prim (global) (list :name global))
+
+(defun global->prim (global)
+ (list :name global :type :reporter :macro `(lambda () ',(intern (symbol-name global) clnl:*model-package*))))
+
+(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)
 
 (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
 
 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.
 
 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
 
   EXTERNAL-GLOBALS is a list of symbols representing global variables that
   are not defined within the code.  Normally these come from widgets defined


@@ -31,13 +45,26 @@ DESCRIPTION:
   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."
   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
-  ((*dynamic-prims* (mapcar #'global->prim external-globals)))
-  (parse-internal lexed-ast)))
+ (let*
+  ((*dynamic-prims*
+    (append
+     (mapcar #'global->prim external-globals)
+     (procedures->prims lexed-ast)))
+   (parsed (parse-internal lexed-ast)))
+  (values
+   (butlast parsed)
+   (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))))
+  (t (procedures->prims (cdr lexed-ast)))))

 
 (defun parse-internal (lexed-ast)
  (cond
 
 (defun parse-internal (lexed-ast)
  (cond

-  ((not lexed-ast) nil)
+  ((not lexed-ast) *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))
   ((eql :to (car lexed-ast)) (parse-procedure lexed-ast))
   ((find (car lexed-ast) '(:globals :turtles-own :patches-own))
    (parse-with-unevaluated-list lexed-ast))


@@ -76,7 +103,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))
  (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
 
 (defun find-closing-bracket (tokens)
  (cond


@@ -94,11 +123,11 @@ DESCRIPTION:
 ARGUMENTS AND VALUES:
 
   MODEL: An ast as created by clnl-code-parse:parse
 ARGUMENTS AND VALUES:
 
   MODEL: An ast as created by clnl-code-parse:parse

-  GLOBAL: A symbol interned in clnl:*model-package*
+  GLOBAL: A symbol interned in :keyword

 
 DESCRIPTION:
 
   Returns the globals that get declared in the code."
  (mapcar
 
 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)))))
   (cdr (second (find :globals code-parsed-ast :key #'car)))))