UI/Model Parse - Sliders - WIP

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

diff --git a/src/main/code-parse.lisp b/src/main/code-parse.lisp
index 7cdf2b5b1864ff53ea9483a18464e2b906cc56c4..e159f39e47135513d557bd04237aa32bc1f46c7c 100644 (file)
--- a/src/main/code-parse.lisp
+++ b/src/main/code-parse.lisp
@@ -7,20 +7,52 @@
 ; 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
+  :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 (car breed-list))
+   (plural-name (symbol-name plural)))
+  (list
+   (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)
 
 (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 +63,35 @@ 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 (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)
+     :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
 
 (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))
   ((eql :to (car lexed-ast)) (parse-procedure lexed-ast))
   ((find (car lexed-ast) '(:globals :turtles-own :patches-own))
    (parse-with-unevaluated-list lexed-ast))


@@ -68,7 +122,15 @@ DESCRIPTION:
   (cons
    (list (car lexed-ast) (cons :list-literal in-list))
    (let
   (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)
     (parse-internal after-list)))))
 
 (defun parse-breed (lexed-ast)


@@ -76,7 +138,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


@@ -87,18 +151,84 @@ DESCRIPTION:
       (values (cons (car tokens) in-block) after-block)))))
 
 (defun globals (code-parsed-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:
 
 
   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
 
 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)))))

+
+(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)))