fi
TEST=$@
-sbcl --eval "(asdf:load-system :cl-nl-test)" --eval "(quit)" &> /dev/null
+sbcl --eval "(asdf:load-system :clnl-test)" --eval "(quit)" &> /dev/null
runtestfn() {
sbcl --noinform --disable-ldb --lose-on-corruption --end-runtime-options \
- --eval "(asdf:load-system :cl-nl-test)" \
- --eval "(cl-nl-test::$1 \"$TEST\")" \
+ --eval "(asdf:load-system :clnl-test)" \
+ --eval "(clnl-test::$1 \"$TEST\")" \
--eval "(quit)" 2> /dev/null | sed -n '/^----$/,$p' | tail -n +2
}
(require 'asdf)
(setf asdf:*central-registry* (list #p"deps/"))
-(asdf:load-system :cl-nl)
-(cl-nl:run)
+(asdf:load-system :clnl)
+(clnl:run)
#!/bin/bash
-sbcl --eval "(asdf:load-system :cl-nl-test)" --eval "(quit)" &> /dev/null
+sbcl --eval "(asdf:load-system :clnl-test)" --eval "(quit)" &> /dev/null
rlwrap sbcl --script bin/test-mode.lisp
(require 'asdf)
(setf asdf:*central-registry* (list #p"deps/"))
-(asdf:load-system :cl-nl-test)
-(cl-nl-test:run)
+(asdf:load-system :clnl-test)
+(clnl-test:run)
(require 'asdf)
(setf asdf:*central-registry* (list #p"deps/"))
-(asdf:load-system :cl-nl-test)
-(sb-ext:quit :unix-status (if (cl-nl-test:run-all-tests) 0 1))
+(asdf:load-system :clnl-test)
+(sb-ext:quit :unix-status (if (clnl-test:run-all-tests) 0 1))
+++ /dev/null
-../src/test/cl-nl-test.asd
\ No newline at end of file
+++ /dev/null
-../src/main/cl-nl.asd
\ No newline at end of file
--- /dev/null
+../src/test/clnl-test.asd
\ No newline at end of file
--- /dev/null
+../src/main/clnl.asd
\ No newline at end of file
+++ /dev/null
-(asdf:defsystem cl-nl
- :name "Experiment"
- :version "0.0.1"
- :maintainer "Frank Duncan (frank@kank.com)"
- :author "Frank Duncan (frank@kank.com)"
- :serial t
- :components ((:file "package")
- (:file "lex")
- (:file "parse")
- (:file "nvm")
- (:file "transpile")
- (:file "random")
- (:file "main"))
- :depends-on (:cl-ppcre :mt19937))
--- /dev/null
+(asdf:defsystem clnl
+ :name "Experiment"
+ :version "0.0.1"
+ :maintainer "Frank Duncan (frank@kank.com)"
+ :author "Frank Duncan (frank@kank.com)"
+ :serial t
+ :components ((:file "package")
+ (:file "lex")
+ (:file "parse")
+ (:file "nvm")
+ (:file "transpile")
+ (:file "random")
+ (:file "main"))
+ :depends-on (:cl-ppcre :mt19937))
-(in-package #:cl-nl.lexer)
+(in-package #:clnl-lexer)
; I played around with using #'read for netlogo code, which would have been neat.
; However, it provides too many instances where people could inject CL code
-(in-package #:cl-nl)
+(in-package #:clnl)
(defun e (ast) ast)
(defun r (str)
(let*
- ((lexed-ast (let ((ast (cl-nl.lexer:lex str))) (format t "Via lexing, AST for~%~S~% became~%~S~%~%" str ast) ast))
- (parsed-ast (let ((ast (cl-nl.parser:parse lexed-ast))) (format t "Via parsing, AST for~%~S~% became~%~S~%~%" lexed-ast ast) ast))
- (transpiled-ast (let ((ast (cl-nl.transpiler:transpile-commands parsed-ast))) (format t "Via transpiling, AST for~%~S~% became~%~S~%" parsed-ast ast) ast)))
+ ((lexed-ast (let ((ast (clnl-lexer:lex str))) (format t "Via lexing, AST for~%~S~% became~%~S~%~%" str ast) ast))
+ (parsed-ast (let ((ast (clnl-parser:parse lexed-ast))) (format t "Via parsing, AST for~%~S~% became~%~S~%~%" lexed-ast ast) ast))
+ (transpiled-ast (let ((ast (clnl-transpiler:transpile-commands parsed-ast))) (format t "Via transpiling, AST for~%~S~% became~%~S~%" parsed-ast ast) ast)))
(eval transpiled-ast)))
(defun p (result) result)
do (p (e (r str)))))
(defun boot ()
- (cl-nl.random:set-seed 15)
- (cl-nl.nvm:create-world)
+ (clnl-random:set-seed 15)
+ (clnl-nvm:create-world)
)
(defun run-commands (cmds)
- (eval (cl-nl.transpiler:transpile-commands (cl-nl.parser:parse (cl-nl.lexer:lex cmds)))))
+ (eval (clnl-transpiler:transpile-commands (clnl-parser:parse (clnl-lexer:lex cmds)))))
(defun run-reporter (reporter)
- (eval (cl-nl.transpiler:transpile-reporter (car (cl-nl.parser:parse (cl-nl.lexer:lex reporter))))))
+ (eval (clnl-transpiler:transpile-reporter (car (clnl-parser:parse (clnl-lexer:lex reporter))))))
-(in-package #:cl-nl.nvm)
+(in-package #:clnl-nvm)
; This is the engine. Yay.
(defvar *self* nil)
(defun show (n)
+ "Prints value in the Command Center, preceded by this agent, and followed by a carriage return.
+
+See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show"
(format t "Showing: ~A~%" (dump-object n)))
(defun create-turtle ()
*turtles*
(list
(make-turtle :who *current-id*
- :color (coerce (+ 5 (* 10 (cl-nl.random:next-int 14))) 'double-float)
- :heading (coerce (cl-nl.random:next-int 360) 'double-float)
+ :color (coerce (+ 5 (* 10 (clnl-random:next-int 14))) 'double-float)
+ :heading (coerce (clnl-random:next-int 360) 'double-float)
:xcor 0d0
:ycor 0d0))))
(incf *current-id*))
-(defun turtles () *turtles*)
+(defun turtles ()
+"Reports the agentset consisting of all turtles.
+
+See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles"
+ *turtles*)
(defun ask (agent-set fn)
+"The specified agent or agentset runs the given commands.
+
+See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask"
(let
((iter (shufflerator agent-set)))
(loop for agent = (funcall iter)
(flet
((fetch ()
(let
- ((idx (when (< i (1- (length copy))) (+ i (cl-nl.random:next-int (- (length copy) i))))))
+ ((idx (when (< i (1- (length copy))) (+ i (clnl-random:next-int (- (length copy) i))))))
(when idx (setf agent (nth idx copy)))
(when idx (setf (nth idx copy) (nth i copy)))
(incf i))))
(t (let ((result agent)) (fetch) result)))))))
(defun random-float (n)
- (cl-nl.random:next-double n))
+"If number is positive, returns a random floating point number greater than or equal to 0 but strictly less than number.
+
+If number is negative, returns a random floating point number less than or equal to 0, but strictly greater than number.
+
+If number is zero, the result is always 0.
-(defun fd (n)
+See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-float"
+ (clnl-random:next-double n))
+
+(defun forward (n)
+"The turtle moves forward by number steps, one step at a time. (If number is negative, the turtle moves backward.)
+
+See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward"
(when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude (~A)" *self*))
(setf (turtle-xcor *self*) (+ (turtle-xcor *self*) (* n (sin (* pi (/ (turtle-heading *self*) 180))))))
(setf (turtle-ycor *self*) (+ (turtle-ycor *self*) (* n (cos (* pi (/ (turtle-heading *self*) 180)))))))
(defun create-turtles (n)
+"Creates number new turtles at the origin. New turtles have random integer
+headings and the color is randomly selected from the 14 primary colors.
+
+If commands are supplied, the new turtles immediately run them.
+
+See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
(loop for i from 1 to n do (create-turtle)))
(defun create-world ()
(format nil "~{~A~%~}"
(list
(format nil "~S" "RANDOM STATE")
- (format nil "~S" (cl-nl.random:export))
+ (format nil "~S" (clnl-random:export))
""
(format nil "~S" "GLOBALS")
"\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\",\"nextIndex\",\"directed-links\",\"ticks\","
-(defpackage #:cl-nl (:use :common-lisp)
+(defpackage #:clnl (:use :common-lisp)
(:export :run :boot :run-commands :run-reporter))
-(defpackage #:cl-nl.parser
+(defpackage #:clnl-parser
(:use :common-lisp)
(:export :parse))
-(defpackage #:cl-nl.random
+(defpackage #:clnl-random
(:use :common-lisp)
(:shadow #:export)
(:export #:export #:set-seed #:next-int #:next-double))
-(defpackage #:cl-nl.transpiler
+(defpackage #:clnl-transpiler
(:use :common-lisp)
(:export :transpile-commands :transpile-reporter))
-(defpackage #:cl-nl.nvm
+(defpackage #:clnl-nvm
(:use :common-lisp)
- (:export :export-world :create-world :dump-object))
+ (:export :export-world :create-world :dump-object
+ ; API as used by transpiled NetLogo programs
+ #:ask
+ #:create-turtles
+ #:forward
+ #:random-float
+ #:show
+ #:turtles
-(defpackage #:cl-nl.lexer
+ ))
+
+(defpackage #:clnl-lexer
(:use :common-lisp)
(:export :lex))
+
+(defpackage #:clnl-interface
+ (:use :common-lisp))
+
-(in-package #:cl-nl.parser)
+(in-package #:clnl-parser)
; Ok, after thinking about this a little, the parser is completely contextual
; based on what has come before. We can't do a contextless parsing, like we
-(in-package #:cl-nl.random)
+(in-package #:clnl-random)
; This is a wrapper around the very nice mersenne twister mt19937 to match
; NetLogo's implementation that tries to match how java.util.Random works
-(in-package #:cl-nl.transpiler)
+(in-package #:clnl-transpiler)
; This is responsible for taking an ast and turning it into valid CL code
; targeting the nvm. Here is where start to care about commands versus reporters
; or a reporter. So monitors can say "hey, transpile this reporter" and we'll check
; to make sure it actually is.
+; Furthermore, the lisp code that any netlogo code would be transpiled to should
+; use exported symbols, such that anyone writing NetLogo code in lisp could use
+; the nvm in the same way that comes out of this transpiler
+
(defparameter *prims* nil)
(defun prim-name (prim) (getf prim :name))
*prims*))
; We count on the parser to handle arguemnts for us, when collating things.
-(defprim :ask :command cl-nl.nvm::ask)
-(defprim :crt :command cl-nl.nvm::create-turtles)
-(defprim :fd :command cl-nl.nvm::fd)
-(defprim :random-float :reporter cl-nl.nvm::random-float)
-(defprim :show :command cl-nl.nvm::show)
-(defprim :turtles :reporter cl-nl.nvm::turtles)
+(defprim :ask :command clnl-nvm:ask)
+(defprim :crt :command clnl-nvm:create-turtles)
+(defprim :fd :command clnl-nvm:forward)
+(defprim :random-float :reporter clnl-nvm:random-float)
+(defprim :show :command clnl-nvm:show)
+(defprim :turtles :reporter clnl-nvm:turtles)
+++ /dev/null
-(asdf:defsystem cl-nl-test
- :name "Experiment Tests"
- :version "0.0.1"
- :maintainer "Frank Duncan (frank@kank.com)"
- :author "Frank Duncan (frank@kank.com)"
- :serial t
- :components ((:file "package")
- (:file "main")
- (:file "simpletests"))
- :depends-on (:cl-nl :ironclad))
--- /dev/null
+(asdf:defsystem clnl-test
+ :name "Experiment Tests"
+ :version "0.0.1"
+ :maintainer "Frank Duncan (frank@kank.com)"
+ :author "Frank Duncan (frank@kank.com)"
+ :serial t
+ :components ((:file "package")
+ (:file "main")
+ (:file "simpletests"))
+ :depends-on (:clnl :ironclad))
-(in-package #:cl-nl-test)
+(in-package #:clnl-test)
(defparameter *tests* nil)
`(defsimpletest
,name
(lambda ()
- (cl-nl:boot)
- (cl-nl:run-commands ,commands)
+ (clnl:boot)
+ (clnl:run-commands ,commands)
(string= ,checksum (checksum-world)))
(lambda ()
- (cl-nl:boot)
- (cl-nl:run-commands ,commands)
+ (clnl:boot)
+ (clnl:run-commands ,commands)
(format nil "~A~A"
- (cl-nl.nvm:export-world)
+ (clnl-nvm:export-world)
(checksum-world)))
"bin/runcmd.scala"
(format nil "~A~%" ,commands)))
`(defsimpletest
,name
(lambda ()
- (cl-nl:boot)
+ (clnl:boot)
(and
- (string= (cl-nl.nvm:dump-object (cl-nl:run-reporter ,reporter)) ,value)
+ (string= (clnl-nvm:dump-object (clnl:run-reporter ,reporter)) ,value)
(string= ,checksum (checksum-world))))
(lambda ()
- (cl-nl:boot)
+ (clnl:boot)
(format nil "~A~%~A~A"
- (cl-nl.nvm:dump-object (cl-nl:run-reporter ,reporter))
- (cl-nl.nvm:export-world)
+ (clnl-nvm:dump-object (clnl:run-reporter ,reporter))
+ (clnl-nvm:export-world)
(checksum-world)))
"bin/runreporter.scala"
(format nil "~A~%" ,reporter)))
(map 'list #'identity
(ironclad:digest-sequence
:sha1
- (map '(vector (unsigned-byte 8)) #'char-code (cl-nl.nvm:export-world))))))
+ (map '(vector (unsigned-byte 8)) #'char-code (clnl-nvm:export-world))))))
(defun run ()
(loop for str = (progn (format t "> ") (force-output) (read-line))
while str
- do (progn (asdf:load-system :cl-nl-test) (run-tests-matching str))))
+ do (progn (asdf:load-system :clnl-test) (run-tests-matching str))))
-(defpackage #:cl-nl-test (:use :common-lisp :cl-nl)
+(defpackage #:clnl-test (:use :common-lisp :clnl)
(:export :run-all-tests :run :test-debug))
-(in-package #:cl-nl-test)
+(in-package #:clnl-test)
(defsimplecommandtest "Nothing" "" "E1DE30F072D785E0D0B59F28B0F7853E3D3E0D8B")
(defsimplecommandtest "Simple crt" "crt 1" "2F08B31AC06C9D5339E6B3E953C2B4B71FDB9CDE")