From 687ec5dde86dc5e9a46f1441051d2b1da13c4478 Mon Sep 17 00:00:00 2001
From: Frank Duncan <frank@kank.net>
Date: Sat, 4 Jun 2016 11:34:55 -0500
Subject: [PATCH] Model export as lisp - Wolf sheep

---
 bin/buildlinuxexec.sh            |  3 +-
 src/main/extensions/cli/cli.lisp |  2 +-
 src/main/main.lisp               | 58 ++++++++++++++++++++++++++++++++
 src/main/package.lisp            |  3 +-
 4 files changed, 63 insertions(+), 3 deletions(-)

diff --git a/bin/buildlinuxexec.sh b/bin/buildlinuxexec.sh
index 37c6d8a..d13d6fe 100755
--- a/bin/buildlinuxexec.sh
+++ b/bin/buildlinuxexec.sh
@@ -31,8 +31,9 @@ mkdir -p tmp/deps/
 
 SBCL_HOME="" tmp/sbcl/bin/sbcl --core tmp/sbcl/lib/sbcl/sbcl.core \
   --eval "(require 'asdf)" \
-  --eval "(asdf:initialize-source-registry '(:source-registry (:tree \"${PWD}/tmp/deps\") (:directory \"${PWD}/src/main\") :IGNORE-INHERITED-CONFIGURATION))" \
+  --eval "(asdf:initialize-source-registry '(:source-registry (:tree \"${PWD}/tmp/deps\") (:tree \"${PWD}/src/main\") :IGNORE-INHERITED-CONFIGURATION))" \
   --eval "(asdf:load-system :clnl)" \
+  --eval "(asdf:load-system :clnl-extension-cli)" \
   --eval "(asdf:clear-output-translations)" \
   --eval '(sb-ext:save-lisp-and-die "clnl" :executable t :toplevel (function clnl:run))'
 
diff --git a/src/main/extensions/cli/cli.lisp b/src/main/extensions/cli/cli.lisp
index 6d24da7..3ca0983 100644
--- a/src/main/extensions/cli/cli.lisp
+++ b/src/main/extensions/cli/cli.lisp
@@ -31,5 +31,5 @@ DESCRIPTION:
     (:|:LOAD|
      (concatenate 'string
       ":load <filename> loads up a model into the current clnl instance."
-      " Try :load \"resources/models/Wolf Sheep Predation.nlogo\""))
+      " Try :load \"Wolf Sheep Predation.nlogo\""))
     (t (format nil "Don't have help for ~S" token))))))
diff --git a/src/main/main.lisp b/src/main/main.lisp
index a226642..b0d82eb 100644
--- a/src/main/main.lisp
+++ b/src/main/main.lisp
@@ -129,6 +129,64 @@ DESCRIPTION:
            prim)) prims)))
     :undefined)))
 
+(defun nlogo->lisp (str pkg-symb boot-fn &key (seed 15) initialize-interface netlogo-callback-fn)
+ (let*
+  ((model (clnl-model:read-from-nlogo str))
+   (shadow-symbs
+    (remove nil
+     (mapcar
+      (lambda (proc-symb)
+       (multiple-value-bind (found external) (find-symbol (symbol-name proc-symb) :cl)
+        (when (and found (eql :external external)) proc-symb)))
+      (mapcar #'car
+       (clnl-code-parser:procedures
+        (clnl-code-parser:parse
+         (clnl-lexer:lex (clnl-model:code model))
+         (clnl-model:widget-globals model))))))))
+  (eval
+   `(progn
+     (defpackage ,pkg-symb (:use :common-lisp) (:shadow ,@shadow-symbs))
+     (,(intern "IN-PACKAGE" :cl) ,pkg-symb) ; intern because of style check
+     (cons
+      `(defpackage ,,pkg-symb (:use :common-lisp) (:shadow ,,@shadow-symbs))
+      (let
+       ((clnl:*model-package* (find-package ,pkg-symb)))
+       (clnl:model->multi-form-lisp
+        ,model
+        (intern (symbol-name ',boot-fn) ,pkg-symb)
+        :seed ,seed
+        :initialize-interface ,initialize-interface
+        :netlogo-callback-fn ,netlogo-callback-fn)))))))
+
+(setf (documentation 'nlogo->lisp 'function)
+ "NLOGO->LISP STR PKG-SYMB BOOT-FN &key SEED INITIALIZE-INTERFACE NETLOGO-CALLBACK-FN => FORMS
+
+ARGUMENTS AND VALUES:
+
+  STR: A stream holding an nlogo file
+  PKG-SYMB: A symbol for the generated package
+  BOOT-FN: A function name
+  SEED: An integer, defaults to 15
+  INITIALIZE-INTERFACE: A boolean
+  NETLOGO-CALLBACK-FN: a symbol
+  FORMS: A list of common lisp form
+
+DESCRIPTION:
+
+  NLOGO->LISP takes a stream STR and returns a multi form lisp program,
+  that when executed, sets up the model.  See MODEL->MULTI-FORM-LISP for
+  more information.
+
+  NLOGO->LISP does extra work of setting up the package to be named by
+  PKG-SYMB in order to correctly shadow common lisp functions.
+
+  It will also change the current package to the one created for the model
+  named by PKG-SYMB.
+
+EXAMPLES:
+
+  (with-open-file (str \"Wolf Sheep Predation.nlogo\") (nlogo->lisp str :wolfsheep 'boot)) => (forms)")
+
 (defun model->single-form-lisp (model &key (seed 15) initialize-interface netlogo-callback)
  (multiple-value-bind
   (code-ast prims)
diff --git a/src/main/package.lisp b/src/main/package.lisp
index 8bafc43..73ae492 100644
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -1,7 +1,8 @@
 (defpackage #:clnl (:use :common-lisp)
  (:export
   #:run #:boot #:run-commands #:run-reporter #:*model-package*
-  #:model->multi-form-lisp #:model->single-form-lisp)
+  #:model->multi-form-lisp #:model->single-form-lisp
+  #:nlogo->lisp)
  (:documentation
   "Main CLNL package
 
-- 
2.25.1