+; 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)
+ ((and (listp (car parsed-ast)) (eql :let (caar parsed-ast))) (list (handle-let parsed-ast)))
+ (t
+ (cons
+ (transpile-command (car parsed-ast))
+ (transpile-commands-inner (cdr parsed-ast))))))
+
+(defun handle-let (parsed-ast &optional vars)
+ (if
+ (and (listp (car parsed-ast)) (eql :let (caar parsed-ast)))
+ (let
+ ((*local-variables* (cons (second (car parsed-ast)) *local-variables*)))
+ (handle-let
+ (cdr parsed-ast)
+ (cons
+ (list
+ (transpile-reporter (second (car parsed-ast)))
+ (transpile-reporter (third (car parsed-ast))))
+ vars)))
+ `(let*
+ ,vars
+ ,@(transpile-commands-inner parsed-ast))))
+
+(defun transpile-command (command)
+ (cond
+ ((not (listp command)) (error "Expected a statement of some sort"))
+ ((not (find-prim (car command))) (error "Couldn't find the command for ~S" (car command)))
+ ((not (prim-command-p (find-prim (car command)))) (error "Expected command, got ~S" (car command)))
+ (t (apply (prim-func (find-prim (car command))) (mapcar #'transpile-reporter (cdr command))))))
+
+(defun transpile-reporter (reporter)