Prims - Implement agent variables, Implement of, who

diff --git a/src/main/clnl.asd b/src/main/clnl.asd
index 476728e923b9ae6988bb9dcddb921d462e750348..86c0570d8333ccd2da77e7ede87a4b4c2eef069a 100644 (file)
--- a/src/main/clnl.asd
+++ b/src/main/clnl.asd
@@ -9,6 +9,7 @@
               (:file "parse")
               (:file "code-parse")
               (:file "nvm/base")
               (:file "parse")
               (:file "code-parse")
               (:file "nvm/base")

+              (:file "nvm/agent")

               (:file "nvm/utils")
               (:file "nvm/nvm")
               (:file "nvm/topology")
               (: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 (file)
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 f2057bd7605540eb65e94917d580dbadd8e91377..482498c9a1d403029ae9da83cea5f6fb2da86355 100644 (file)
--- a/src/main/nvm/nvm.lisp
+++ b/src/main/nvm/nvm.lisp
@@ -55,7 +55,7 @@ DESCRIPTION:
    *turtles*
    (list
     (make-turtle
    *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
      :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)))))
 
    :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))
 (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 (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
 
 (defun current-state ()
  "CURRENT-STATE => WORLD-STATE
 


@@ -410,7 +438,7 @@ DESCRIPTION:
    (lambda (turtle)
     (format nil
      "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",~A"
    (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))
      (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 05f9cd7b061d7d4afd80127af2da9060caf870c9..964001c62c46bd55a05516c9aab4de247383af56 100644 (file)
--- 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
  (:use :common-lisp)
  (:export #:export-world #:create-world #:current-state
   ; API as used by transpiled NetLogo programs

+  #:agent-value

   #:ask
   #:create-turtles
   #:die
   #:ask
   #:create-turtles
   #:die

+  #:of

   #:forward
   #:lookup-color
   #:reset-ticks
   #:forward
   #:lookup-color
   #:reset-ticks

diff --git a/src/main/parse.lisp b/src/main/parse.lisp
index eeadd95d840122cd2b501160eae125f550484020..2f6b77f2a6a859215e44ebeb9d655838f092a2d1 100644 (file)
--- 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 :not (:boolean))
 (defprim :nobody ())
 (defprim :one-of (t))

+(defprim :of (:reporter-block :agentset) :infix)

 (defprim :patches ())
 (defprim :pcolor ())
 (defprim :random (:number))
 (defprim :patches ())
 (defprim :pcolor ())
 (defprim :random (:number))


@@ -258,6 +259,7 @@ DESCRIPTION:
 (defprim :tick ())
 (defprim :ticks ())
 (defprim :turtles ())
 (defprim :tick ())
 (defprim :ticks ())
 (defprim :turtles ())

+(defprim :who ())

 
 ; colors
 (defprim :black ())
 
 ; colors
 (defprim :black ())

diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp
index 9dc373f6b74cbc29750fb6b1fc034e23604ec4e0..0227fe4144ea9394937f8bdd1e77a5309b667015 100644 (file)
--- 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))
   ((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)))
   ((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-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))
 ; 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 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)
 ; 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)
 (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)
 (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)
 (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))))
 
 ; 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 f4d6368f62097d7f3578a93be53319c220260d1e..5bdb498e337a355b090c702a86f4e81f640e486d 100644 (file)
--- 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 "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")