From: Frank Duncan Date: Fri, 29 Apr 2016 00:53:56 +0000 (-0500) Subject: Prims - Implement agent variables, Implement of, who X-Git-Tag: v0.1.0~37 X-Git-Url: https://code.consxy.com/gitweb/?a=commitdiff_plain;h=82888b4c12ff462e539e9e7746d5268f9c46f330;p=clnl Prims - Implement agent variables, Implement of, who --- 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")