From 82888b4c12ff462e539e9e7746d5268f9c46f330 Mon Sep 17 00:00:00 2001
From: Frank Duncan <frank@kank.net>
Date: Thu, 28 Apr 2016 19:53:56 -0500
Subject: [PATCH] Prims - Implement agent variables, Implement of, who

---
 src/main/clnl.asd         |  1 +
 src/main/nvm/agent.lisp   | 24 ++++++++++++++++++++++++
 src/main/nvm/nvm.lisp     | 32 ++++++++++++++++++++++++++++++--
 src/main/package.lisp     |  2 ++
 src/main/parse.lisp       |  2 ++
 src/main/transpile.lisp   | 11 +++++++++++
 src/test/simpletests.lisp |  3 +++
 7 files changed, 73 insertions(+), 2 deletions(-)
 create mode 100644 src/main/nvm/agent.lisp

diff --git a/src/main/clnl.asd b/src/main/clnl.asd
index 476728e..86c0570 100644
--- a/src/main/clnl.asd
+++ b/src/main/clnl.asd
@@ -9,6 +9,7 @@
               (:file "parse")
               (:file "code-parse")
               (:file "nvm/base")
+              (:file "nvm/agent")
               (:file "nvm/utils")
               (:file "nvm/nvm")
               (:file "nvm/topology")
