--- /dev/null
+[submodule "wiki"]
+ path = wiki
+ url = https://github.com/frankduncan/clnl.wiki.git
before_install:
- export DISPLAY=:99.0
- /sbin/start-stop-daemon --start --quiet --pidfile /tmp/custom_xvfb_99.pid --make-pidfile --background --exec /usr/bin/Xvfb -- :99 -ac -screen 0 1280x1024x24
+ - wget http://frank.kank.net/travissbcl/clnl/ee78f42/$(git rev-parse HEAD)/travissbcl
+ - chmod +x travissbcl
script:
- - deps/travissbcl --script bin/travis.lisp
+ - ./travissbcl --script bin/travis.lisp
* nibbles
* trivial-features
* style-checker
+ * docgen
* rlwrap
# Running
tar zxf ../../deps/tarpit/nibbles-v0.12.tar.gz &&
tar zxf ../../deps/tarpit/trivial-features_0.8.tar.gz &&
tar zxf ../../deps/tarpit/style-checker_0.1.tar.gz &&
+ tar zxf ../../deps/tarpit/docgen_0.1.tar.gz &&
ln -s cl-ppcre-2.0.10/cl-ppcre.asd . &&
ln -s ironclad_0.33.0/ironclad.asd . &&
ln -s mt19937-1.1.1/mt19937.asd . &&
ln -s cffi_0.15.0/cffi-grovel.asd . &&
ln -s cffi_0.15.0/cffi-uffi-compat.asd . &&
ln -s trivial-features_0.8/trivial-features.asd . &&
- ln -s style-checker_0.1/style-checker.asd .
+ ln -s style-checker_0.1/style-checker.asd . &&
+ ln -s docgen_0.1/docgenasd .
)
--eval "(asdf:load-system :cl-opengl)" \
--eval "(asdf:load-system :cl-glut)" \
--eval "(asdf:load-system :style-checker)" \
+ --eval "(asdf:load-system :docgen)" \
--eval "(asdf:clear-output-translations)" \
- --eval '(sb-ext:save-lisp-and-die "deps/travissbcl" :executable t)' \
+ --eval '(sb-ext:save-lisp-and-die "travissbcl" :executable t)' \
-chmod +x deps/travissbcl
+chmod +x travissbcl
+travisname=travissbcl-$(git rev-parse --short HEAD)
+mv travissbcl $travisname
-# rm -rf tmp
+echo "You should upload via the command: scp $travisname nami:/opt/travis/sbcls/clnl/"
+echo "You should also set travisname in .travis.yml to $travisname"
+
+rm -rf tmp
--- /dev/null
+#!/bin/bash
+
+generatedoc() {
+ package=$1
+ sbcl \
+ --eval "(asdf:load-system :docgen)" \
+ --eval "(asdf:load-system :clnl)" \
+ --eval "(format t \"----~%\")" \
+ --eval "(format t \"~A\" (docgen:export-package $package))" \
+ --eval "(quit)" 2> /dev/null | sed -n '/^----$/,$p' | tail -n +2
+}
+
+generatedoc :clnl > wiki/DocsMain.md
+generatedoc :clnl-nvm > wiki/DocsNvm.md
+generatedoc :clnl-interface > wiki/DocsOtherPackages.md
+generatedoc :clnl-lexer >> wiki/DocsOtherPackages.md
+generatedoc :clnl-parser >> wiki/DocsOtherPackages.md
+generatedoc :clnl-transpiler >> wiki/DocsOtherPackages.md
+generatedoc :clnl-random >> wiki/DocsOtherPackages.md
(when (not (syntax-checker:pretty-print-check-directory "src"))
(format t "~c[1;31mFailed style check!~c[0m~%" #\Esc #\Esc)
(sb-ext:exit :code 1))
+(format t "~c[1;32m- Style Passed!~c[0m~%" #\Esc #\Esc)
-(format t "~c[1;32mSuccess!~c[0m~%" #\Esc #\Esc)
+(format t "~%~c[1;33mChecking Docs~c[0m~%" #\Esc #\Esc)
+(when (not (docgen:pretty-print-validate-packages
+ :clnl :clnl-parser :clnl-random :clnl-transpiler :clnl-nvm :clnl-lexer :clnl-interface))
+ (format t "~c[1;31mFailed doc check!~c[0m~%" #\Esc #\Esc)
+ (sb-ext:exit :code 1))
+(format t "~c[1;32m- Doc Check Passed!~c[0m~%" #\Esc #\Esc)
+
+(format t "~c[1;30m--------------~c[0m~%" #\Esc #\Esc)
+(format t "~c[1;32mBuild Success!~c[0m~%" #\Esc #\Esc)
(sb-ext:exit :code 0)
+++ /dev/null
-5ba26ad20f3cda2796a44d201fba629edd567e4c
\ No newline at end of file
(mapcar
(lambda (turtle)
(let
- ((color (nl-color->rgb (clnl-nvm:turtle-color turtle))))
+ ((color (nl-color->rgb (getf turtle :color))))
(gl:color (car color) (cadr color) (caddr color)))
(gl:with-pushed-matrix
- (gl:translate (* (clnl-nvm:turtle-xcor turtle) *patch-size*) (* (clnl-nvm:turtle-ycor turtle) *patch-size*) 0)
- (gl:rotate (clnl-nvm:turtle-heading turtle) 0 0 -1)
+ (gl:translate (* (getf turtle :xcor) *patch-size*) (* (getf turtle :ycor) *patch-size*) 0)
+ (gl:rotate (getf turtle :heading) 0 0 -1)
(gl:call-list *turtle-list*)))
- (clnl-nvm:turtles))
+ (clnl-nvm:current-state))
(gl:flush))
(defun display ()
(gl:end)))
(defun run ()
+ "RUN => RESULT
+
+ARGUMENTS AND VALUES:
+
+ RESULT: undefined, should never get here
+
+DESCRIPTION:
+
+ RUN runs the view in an external window.
+
+ This should be run inside another thread as it starts the glut main-loop.
+ Closing this window will then cause the entire program to terminate."
; I do this because I don't know who or what in the many layers
; is causing the floating point errors, but I definitely don't
; want to investigate until simply ignoring them becomes a problem.
(cl-glut:main-loop)))
(defun export-view ()
+ "EXPORT-VIEW => IMAGE-DATA
+
+ARGUMENTS AND VALUES:
+
+ IMAGE-DATA: A vector, pixel data as returned by opengls readPixels
+
+DESCRIPTION:
+
+ EXPORT-VIEW returns the current view in raw data of RGBA pixels.
+
+ Each pixel is made up of 4 bytes of data, which an be walked over. The number
+ of pixels is the current width x height. Converting to some other image format
+ is a matter of pulling that information out and putting it into whatever format
+ you like.
+
+ This requires opengl to run, but can be used with xvfb in a headless mode."
(sb-int:with-float-traps-masked (:invalid)
(when (not *glut-window-opened*)
(cl-glut:init)
*lexes*))))
(defun lex (text)
+ "LEX TEXT => AST
+
+ARGUMENTS AND VALUES:
+
+ TEXT: Some NetLogo code
+ AST: An ambigious AST that can later be parsed
+
+DESCRIPTION:
+
+ LEX lexes NetLogo code.
+
+ LEX checks for some things, in as much as it can without knowing anything
+ about some of the backgrounds of NetLogo. However, it does the first pass
+ with as much as it can."
(if (string= "" text)
(let
((lex (find-if (lambda (f) (funcall f *state* :eof)) *lexes* :from-end t :key #'car)))
(defun p (result) result)
(defun run ()
+ "RUN => RESULT
+
+ARGUMENTS AND VALUES:
+
+ RESULT: undefined, the system terminates at the end of the loop
+
+DESCRIPTION:
+
+ RUN implements a very simple REPL."
(loop
:for str := (progn (format t "> ") (force-output) (read-line))
:while str
(sb-ext:exit))
(defun boot ()
+ "BOOT => RESULT
+
+ARGUMENTS AND VALUES:
+
+ RESULT: undefined
+
+DESCRIPTION:
+
+ BOOT does exactly that, boots the clnl system in a clean state. The seed
+ is set so that multiple runs will evaluate to the same."
(clnl-random:set-seed 15)
(clnl-nvm:create-world))
(defun run-commands (cmds)
+ "RUN-COMMANDS CMDS => RESULT
+
+ARGUMENTS AND VALUES:
+
+ CMDS: A string that may have one more NetLogo commands
+ RESULT: undefined
+
+DESCRIPTION:
+
+ RUN-COMMANDS will take NetLogo commands, put them through the various
+ stages need to turn them into Common Lisp code, and run it."
(eval (clnl-transpiler:transpile-commands (clnl-parser:parse (clnl-lexer:lex cmds)))))
(defun run-reporter (reporter)
+ "RUN-REPORTER REPORTER => RESULT
+
+ARGUMENTS AND VALUES:
+
+ REPORTER: A string that should have only one reporter
+ RESULT: The value reported by the NVM
+
+DESCRIPTION:
+
+ RUN-REPORTER will take a NetLogo REPORTER, put it through the various
+ stages need to turn them into Common Lisp code, run it, and return the RESULT."
(eval (clnl-transpiler:transpile-reporter (car (clnl-parser:parse (clnl-lexer:lex reporter))))))
(in-package #:clnl-nvm)
-; This is the engine. Yay.
-
(defvar *current-id* 0)
(defstruct turtle who color heading xcor ycor)
(defvar *myself* nil)
(defvar *self* nil)
-(defun show (n)
- "Prints value in the Command Center, preceded by this agent, and followed by a carriage return.
+(defun show (value)
+ "SHOW VALUE => RESULT
+
+ARGUMENTS AND VALUES:
+
+ VALUE: a NetLogo value
+ RESULT: undefined
+
+DESCRIPTION:
-See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show"
- (format t "Showing: ~A~%" (dump-object n)))
+ A command that prints the given NetLogo value to the command center.
+
+ See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show"
+ (format t "Showing: ~A~%" (dump-object value)))
(defun create-turtle ()
(setf
(incf *current-id*))
(defun turtles ()
- "Reports the agentset consisting of all turtles.
+ "TURTLES => ALL-TURTLES
+
+ARGUMENTS AND VALUES:
+
+ ALL-TURTLES: a NetLogo agentset, all turtles
-See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#turtles"
+DESCRIPTION:
+
+ Reports the agentset consisting of all the turtles.
+
+ This agentset is special in that it represents the living turtles
+ each time it's used, so changes depending on the state of the engine.
+
+ 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.
+ "ASK AGENT-SET FN => RESULT
+
+ARGUMENTS AND VALUES:
+
+ AGENT-SET: a NetLogo agentset
+ FN: a function, run on each agent
+ RESULT: undefined, commands don't return
+
+DESCRIPTION:
-See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask"
+ ASK is equivalent to ask 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.
+
+ See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask"
(let
((iter (shufflerator agent-set)))
(loop
(t (let ((result agent)) (fetch) result)))))))
(defun random-float (n)
- "If number is positive, returns a random floating point number greater than
-or equal to 0 but strictly less than number.
+ "RANDOM-FLOAT N => RANDOM-NUMBER
+
+ARGUMENTS AND VALUES:
+
+ N: a double, the upper bound of the random float
+ RANDOM-NUMBER: a double, the random result
+
+DESCRIPTION:
+
+ Returns a random number strictly closer to zero than N.
-If number is negative, returns a random floating point number less than or equal
-to 0, but strictly greater than number.
+ If number is positive, returns a random floating point number greater than
+ or equal to 0 but strictly less than number.
-If number is zero, the result is always 0.
+ If number is negative, returns a random floating point number less than or equal
+ to 0, but strictly greater than number.
-See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#random-float"
+ If number is zero, the result is always 0.
+
+ 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.)
+ "FORWARD N => RESULT
+
+ARGUMENTS AND VALUES:
+
+ N: a double, the amount the turtle moves forward
+ RESULT: undefined
+
+DESCRIPTION:
+
+ Moves the current turtle forward N steps, one step at a time.
+
+ This moves forward one at a time in order to make the view updates look
+ good in the case of a purposefully slow running instance. If the number
+ is negative, the turtle moves backward.
-See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#forward"
+ If the current agent is not a turtle, it raises an error.
+
+ 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.
+ "CREATE-TURTLES N => RESULT
+
+ARGUMENTS AND VALUES:
+
+ N: an integer, the numbers of turtles to create
+ RESULT: undefined
+
+DESCRIPTION:
-If commands are supplied, the new turtles immediately run them.
+ Creates number new turtles at the origin.
-See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
+ 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 (unimplemented).
+
+ See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles"
(loop :for i :from 1 :to n :do (create-turtle)))
(defun create-world ()
+ "CREATE-WORLD => RESULT
+
+ARGUMENTS AND VALUES:
+
+ RESULT: undefined
+
+DESCRIPTION:
+
+ Initializes the world in the NVM.
+
+ This should be called before using the engine in any real capacity. If
+ called when an engine is already running, it may do somethign weird."
(setf *turtles* nil)
(setf *current-id* 0))
(defmethod dump-object ((o string)) o)
+(defun current-state ()
+ "CURRENT-STATE => WORLD-STATE
+
+ARGUMENTS AND VALUES:
+
+ WORLD-STATE: A list, the current state of the whole world
+
+DESCRIPTION:
+
+ Dumps out the state of the world.
+
+ This is useful for visualizations and also storing in a common lisp
+ data structure for easy usage in a common lisp instance. It's preferable
+ to use this when working with the nvm than the output done by export-world.
+
+ Currently this only dumps out turtle information.
+
+ This is called CURRENT-STATE because export-world is an actual primitive
+ used by NetLogo."
+ (mapcar
+ (lambda (turtle)
+ (list
+ :color (turtle-color turtle)
+ :xcor (turtle-xcor turtle)
+ :ycor (turtle-ycor turtle)
+ :heading (turtle-heading turtle)))
+ *turtles*))
+
+(defun export-patches ()
+ (list
+ "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\""
+ "\"-1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
+ "\"0\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
+ "\"1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
+ "\"-1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
+ "\"0\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
+ "\"1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
+ "\"-1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
+ "\"0\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
+ "\"1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""))
+
(defun export-world ()
+ "EXPORT-WORLD => WORLD-CSV
+
+ARGUMENTS AND VALUES:
+
+ WORLD-CSV: A string, the csv of the world
+
+DESCRIPTION:
+
+ Dumps out a csv matching NetLogo's export world.
+
+ This is useful for serializing the current state of the engine in order
+ to compare against NetLogo or to reimport later. Contains everything needed
+ to boot up a NetLogo instance in the exact same state."
(format nil "~{~A~%~}"
(list
(format nil "~S" "RANDOM STATE")
"\"\"\"default\"\"\",\"\"\"\"\"\",\"9.9\",\"{all-turtles}\",\"false\",\"1\",\"1\",\"\"\"up\"\"\""))
*turtles*))
(format nil "~S" "PATCHES")
- "\"pxcor\",\"pycor\",\"pcolor\",\"plabel\",\"plabel-color\""
- "\"-1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
- "\"0\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
- "\"1\",\"1\",\"0\",\"\"\"\"\"\",\"9.9\""
- "\"-1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
- "\"0\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
- "\"1\",\"0\",\"0\",\"\"\"\"\"\",\"9.9\""
- "\"-1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
- "\"0\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
- "\"1\",\"-1\",\"0\",\"\"\"\"\"\",\"9.9\""
+ (format nil "~{~A~^~%~}" (export-patches))
""
(format nil "~S" "LINKS")
"\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\""
(defpackage #:clnl (:use :common-lisp)
- (:export :run :boot :run-commands :run-reporter))
+ (:export :run :boot :run-commands :run-reporter)
+ (:documentation
+ "Main CLNL package
+
+The entry point for general purpose clnl startup, as well as
+the place that ties all the parts together into a cohesive whole."))
(defpackage #:clnl-parser
(:use :common-lisp)
- (:export :parse))
+ (:export :parse)
+ (:documentation
+ "CLNL Parser
+
+All the code to convert the list of tokens coming from the lexer
+into an ast that can be transpiled later."))
(defpackage #:clnl-random
(:use :common-lisp)
(:shadow #:export)
- (:export #:export #:set-seed #:next-int #:next-double))
+ (:export #:export #:set-seed #:next-int #:next-double)
+ (:documentation
+ "Wrapper around mt19937.
+
+mt19937 implements a merseinne twister that must be adapted a little in
+order to match the implementation in the main NetLogo codebase which tries
+to match how java.util.Random works. Turtles, all the way down."))
(defpackage #:clnl-transpiler
(:use :common-lisp)
- (:export :transpile-commands :transpile-reporter))
+ (:export :transpile-commands :transpile-reporter)
+ (:documentation
+ "CLNL Transpiler
+
+The transpiler 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
+and ensuring that things are in the right place. The reason we wait until here
+is because we want to allow someone else to play with the AST before handing it off
+to us. For instance, the command center wants to add \"show\" to reporters, and
+the users dictate based on entry point whether they are expecting a command
+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
+All the code to convert the list of tokens coming from the lexer
+into an ast that can be transpiled later."))
(defpackage #:clnl-nvm
(:use :common-lisp)
- (:export :export-world :create-world :dump-object :turtle-color :turtle-xcor :turtle-ycor :turtle-heading
+ (:export :export-world :create-world :current-state
; API as used by transpiled NetLogo programs
#:ask
#:create-turtles
#:forward
#:random-float
#:show
- #:turtles))
+ #:turtles)
+ (:documentation
+ "CLNL NVM
+
+NetLogo Virtual Machine: the simulation engine."))
(defpackage #:clnl-lexer
(:use :common-lisp)
- (:export :lex))
+ (:export :lex)
+ (:documentation
+ "CLNL Lexer
+
+The primary code responsible for tokenizing NetLogo code."))
(defpackage #:clnl-interface
(:use :common-lisp)
- (:export :run :export-view))
+ (:export :run :export-view)
+ (:documentation
+ "CLNL Interface
+
+The NetLogo view interface using opengl. This is responsible for taking the
+current state of the enging and displaying it. Will not house any interface
+components."))
; Make this only as complicated as it needs to be, letting it grow
; as we take on more and more of the language
(defun parse (lexed-ast)
+ "PARSE LEXED-AST => AST
+
+ARGUMENTS AND VALUES:
+
+ LEXED-AST: An ambigious ast
+ AST: An unambigious ast that can be transpiled
+
+DESCRIPTION:
+
+ PARSE takes a ambigious LEXED-AST and converts it to an unambigious one.
+
+ The need for a parser between the lexer and the transpiler is because NetLogo
+ needs two passes to turn into something that can be used. This is the only entry
+ point into this module, and should probably remain that way.
+
+ There's also a lot of error checking that the LEXED-AST even makes sense, even
+ though the lexer obviously thought it did.
+
+ Examples are too numerous and varied, but by inserting an output between
+ the lexer and this code, a good idea of what goes on can be gotten."
(cond
((not lexed-ast) nil)
((numberp (car lexed-ast)) (cons (coerce (car lexed-ast) 'double-float) (parse (cdr lexed-ast))))
(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
-
(defun set-seed (n)
+ "SET-SEED => RESULT
+
+ARGUMENTS AND VALUES:
+
+ RESULT: undefined
+
+DESCRIPTION:
+
+ SET-SEED sets the seed on the RNG."
(setf mt19937:*random-state* (funcall
(symbol-function (intern "MAKE-RANDOM-OBJECT" :mt19937))
:state (mt19937:init-random-state n))))
(defun next-int (n)
+ "NEXT-INT N => INT
+
+ARGUMENTS AND VALUES:
+
+ N: An integer representing the upper bound
+ INT: An integer
+
+DESCRIPTION:
+
+ NEXT-INTEGER returns the next randomly generated integer.
+
+ It does so in a way that's in accordance with java.util.Random and
+ the MerseinneTwisterFast that's in NetLogo. It also advances the
+ RNG and is bounded by N."
(if
(= n (logand n (- n) ))
(ash (* n (ash (mt19937:random-chunk mt19937:*random-state*) -1) ) -31)
(rem (ash (mt19937:random-chunk mt19937:*random-state*) -1) n)))
(defun next-double (&optional (n 1d0))
+ "NEXT-DOUBLE &optional N => DOUBLE
+
+ARGUMENTS AND VALUES:
+
+ N: A double representing the upper bound
+ DOUBLE: A double
+
+DESCRIPTION:
+
+ NEXT-DOUBLE returns the next randomly generated double.
+
+ It does so in a way that's in accordance with java.util.Random and
+ the MerseinneTwisterFast that's in NetLogo. It also advances the
+ RNG and is bounded by N."
(let
((y (mt19937:random-chunk mt19937:*random-state*))
(z (mt19937:random-chunk mt19937:*random-state*)))
; Oh, export world, you WILL be mine
(defun export ()
+ "EXPORT => RANDOM-STATE
+
+ARGUMENTS AND VALUES:
+
+ RANDOM-STATE: A dump of the current random state
+
+DESCRIPTION:
+
+ EXPORT dumps out the random state to be export world ready.
+
+ When NetLogo dumps out the current state of the engine, the state of the
+ RNG also gets dumped out so that it can be reinitialized later. This
+ accomplishes that.
+
+ This isn't really useful for regular use."
(let
((state
(map
(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
-; and ensuring that things are in the right place. The reason we wait until here
-; is because we want to allow someone else to play with the AST before handing it off
-; to us. For instance, the command center wants to add "show" to reporters, and
-; the users dictate based on entry point whether they are expecting a command
-; 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))
(defun find-prim (symb) (find symb *prims* :key #'prim-name))
; Let this grow, slowly but surely, eventually taking on calling context, etc.
-; For now, it's just a
+; For now, it's just a
(defun transpile-commands (parsed-ast)
+ "TRANSPILE-COMMANDS PARSED-AST => AST
+
+ARGUMENTS AND VALUES:
+
+ PARSED-AST: An ast as returned by the parser
+ AST: An common lisp AST that can be actually run in a common lisp instance
+
+DESCRIPTION:
+
+ TRANSPILE-COMMANDS takes a unambigious PARSED-AST and converts it to
+ Common Lisp code.
+
+ Calling eval on that code should work correctly as long as you have a
+ running engine. This is the entry point for commands, so it does
+ extra checking to ensure that commands are actually in the PARSED-AST."
`(progn
,@(mapcar #'transpile-command parsed-ast)))
(t `(,(prim-func (find-prim (car command))) ,@(mapcar #'transpile-reporter (cdr command))))))
(defun transpile-reporter (reporter)
+ "TRANSPILE-REPORTER REPORTER => AST
+
+ARGUMENTS AND VALUES:
+
+ REPORTER: An ast returned from the parser.
+ AST: An common lisp AST that can be actually run in a common lisp instance
+
+DESCRIPTION:
+
+ TRANSPILE-REPORTER takes a unambigious PARSED-AST and converts it to
+ Common Lisp code.
+
+ Calling eval on that code should work correctly as long as you have a
+ running engine. This is the entry point for reporters, so it does
+ extra checking to ensure that the reporter is actually in the REPORTER.
+
+ The Common lisp code that is returned, when run, will return some value."
(cond
((numberp reporter) reporter) ; The parser converts to double for us
((symbolp reporter) reporter) ; The parser should have checked that having a symbol here is ok
(lambda ()
(clnl:boot)
(and
- (string= (clnl-nvm:dump-object (clnl:run-reporter ,reporter)) ,value)
+ (string= (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter)) ,value)
(checksum= ,checksum (checksum-world))))
(lambda ()
(clnl:boot)
(format nil "~A~%~A~A"
- (clnl-nvm:dump-object (clnl:run-reporter ,reporter))
+ (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter))
(clnl-nvm:export-world)
(checksum-world)))
"bin/runreporter.scala"
--- /dev/null
+Subproject commit 14906cabcb1e40519cffa9fabd26c27067bb08a3
projects / clnl / commitdiff