Prims - Implement with

diff --git a/src/main/nvm/base.lisp b/src/main/nvm/base.lisp
index d93089e32e7b1bacb53a7581d4cb6ef55ce197bd..ba895e38456f65da034ceee932b860125cc56001 100644 (file)
--- a/src/main/nvm/base.lisp
+++ b/src/main/nvm/base.lisp
@@ -17,11 +17,18 @@
  (cond
   ((eql agentset :turtles) *turtles*)
   ((eql agentset :patches) *patches*)
-  ((and (listp agentset) (eql :agentset (car agentset))) (cdr agentset))
+  ((and (listp agentset) (eql :agentset (car agentset))) (cddr agentset))
   (t (error "Doesn't seem to be an agentset: ~A" agentset))))
 
-(defun list->agentset (list)
- (cons :agentset list))
+(defun agentset-breed (agentset)
+ (cond
+  ((eql agentset :turtles) :turtles)
+  ((eql agentset :patches) :patches)
+  ((and (listp agentset) (eql :agentset (car agentset))) (second agentset))
+  (t (error "Doesn't seem to be an agentset: ~A" agentset))))
+
+(defun list->agentset (list breed)
+ (append (list :agentset breed) list))
 
 (defun agentset-p (o)
  (or

diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp
index c590f2f60a7d5e67faa2dbd885630db507271773..67b3ec4855117f4b5d7e904c3335d1fae0908d28 100644 (file)
--- a/src/main/nvm/nvm.lisp
+++ b/src/main/nvm/nvm.lisp
@@ -206,6 +206,30 @@ DESCRIPTION:
   (t
    (error "Of requires an agentset or agent but got: ~A" agent-or-agentset))))
 
+(defun with (agentset fn)
+ "WITH AGENTSET FN => RESULT-AGENTSET
+
+ARGUMENTS AND VALUES:
+
+  AGENTSET: a NetLogo agentset
+  FN: a boolean function, run on each agent to determine if included
+  RESULT-AGENTSET: an agentset of valid agents
+
+DESCRIPTION:
+
+  WITH is equivalent to with in NetLogo.
+
+  Returns a new agentset containing only those agents that reported true
+  when FN is called.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#with"
+ (list->agentset
+  (remove-if-not
+   (lambda (agent)
+    (let ((*myself* *self*) (*self* agent)) (funcall fn)))
+   (agentset-list agentset))
+  (agentset-breed agentset)))
+
 (defun shufflerator (agentset-list)
  (let
   ((copy (copy-list agentset-list))
@@ -459,7 +483,7 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
  (let
   ((new-turtles (loop :repeat n :collect (create-turtle))))
-  (when fn (ask (list->agentset new-turtles) fn))))
+  (when fn (ask (list->agentset new-turtles :turtles) fn))))
 
 (defun reset-ticks ()
  "RESET-TICKS => RESULT
@@ -560,7 +584,10 @@ DESCRIPTION:
 (defmethod dump-object ((o (eql t))) "true")
 (defmethod dump-object ((o (eql nil))) "false")
 
-(defmethod dump-object ((o list)) (format nil "[~{~A~^ ~}]" (mapcar #'dump-object o)))
+(defmethod dump-object ((o list))
+ (cond
+  ((agentset-p o) (format nil "(agentset, ~A ~A)" (dump-object (count o)) (string-downcase (agentset-breed o))))
+  (t (format nil "[~{~A~^ ~}]" (mapcar #'dump-object o)))))
 
 (defmethod dump-object ((o patch))
  (format nil "(patch ~A ~A)" (dump-object (patch-xcor o)) (dump-object (patch-ycor o))))

diff --git a/src/main/package.lisp b/src/main/package.lisp
index d9d95af89b10a14c3259a78d1af9c0a724c9ca58..29f05cc43dd7f68d3824977bfa2c389917e8c938 100644 (file)
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -87,7 +87,8 @@ into an ast that can be transpiled later."))
   #:turtles
   #:tick
   #:ticks
-  #:turn-right #:turn-left)
+  #:turn-right #:turn-left
+  #:with)
  (:documentation
   "CLNL NVM
 

diff --git a/src/main/parse.lisp b/src/main/parse.lisp
index 622723748d606f2d9bcb8565fc1c6c1c72efa543..11af5517e284a97db29cddf9aa6035aeadf2a402 100644 (file)
--- a/src/main/parse.lisp
+++ b/src/main/parse.lisp
@@ -252,7 +252,7 @@ DESCRIPTION:
 (defprim :count (:agentset))
 (defprim :die ())
 (defprim :display ())
-(defprim :with (:reporter-block))
+(defprim :with (:agentset :reporter-block) :infix)
 (defprim :fd (:number))
 (defprim :hatch (:number :command-block))
 ; (defprim :let (t t)) ; keeping this here, commented out, to note that it has special processing

diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp
index 5914a592eefbf634ed417a44e16375754fd55038..1d4a90c446a0a5f897175023433fd382ee76df36 100644 (file)
--- a/src/main/transpile.lisp
+++ b/src/main/transpile.lisp
@@ -175,6 +175,7 @@ DESCRIPTION:
 (defsimpleprim :ticks :reporter clnl-nvm:ticks)
 (defsimpleprim :turtles :reporter clnl-nvm:turtles)
 (defagentvalueprim :who)
+(defsimpleprim :with :reporter clnl-nvm:with)
 
 ; Colors
 (defmacro defcolorprim (color) `(defprim ,color :reporter (lambda () `(clnl-nvm:lookup-color ,,color))))

diff --git a/src/test/simpletests.lisp b/src/test/simpletests.lisp
index a82c5973a66f33863db11fedfd5bcd9a9a1ff0ea..96ce890ef55128de24664bd6ea60747a525a1ab0 100644 (file)
--- a/src/test/simpletests.lisp
+++ b/src/test/simpletests.lisp
@@ -211,3 +211,17 @@
 
 (defsimplereportertest "count 3" "count patches" "9"
  "E1DE30F072D785E0D0B59F28B0F7853E3D3E0D8B")
+
+(defreportertestwithsetup "with 1"
+ "crt 10 [ set color blue ] crt 10 [ set color green ]" "turtles with [ color = blue ]"
+ "(agentset, 10 turtles)"
+ "3FA51464CBF2AD493FA95A52E17768E1D8C8EFBB")
+
+(defreportertestwithsetup "with 2"
+ "crt 10 [ set color blue ] crt 10 [ set color green ]" "turtles with [ color = black ]"
+ "(agentset, 0 turtles)"
+ "3FA51464CBF2AD493FA95A52E17768E1D8C8EFBB")
+
+(defsimplereportertest "with 3" "patches with [ pcolor = green ]"
+ "(agentset, 0 patches)"
+ "E1DE30F072D785E0D0B59F28B0F7853E3D3E0D8B")