Code - globals

[clnl] / src / main / parse.lisp

diff --git a/src/main/parse.lisp b/src/main/parse.lisp
index 1e5c30593fed8acc330095f4b90f277e0da0c5fb..97588bb085d1ef9df51ad59aab4ab1a0f00165b4 100644 (file)
--- a/src/main/parse.lisp
+++ b/src/main/parse.lisp
@@ -21,27 +21,38 @@
 ;    - We don't really care if things are commands or reporters right now
 
 (defparameter *prims* nil)
+; prims that are created when compiling the netlogo file
+; usually via procedures or top level things like breed declarations
+(defparameter *dynamic-prims* nil)
 
 (defun prim-name (prim) (getf prim :name))
 (defun prim-num-args (prim) (length (getf prim :args)))
 (defun prim-args (prim) (getf prim :args))
+(defun prim-structure-prim (prim) (getf prim :structure-prim))
 
 (defun find-prim (symb) (find symb *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
-(defun parse (lexed-ast)
- "PARSE LEXED-AST => AST
+(defun parse (lexed-ast &optional dynamic-prims)
+ "PARSE LEXED-AST &optional DYNAMIC-PRIMS => AST
+
+  DYNAMIC-PRIMS: DYNAMIC-PRIM*
 
 ARGUMENTS AND VALUES:
 
   LEXED-AST: An ambigious ast
   AST: An unambigious ast that can be transpiled
+  DYNAMIC-PRIM: A prim not statically defined
 
 DESCRIPTION:
 
   PARSE takes a ambigious LEXED-AST and converts it to an unambigious one.
 
+  DYNAMIC-PRIMS that are passed in are used to avoid compilation errors on
+  things not statically defined by the NetLogo language, be they user defined
+  procedures or generated primitives from breed declarations.
+
   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.
@@ -51,31 +62,48 @@ DESCRIPTION:
 
   Examples are too numerous and varied, but by inserting an output between
   the lexer and this code, a good idea of what goes on can be gotten."
+ (let
+  ; could have defined this using the special variable, but didn't to make the
+  ; function definition simpler, as well as the documentation.
+  ((*dynamic-prims* dynamic-prims))
+  (parse-internal lexed-ast)))
+
+(defun parse-internal (lexed-ast)
  (cond
   ((not lexed-ast) nil)
-  ((numberp (car lexed-ast)) (cons (coerce (car lexed-ast) 'double-float) (parse (cdr lexed-ast))))
+  ((numberp (car lexed-ast)) (cons (coerce (car lexed-ast) 'double-float) (parse-internal (cdr lexed-ast))))
   ((eql :[ (car lexed-ast)) (parse-block (cdr lexed-ast)))
   ((and (symbolp (car lexed-ast)) (find-prim (car lexed-ast)))
-   (let*
-    ((prim (find-prim (car lexed-ast)))
-     (num-args (prim-num-args prim))
-     (parsed-remainder (parse (cdr lexed-ast))))
-    (cons
-     (cons
-      (prim-name prim)
-      (mapcar
-       #'help-arg
-       (prim-args prim)
-       (butlast parsed-remainder (- (length parsed-remainder) num-args))))
-     (nthcdr num-args parsed-remainder))))
+   (let
+    ((prim (find-prim (car lexed-ast))))
+    (when (prim-structure-prim prim)
+     (error "This doesn't make sense here"))
+    (parse-prim prim lexed-ast)))
   (t (error "Couldn't parse ~S" lexed-ast))))
 
+(defun parse-prim (prim lexed-ast)
+ (let
+  ((num-args (prim-num-args prim))
+   (parsed-remainder (parse-internal (cdr lexed-ast))))
+  (cons
+   (cons
+    (prim-name prim)
+    (mapcar
+     #'help-arg
+     (prim-args prim)
+     (butlast parsed-remainder (- (length parsed-remainder) num-args))))
+   (nthcdr num-args parsed-remainder))))
+
 (defun help-arg (arg-type arg)
  (case arg-type
   (:command-block
    (if (not (and (consp arg) (eql 'block (car arg))))
     (error "Required a block, but found a ~A" arg)
     (cons :command-block (cdr arg))))
+  (:list
+   (if (and (consp arg) (eql 'block (car arg)))
+    (cons :list-literal (cdr arg))
+    arg))
   (t arg)))
 
 (defun parse-block (tokens)
@@ -83,8 +111,8 @@ DESCRIPTION:
   (cons
    (cons
     'block
-    (parse in-block))
-   (parse after-block))))
+    (parse-internal in-block))
+   (parse-internal after-block))))
 
 (defun find-closing-bracket (tokens &optional (depth 0))
  (cond
@@ -100,6 +128,11 @@ DESCRIPTION:
    (list :name ,name :args ',args)
    *prims*))
 
+(defmacro defstructureprim (name)
+ `(push
+   (list :name ,name :structure-prim t)
+   *prims*))
+
 ; This list of prims will get combined with the mapping to actual code later
 ; Current list of argument types we accept:
 ; - :number
@@ -112,3 +145,10 @@ DESCRIPTION:
 (defprim :random-float (:number))
 (defprim :show (t))
 (defprim :turtles ())
+
+(defstructureprim :globals)
+(defstructureprim :breed)
+(defstructureprim :turtles-own)
+(defstructureprim :patches-own)
+(defstructureprim :to)
+(defstructureprim :to-report)