X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=blobdiff_plain;f=src%2Fmain%2Ftranspile.lisp;h=b0f90fe504cf1de1f368b477756ea32afb26d68c;hp=956b226eaea577f61fb3de51b4ac0417e8761a4d;hb=89cb3482de1fefc2d8e5f67e1e04a0790e8cd243;hpb=807df6b6f160d82cc04ca02ce88d61ee58439ad1

diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp
index 956b226..b0f90fe 100644
--- a/src/main/transpile.lisp
+++ b/src/main/transpile.lisp
@@ -49,7 +49,6 @@ DESCRIPTION:
 
   Calling eval on that code should work correctly as long as you have a
   running engine."
-
  (let
   ((*dynamic-prims*
     (mapcar
@@ -58,11 +57,13 @@ DESCRIPTION:
        (append (list :func (getf prim :macro)) prim)
        (append (list :func (lambda (&rest args) `(funcall ,(getf prim :func) ,@args))) prim)))
      dynamic-prims)))
-  (cond
-   ((command-list-p parsed-ast) (transpile-commands parsed-ast))
-   ((and (listp parsed-ast) (= 1 (length parsed-ast)) (reporter-p (car parsed-ast)))
-    (transpile-reporter (car parsed-ast)))
-   (t (error "Is neither a list of commands nor a reporter: ~S" parsed-ast)))))
+  (let
+   ((deoptionalized-ast (deoptionalize parsed-ast)))
+   (cond
+    ((command-list-p deoptionalized-ast) (transpile-commands deoptionalized-ast))
+    ((and (listp deoptionalized-ast) (= 1 (length deoptionalized-ast)) (reporter-p (car deoptionalized-ast)))
+     (transpile-reporter (car deoptionalized-ast)))
+    (t (error "Is neither a list of commands nor a reporter: ~S" deoptionalized-ast))))))
 
 (defun command-list-p (parsed-ast)
  "COMMAND-LIST-P PARSED-AST => RESULT
@@ -76,9 +77,12 @@ DESCRIPTION:
 
   COMMAND-LIST-P returns whether the parsed-ast is a valid list
   of commands."
+ (every #'command-p parsed-ast))
+
+(defun command-p (parsed-ast)
  (and
-  (every #'listp parsed-ast)
-  (every #'prim-command-p (mapcar #'find-prim (mapcar #'car parsed-ast)))))
+  (listp parsed-ast)
+  (prim-command-p (find-prim (car parsed-ast)))))
 
 (defun reporter-p (parsed-ast)
  "REPORTER-P PARSED-AST => RESULT
@@ -92,6 +96,7 @@ DESCRIPTION:
 
   REPORTER-P returns whether the parsed-ast is a valid reporter."
  (and
+  (listp parsed-ast)
   (symbolp (car parsed-ast))
   (prim-reporter-p (find-prim (car parsed-ast)))))
 
@@ -101,6 +106,51 @@ DESCRIPTION:
  `(progn
    ,@(transpile-commands-inner parsed-ast)))
 
+; This makes some assumptions about the precedence of optionality
+; Consider the following:
+; - command-1 <optional> <optional>
+; - reporter-1 <optional>
+;
+; And consider:
+; - command-1 reporter-1 "foo"
+;
+; Does the "foo" belong to command-1 or reporter-1?
+;
+; I'm not sure how netlogo answers this at this time, but for the purposes
+; of this deoptionalizer, "foo" belongs to reporter-1.  In the case that the
+; language tests treat this as incorrect, I'll fix it.  I'm not sure if this
+; case exists in the base netlogo language, and I don't feel like creating
+; a specific test case at this time to find out.
+(defun deoptionalize (parsed-ast)
+ (let
+  ((first-thing (car parsed-ast)))
+  (cond
+   ((not parsed-ast) nil)
+   ((not (listp first-thing)) (cons first-thing (deoptionalize (cdr parsed-ast))))
+   ((and
+     (find :optional first-thing)
+     (cadr parsed-ast)
+     (not (command-p (cadr parsed-ast))))
+    (let
+     ((deoptionalized-rest (deoptionalize (cdr parsed-ast)))
+      (optional-pos (position :optional first-thing)))
+     (deoptionalize
+      (cons
+       (append
+        (subseq first-thing 0 optional-pos)
+        (list (car deoptionalized-rest))
+        (subseq first-thing (1+ optional-pos)))
+       (cdr deoptionalized-rest)))))
+   ((find :optional first-thing)
+    (deoptionalize
+     (cons
+      (subseq first-thing 0 (position :optional first-thing))
+      (cdr parsed-ast))))
+   (t
+    (cons
+     (deoptionalize first-thing)
+     (deoptionalize (cdr parsed-ast)))))))
+
 (defun transpile-commands-inner (parsed-ast)
  (cond
   ((not parsed-ast) nil)
@@ -143,6 +193,7 @@ DESCRIPTION:
   ((eql :command-block (car reporter)) (transpile-command-block reporter))
   ((eql :list-literal (car reporter)) (cons 'list (mapcar #'transpile-reporter (cdr reporter))))
   ((eql :reporter-block (car reporter)) (transpile-reporter-block reporter))
+  ((eql :token (car reporter)) (cadr reporter))
   ((and (symbolp (car reporter)) (find (car reporter) *local-variables*))
    (intern (symbol-name (car reporter)) clnl:*model-package*))
   ((not (find-prim (car reporter))) (error "Couldn't find the reporter for ~S" (car reporter)))
@@ -240,3 +291,7 @@ DESCRIPTION:
 (defcolorprim :brown)
 (defcolorprim :green)
 (defcolorprim :white)
+
+; Boleans
+(defprim :true :reporter (lambda () t))
+(defprim :false :reporter (lambda () nil))