Improve parser - generate prims from procedures

[clnl] / src / main / parse.lisp

diff --git a/src/main/parse.lisp b/src/main/parse.lisp
index eaaa3fe1d5fdf70c82d43c77431caacfaf5e7dea..ad9f746a211d8e15bf1d2a3d4e55e2f41ab46531 100644 (file)
--- a/src/main/parse.lisp
+++ b/src/main/parse.lisp
@@ -31,7 +31,10 @@
 (defun prim-structure-prim (prim) (getf prim :structure-prim))
 (defun prim-is-infix (prim) (getf prim :infix))
 
-(defun find-prim (symb) (find symb *prims* :key #'prim-name))
+(defun find-prim (symb)
+ (or
+  (find symb *prims* :key #'prim-name)
+  (find symb *dynamic-prims* :key #'prim-name)))
 
 ; Make this only as complicated as it needs to be, letting it grow
 ; as we take on more and more of the language
@@ -39,12 +42,16 @@
  "PARSE LEXED-AST &optional DYNAMIC-PRIMS => AST
 
   DYNAMIC-PRIMS: DYNAMIC-PRIM*
+  DYNAMIC-PRIM: (:name NAME :args ARGS :infix INFIX)
+  ARGS: ARG*
 
 ARGUMENTS AND VALUES:
 
   LEXED-AST: An ambigious ast
   AST: An unambigious ast that can be transpiled
-  DYNAMIC-PRIM: A prim not statically defined
+  NAME: A symbol in the keyword package
+  INFIX: Boolean denoting whether the prim is infix
+  ARG: A list of symbols denoting the type of argument
 
 DESCRIPTION:
 
@@ -54,6 +61,9 @@ DESCRIPTION:
   things not statically defined by the NetLogo language, be they user defined
   procedures or generated primitives from breed declarations.
 
+  The possible values for ARG are :agentset, :boolean, :number, :command-block,
+  or t for wildcard.
+
   The need for a parser between the lexer and the transpiler is because NetLogo
   needs two passes to turn into something that can be used.  This is the only entry
   point into this module, and should probably remain that way.
@@ -91,6 +101,7 @@ DESCRIPTION:
         :arg-countdown (when arg-countdown (1- arg-countdown))))
       ((eql (intern "(" (find-package :keyword)) (car lexed-ast)) (parse-parened-expr (cdr lexed-ast) arg-countdown))
       ((eql (intern ")" (find-package :keyword)) (car lexed-ast)) (error "Closing parens has no opening parens"))
+      ((eql :let (car lexed-ast)) (parse-let (cdr lexed-ast) arg-countdown))
       ((eql :[ (car lexed-ast)) (parse-block (cdr lexed-ast) arg-countdown))
       (prim
        (when (prim-structure-prim prim)
@@ -98,6 +109,17 @@ DESCRIPTION:
        (parse-prim prim lexed-ast nil arg-countdown))
       (t (error "Couldn't parse ~S" lexed-ast))))))))
 
+(defun parse-let (lexed-ast arg-countdown)
+ (when (not (keywordp (car lexed-ast))) (error "Needed a keyword for let"))
+ (let*
+  ((half-parsed-remainder (parse-internal (cdr lexed-ast) :arg-countdown 1)))
+  (let
+   ((*dynamic-prims* (cons (list :name (car lexed-ast)) *dynamic-prims*)))
+   (parse-internal
+    (cdr half-parsed-remainder)
+    :arg-countdown (when arg-countdown (1- arg-countdown))
+    :prev-item (list :let (car lexed-ast) (car half-parsed-remainder))))))
+
 (defun parse-prim (prim lexed-ast prev-item arg-countdown)
  (let*
   ((num-args (- (prim-num-args prim) (if (prim-is-infix prim) 1 0)))
@@ -208,8 +230,9 @@ DESCRIPTION:
 (defprim :with (:reporter-block))
 (defprim :fd (:number))
 (defprim :hatch (:number :command-block))
-(defprim :let (t t))
+; (defprim :let (t t)) ; keeping this here, commented out, to note that it has special processing
 (defprim :if (:boolean :command-block))
+(defprim :if-else (:boolean :command-block :command-block))
 (defprim :ifelse (:boolean :command-block :command-block))
 (defprim :label ())
 (defprim :label-color ())
@@ -251,35 +274,6 @@ DESCRIPTION:
 
 ; Placeholder prims that should be populated in dynamic prims
 
-; Generated by globals/widgets
-(defprim :grass ())
-(defprim :initial-number-sheep ())
-(defprim :initial-number-wolves ())
-(defprim :sheep-gain-from-food ())
-(defprim :wolf-gain-from-food ())
-(defprim :sheep-reproduce ())
-(defprim :wolf-reproduce ())
-(defprim :grass? ())
-(defprim :grass-regrowth-time ())
-(defprim :show-energy? ())
-
-; Generated by procedures
-(defprim :move ())
-(defprim :eat-grass ())
-(defprim :reproduce-sheep ())
-(defprim :reproduce-wolves ())
-(defprim :catch-sheep ())
-(defprim :death ())
-(defprim :grow-grass ())
-(defprim :display-labels ())
-
-; Generated by *-own
-(defprim :countdown ())
-(defprim :energy ())
-
-; Generated by a let
-(defprim :prey ())
-
 ; Generated by breeds
 (defprim :sheep ())
 (defprim :wolves ())