diff --git a/src/main/nvm/agent.lisp b/src/main/nvm/agent.lisp
new file mode 100644
index 0000000..93da162
--- /dev/null
+++ b/src/main/nvm/agent.lisp
@@ -0,0 +1,24 @@
+(in-package #:clnl-nvm)
+
+(defun agent-value (var &optional (agent *self*))
+ "AGENT-VALUE VAR &optional AGENT => RESULT
+
+ARGUMENTS AND VALUES:
+
+  VAR: A variable name
+  AGENT: an agent, defaulting to *self*
+  RESULT: the value of VAR
+
+DESCRIPTION:
+
+  AGENT-VALUE is the general agent variable access function.  For many
+  NetLogo reporters, the compilation results is AGENT-VALUE.  The list of
+  valid values are any builtin variable in the NetLogo dictionary, as well
+  as any *-own variable.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html for builtins"
+ (agent-value-inner agent (intern (string-upcase var) :keyword)))
+
+(defgeneric agent-value-inner (agent var))
+
+(defmethod agent-value-inner ((agent turtle) (var (eql :who))) (turtle-who agent))
diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp
index f2057bd..482498c 100644
--- a/src/main/nvm/nvm.lisp
+++ b/src/main/nvm/nvm.lisp
@@ -55,7 +55,7 @@ DESCRIPTION:
    *turtles*
    (list
     (make-turtle
-     :who *current-id*
+     :who (coerce *current-id* 'double-float)
      :color (coerce (+ 5 (* 10 (clnl-random:next-int 14))) 'double-float)
      :heading (coerce (clnl-random:next-int 360) 'double-float)
      :xcor 0d0
@@ -127,6 +127,32 @@ DESCRIPTION:
    :while agent
    :do (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
 
+(defun of (fn agent-set)
+ "OF FN AGENT-SET => RESULT
+
+ARGUMENTS AND VALUES:
+
+  FN: a function, run on each agent
+  AGENT-SET: a NetLogo agentset
+  RESULT: a list
+
+DESCRIPTION:
+
+  OF is equivalent to of in NetLogo.
+
+  The specified AGENT-SET runs the given FN.  The order in which the agents
+  are run is random each time, and only agents that are in the set at the
+  beginning of the call.  A list is returned of the returned valuse of
+  FN.
+
+  See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#of"
+ (let
+  ((iter (shufflerator agent-set)))
+  (loop
+   :for agent := (funcall iter)
+   :while agent
+   :collect (let ((*myself* *self*) (*self* agent)) (funcall fn)))))
+
 (defun shufflerator (agent-set)
  (let
   ((copy (copy-list agent-set))
@@ -363,6 +389,8 @@ 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)))
+
 (defun current-state ()
  "CURRENT-STATE => WORLD-STATE
 
@@ -410,7 +438,7 @@ DESCRIPTION:
    (lambda (turtle)
     (format nil
      "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",~A"
-     (turtle-who turtle)
+     (dump-object (turtle-who turtle))
      (dump-object (turtle-color turtle))
      (dump-object (turtle-heading turtle))
      (dump-object (turtle-xcor turtle))
diff --git a/src/main/package.lisp b/src/main/package.lisp
index 05f9cd7..964001c 100644
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -66,9 +66,11 @@ into an ast that can be transpiled later."))
  (:use :common-lisp)
  (:export #:export-world #:create-world #:current-state
   ; API as used by transpiled NetLogo programs
+  #:agent-value
   #:ask
   #:create-turtles
   #:die
+  #:of
   #:forward
   #:lookup-color
   #:reset-ticks
diff --git a/src/main/parse.lisp b/src/main/parse.lisp
index eeadd95..2f6b77f 100644
--- a/src/main/parse.lisp
+++ b/src/main/parse.lisp
@@ -239,6 +239,7 @@ DESCRIPTION:
 (defprim :not (:boolean))
 (defprim :nobody ())
 (defprim :one-of (t))
+(defprim :of (:reporter-block :agentset) :infix)
 (defprim :patches ())
 (defprim :pcolor ())
 (defprim :random (:number))
@@ -258,6 +259,7 @@ DESCRIPTION:
 (defprim :tick ())
 (defprim :ticks ())
 (defprim :turtles ())
+(defprim :who ())
 
 ; colors
 (defprim :black ())
diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp
index 9dc373f..0227fe4 100644
--- a/src/main/transpile.lisp
+++ b/src/main/transpile.lisp
@@ -94,6 +94,7 @@ DESCRIPTION:
   ((symbolp reporter) (intern (symbol-name reporter) clnl:*model-package*))
   ((not (listp reporter)) (error "Expected a statement of some sort"))
   ((eql :command-block (car reporter)) (transpile-command-block reporter))
+  ((eql :reporter-block (car reporter)) (transpile-reporter-block reporter))
   ((and (symbolp (car reporter)) (find (car reporter) *local-variables*))
    (intern (symbol-name (car reporter)) clnl:*model-package*))
   ((not (find-prim (car reporter))) (error "Couldn't find the reporter for ~S" (car reporter)))
@@ -103,6 +104,11 @@ DESCRIPTION:
 (defun transpile-command-block (block)
  `(lambda () ,@(transpile-commands-inner (cdr block))))
 
+(defun transpile-reporter-block (block)
+ ;(when (/= (length block) 1) (error "Reporter block invalid ~S" block))
+ `(lambda ()
+   ,@(transpile-reporter (cadr block))))
+
 ; Undoes the previous function :)
 (defun make-command-block-inline (block)
  (cddr block))
@@ -119,6 +125,9 @@ DESCRIPTION:
 (defmacro defprim-alias (name real-symb)
  `(push (list :name ,name :real-symb ,real-symb) *prim-aliases*))
 
+(defmacro defagentvalueprim (name)
+ `(defsimpleprim ,name :reporter (clnl-nvm:agent-value ,name)))
+
 ; We count on the parser to handle arguemnts for us, when collating things.
 
 (defsimpleprim := :reporter cl:equalp)
@@ -143,6 +152,7 @@ DESCRIPTION:
 (defprim-alias :if-else :ifelse)
 (defsimpleprim :lt :command clnl-nvm:turn-left)
 (defkeywordprim :nobody)
+(defsimpleprim :of :reporter clnl-nvm:of)
 (defsimpleprim :reset-ticks :command clnl-nvm:reset-ticks)
 (defsimpleprim :random-float :reporter clnl-nvm:random-float)
 (defsimpleprim :rt :command clnl-nvm:turn-right)
@@ -150,6 +160,7 @@ DESCRIPTION:
 (defsimpleprim :tick :command clnl-nvm:tick)
 (defsimpleprim :ticks :reporter clnl-nvm:ticks)
 (defsimpleprim :turtles :reporter clnl-nvm:turtles)
+(defagentvalueprim :who)
 
 ; 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 f4d6368..5bdb498 100644
--- a/src/test/simpletests.lisp
+++ b/src/test/simpletests.lisp
@@ -149,3 +149,6 @@
 
 (defreportertestwithsetup "ticks 1" "reset-ticks tick tick" "ticks" "2"
  "E1DE30F072D785E0D0B59F28B0F7853E3D3E0D8B")
+
+(defreportertestwithsetup "of / who 1" "crt 10" "[ who ] of turtles" "[5 9 4 3 7 0 1 2 6 8]"
+ "3F39BD2D8D5A1B2333E6C0DB665DBE3DCD5A75CE")
-- 
2.25.1