Code - procedures handle stop better

diff --git a/src/main/main.lisp b/src/main/main.lisp
index 35a5961d399ec88c0753bccc207756201d0c2313..5d8856e3522c9eec429a58b1d38f3c3963262919 100644 (file)
--- a/src/main/main.lisp
+++ b/src/main/main.lisp
@@ -115,14 +115,15 @@ DESCRIPTION:
 
 (defun create-proc-body (proc prims)
  `(,(intern (string-upcase (car proc)) *model-package*) ()
 
 (defun create-proc-body (proc prims)
  `(,(intern (string-upcase (car proc)) *model-package*) ()

-   ,@(cdr ; remove the progn, cuz it looks nicer
-      (clnl-transpiler:transpile (cadr proc)
-       (mapcar
-        (lambda (prim)
-         (if (getf prim :macro) ; The reason we do this is because with macros, we want to evaluate them in
-                                ; this scope while preserving them for the generational purposes below
-          (append (list :macro (eval (getf prim :macro))) prim)
-          prim)) prims)))))
+   (clnl-nvm:with-stop-handler
+    ,@(cdr ; remove the progn, cuz it looks nicer
+       (clnl-transpiler:transpile (cadr proc)
+        (mapcar
+         (lambda (prim)
+          (if (getf prim :macro) ; The reason we do this is because with macros, we want to evaluate them in
+                                 ; this scope while preserving them for the generational purposes below
+           (append (list :macro (eval (getf prim :macro))) prim)
+           prim)) prims))))))

 
 (defun model->single-form-lisp (model &key (seed 15) initialize-interface netlogo-callback)
  (multiple-value-bind
 
 (defun model->single-form-lisp (model &key (seed 15) initialize-interface netlogo-callback)
  (multiple-value-bind

diff --git a/src/test/modeltests.lisp b/src/test/modeltests.lisp
index 79ebc4ba261614016a578dd439c870a25c936286..8f2d12a094e9ddbaaf63e1edf3179d8d7e8b2c33 100644 (file)
--- a/src/test/modeltests.lisp
+++ b/src/test/modeltests.lisp
@@ -108,3 +108,17 @@ to go
 end"
  "setup go"
  "2614B99F64ACFA2BD64D66B129C0A17F2150FADD")
 end"
  "setup go"
  "2614B99F64ACFA2BD64D66B129C0A17F2150FADD")

+
+(defmodelcommandtest "procedures stop"
+ "to setup
+  create-turtles 5
+  stop
+  create-turtles 5
+end
+
+to go
+  if 5 < count turtles [ stop ]
+  crt 1
+end"
+ "setup go go"
+ "438848EF35C6B0D28D50961072C70FCC02BB4FD8")