X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=blobdiff_plain;f=src%2Fmain%2Fmain.lisp;h=0997963960d63dff7d1b8d51ec73ea96b118ed2d;hp=5d8856e3522c9eec429a58b1d38f3c3963262919;hb=807df6b;hpb=3ae0c35e27580b247652dff608dd8c4d29f16bff diff --git a/src/main/main.lisp b/src/main/main.lisp index 5d8856e..0997963 100644 --- a/src/main/main.lisp +++ b/src/main/main.lisp @@ -132,28 +132,23 @@ DESCRIPTION: (let ((globals (append - (clnl-model:widget-globals model) - (clnl-code-parser:globals code-ast)))) - `(prog () - ; First declare is in case we don't use it, it shows up in export correctly - ,@(when (and (> (length globals) 0) netlogo-callback) - `((declare (special ,@(mapcar (lambda (pair) (intern (string-upcase (car pair)) *model-package*)) globals))))) - (let - ,(mapcar (lambda (pair) (list (intern (string-upcase (car pair)) *model-package*) (cadr pair))) globals) - ; We declare twice rather than once and doing a bunch of setfs - ,@(when (and (> (length globals) 0) netlogo-callback) - `((declare (special ,@(mapcar (lambda (pair) (intern (string-upcase (car pair)) *model-package*)) globals))))) - (labels - ,(mapcar - (lambda (proc) (create-proc-body proc prims)) - (clnl-code-parser:procedures code-ast)) - (clnl-random:set-seed ,seed) - ,(create-world-call model globals code-ast) - ,@(when netlogo-callback - `((funcall ,netlogo-callback - (lambda (,(intern "NETLOGO-CODE" *model-package*)) - ,(netlogo-callback-body prims))))) - ,@(when initialize-interface `((clnl-interface:initialize :dims ',(clnl-model:world-dimensions model)))))))))) + (clnl-code-parser:globals code-ast) + (clnl-model:widget-globals model)))) + `(progn + ,@(mapcar + (lambda (pair) `(defparameter ,(intern (string-upcase (car pair)) *model-package*) ,(cadr pair))) + globals) + (labels + ,(mapcar + (lambda (proc) (create-proc-body proc prims)) + (clnl-code-parser:procedures code-ast)) + (clnl-random:set-seed ,seed) + ,(create-world-call model globals code-ast) + ,@(when netlogo-callback + `((funcall ,netlogo-callback + (lambda (,(intern "NETLOGO-CODE" *model-package*)) + ,(netlogo-callback-body prims))))) + ,@(when initialize-interface `((clnl-interface:initialize :dims ',(clnl-model:world-dimensions model))))))))) (setf (documentation 'model->single-form-lisp 'function) "MODEL->SINGLE-FORM-LISP MODEL &key SEED INITIALIZE-INTERFACE NETLOGO-CALLBACK => FORM