From: Frank Duncan Date: Sat, 14 May 2016 00:53:19 +0000 (-0500) Subject: Code - procedures handle stop better X-Git-Tag: v0.1.0~13 X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=commitdiff_plain;h=f011c771176fcb272939f01ddf31c1dd267990bf Code - procedures handle stop better --- diff --git a/src/main/main.lisp b/src/main/main.lisp index 35a5961..5d8856e 100644 --- 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*) () - ,@(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 diff --git a/src/test/modeltests.lisp b/src/test/modeltests.lisp index 79ebc4b..8f2d12a 100644 --- a/src/test/modeltests.lisp +++ b/src/test/modeltests.lisp @@ -108,3 +108,17 @@ to go 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")