Prims - Implement stop

diff --git a/src/main/main.lisp b/src/main/main.lisp
index eee8e48f48b6e7930f5cff269f6b378a7825b058..3acd6e366f193e9fa1e4aaeee248fc24734f7897 100644 (file)
--- a/src/main/main.lisp
+++ b/src/main/main.lisp
@@ -62,7 +62,7 @@ DESCRIPTION:
 
   RUN-COMMANDS will take NetLogo commands, put them through the various
   stages need to turn them into Common Lisp code, and run it."
- (eval (clnl-transpiler:transpile-commands (clnl-parser:parse (clnl-lexer:lex cmds)))))
+ (clnl-nvm:with-stop-handler (eval (clnl-transpiler:transpile-commands (clnl-parser:parse (clnl-lexer:lex cmds))))))
 
 (defun run-reporter (reporter)
  "RUN-REPORTER REPORTER => RESULT

diff --git a/src/main/nvm/base.lisp b/src/main/nvm/base.lisp
index 9d07e9b1280ff677b51faf1e65993f924c59cc80..fc2db581e6395ae764753febb0c8d8f52e308626 100644 (file)
--- a/src/main/nvm/base.lisp
+++ b/src/main/nvm/base.lisp
@@ -11,6 +11,23 @@
 (defvar *ticks* nil)
 (defvar *breeds* nil)
 
+(define-condition stop nil nil)
+
+(defmacro with-stop-handler (&rest forms)
+ "MACRO WITH-STOP-HANDLER &rest FORMS => HANDLED-FORM
+
+ARGUMENTS AND VALUES:
+
+  FORMS: body to be handled
+  HANDLED-FORM: body with handling
+
+DESCRIPTION:
+
+  WITH-STOP-HANDLER is a convenience macro to handle when
+  programs issue a stop condition.  When one does, a simple
+  :stop is returned."
+ `(handler-case (progn ,@forms) (stop (s) :stop)))
+
 (defstruct turtle who color heading xcor ycor (label "") (label-color 9.9d0) (size 1d0) shape)
 (defstruct patch color xcor ycor)
 

diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp
index 9ccb80d7993c27e36cf77e633da27589a80b6db9..a272a34526490aa84b4d189831beef373dd1fa54 100644 (file)
--- a/src/main/nvm/nvm.lisp
+++ b/src/main/nvm/nvm.lisp
@@ -150,9 +150,9 @@ DESCRIPTION:
     (loop
      :for agent := (funcall iter)
      :while agent
-     :do (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
+     :do (let ((*myself* *self*) (*self* agent)) (with-stop-handler (funcall fn))))))
   ((agent-p agent-or-agentset)
-   (let ((*myself* *self*) (*self* agent-or-agentset)) (funcall fn)))
+   (let ((*myself* *self*) (*self* agent-or-agentset)) (with-stop-handler (funcall fn))))
   (t
    (error "Ask requires an agentset or agent but got: ~A" agent-or-agentset))))
 
@@ -203,6 +203,22 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#display"
  nil)
 
+(defun stop ()
+ "STOP => RESULT
+
+ARGUMENTS AND VALUES:
+
+  RESULT: undefined
+
+DESCRIPTION:
+
+  Returns from the current stop block, which will halt the currently running
+  thing, be that the program, current ask block, or procedure.  Stop has odd
+  semantics that are best gleaned from the actual NetLogo manual.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#stop"
+ (error (make-condition 'stop)))
+
 (defun of (fn agent-or-agentset)
  "OF FN AGENT-OR-AGENTSET => RESULT
 

diff --git a/src/main/package.lisp b/src/main/package.lisp
index 07666e7374406dea9f709ccb61b6c8ed8c5bc737..89a0ab3c82c61fc575006009fa97944488d9beec 100644 (file)
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -65,7 +65,7 @@ into an ast that can be transpiled later."))
 (defpackage #:clnl-nvm
  (:use :common-lisp)
  (:shadow #:random #:count)
- (:export #:export-world #:create-world #:current-state
+ (:export #:export-world #:create-world #:current-state #:with-stop-handler
   ; API as used by transpiled NetLogo programs
   #:agent-value
   #:ask
@@ -88,6 +88,7 @@ into an ast that can be transpiled later."))
   #:set-default-shape
   #:setxy
   #:show
+  #:stop
   #:turtles
   #:tick
   #:ticks

diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp
index 8cf44e7eab3da22a6c279f4a486d19dd64b4be0a..b0fcb47790654cbc05e6868b20c732b1533caab1 100644 (file)
--- a/src/main/transpile.lisp
+++ b/src/main/transpile.lisp
@@ -177,6 +177,7 @@ DESCRIPTION:
 (defsimpleprim :set-default-shape :command clnl-nvm:set-default-shape)
 (defsimpleprim :setxy :command clnl-nvm:setxy)
 (defsimpleprim :show :command clnl-nvm:show)
+(defsimpleprim :stop :command clnl-nvm:stop)
 (defagentvalueprim :size)
 (defsimpleprim :tick :command clnl-nvm:tick)
 (defsimpleprim :ticks :reporter clnl-nvm:ticks)

diff --git a/src/test/simpletests.lisp b/src/test/simpletests.lisp
index d85675db12428ec64b7a8d8c0ad0d20604f4b9a7..3aef8e2b8e39e9425b3e056bbfa463a7ac18ac56 100644 (file)
--- a/src/test/simpletests.lisp
+++ b/src/test/simpletests.lisp
@@ -253,3 +253,9 @@
 
 (defsimplecommandtest "clear-all 1" "crt 10 ask patches [ set pcolor random 100 ] clear-all"
  "7B5DF28923D7FD72158018A876DE8ED02CFB0882")
+
+(defsimplecommandtest "stop 1" "crt 10 stop crt 10"
+ "A925E39EC022967568D238D31F70F0A375024A89")
+
+(defsimplecommandtest "stop 2" "crt 10 ask turtles [ fd 1 stop fd 1 ]"
+ "A6C980CC9843CDD211ABD9C13899010D555F3DC5")