X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;f=src%2Fmain%2Fparse.lisp;h=97588bb085d1ef9df51ad59aab4ab1a0f00165b4;hb=3abea7023574532423fa24d5f97154db474b50a0;hp=70e141d249e30fd398908497436e136c8d53be41;hpb=471de83db1aee70065808cbc061867e3320bf4b7;p=clnl

diff --git a/src/main/parse.lisp b/src/main/parse.lisp
index 70e141d..97588bb 100644
--- a/src/main/parse.lisp
+++ b/src/main/parse.lisp
@@ -21,41 +21,89 @@
 ;    - 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)
+(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.
+
+  There's also a lot of error checking that the LEXED-AST even makes sense, even
+  though the lexer obviously thought it did.
+
+  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)
@@ -63,8 +111,8 @@
   (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
@@ -80,6 +128,11 @@
    (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
@@ -92,3 +145,10 @@
 (defprim :random-float (:number))
 (defprim :show (t))
 (defprim :turtles ())
+
+(defstructureprim :globals)
+(defstructureprim :breed)
+(defstructureprim :turtles-own)
+(defstructureprim :patches-own)
+(defstructureprim :to)
+(defstructureprim :to-report)