From 083d6c212147c2242f0513924e931bcdafd641c9 Mon Sep 17 00:00:00 2001
From: Frank Duncan <frank@kank.net>
Date: Sun, 1 May 2016 01:16:20 -0500
Subject: [PATCH] Prims - Implement with

---
 src/main/nvm/base.lisp    | 13 ++++++++++---
 src/main/nvm/nvm.lisp     | 31 +++++++++++++++++++++++++++++--
 src/main/package.lisp     |  3 ++-
 src/main/parse.lisp       |  2 +-
 src/main/transpile.lisp   |  1 +
 src/test/simpletests.lisp | 14 ++++++++++++++
 6 files changed, 57 insertions(+), 7 deletions(-)

diff --git a/src/main/nvm/base.lisp b/src/main/nvm/base.lisp
index d93089e..ba895e3 100644
--- 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 c590f2f..67b3ec4 100644
--- 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 d9d95af..29f05cc 100644
--- 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 6227237..11af551 100644
--- 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 5914a59..1d4a90c 100644
--- 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 a82c597..96ce890 100644
--- 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")
-- 
2.25.1