From: Frank Duncan Date: Thu, 13 Aug 2015 16:26:33 +0000 (-0500) Subject: Add documentation checker for exported symbols X-Git-Tag: v0.0.0~5 X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=commitdiff_plain;h=5c8699f151207953f4029e0fc6c488afce99f756 Add documentation checker for exported symbols --- diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..1709ac1 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "wiki"] + path = wiki + url = https://github.com/frankduncan/clnl.wiki.git diff --git a/.travis.yml b/.travis.yml index 03b4b90..0f8766c 100644 --- a/.travis.yml +++ b/.travis.yml @@ -6,5 +6,7 @@ addons: 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 diff --git a/README.md b/README.md index 4e5dcd5..9b39225 100644 --- a/README.md +++ b/README.md @@ -19,6 +19,7 @@ If you'd like to build it, you're going to need a few things: * nibbles * trivial-features * style-checker + * docgen * rlwrap # Running diff --git a/bin/buildtravisexec.sh b/bin/buildtravisexec.sh index 5715bf2..3185576 100755 --- a/bin/buildtravisexec.sh +++ b/bin/buildtravisexec.sh @@ -21,6 +21,7 @@ mkdir -p tmp/deps/ 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 . && @@ -36,7 +37,8 @@ mkdir -p tmp/deps/ 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 . ) @@ -49,9 +51,15 @@ SBCL_HOME="" tmp/sbcl/bin/sbcl --core tmp/sbcl/lib/sbcl/sbcl.core \ --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 diff --git a/bin/generatedocs.sh b/bin/generatedocs.sh new file mode 100755 index 0000000..e904474 --- /dev/null +++ b/bin/generatedocs.sh @@ -0,0 +1,19 @@ +#!/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 diff --git a/bin/travis.lisp b/bin/travis.lisp index 0430056..153e1c5 100644 --- a/bin/travis.lisp +++ b/bin/travis.lisp @@ -13,6 +13,15 @@ (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) diff --git a/deps/tarpit/docgen_0.1.tar.gz b/deps/tarpit/docgen_0.1.tar.gz new file mode 100644 index 0000000..9798899 Binary files /dev/null and b/deps/tarpit/docgen_0.1.tar.gz differ diff --git a/deps/travissbcl.REMOVED.git-id b/deps/travissbcl.REMOVED.git-id deleted file mode 100644 index c65f7d3..0000000 --- a/deps/travissbcl.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -5ba26ad20f3cda2796a44d201fba629edd567e4c \ No newline at end of file diff --git a/src/main/interface.lisp b/src/main/interface.lisp index 387679e..92f292a 100644 --- a/src/main/interface.lisp +++ b/src/main/interface.lisp @@ -43,13 +43,13 @@ (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 () @@ -85,6 +85,18 @@ (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. @@ -105,6 +117,22 @@ (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) diff --git a/src/main/lex.lisp b/src/main/lex.lisp index b0ef2f1..d39ab59 100644 --- a/src/main/lex.lisp +++ b/src/main/lex.lisp @@ -32,6 +32,20 @@ *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))) diff --git a/src/main/main.lisp b/src/main/main.lisp index 8304d0f..749c765 100644 --- a/src/main/main.lisp +++ b/src/main/main.lisp @@ -15,6 +15,15 @@ (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 @@ -22,11 +31,43 @@ (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)))))) diff --git a/src/main/nvm.lisp b/src/main/nvm.lisp index 2b30edf..bf8981a 100644 --- a/src/main/nvm.lisp +++ b/src/main/nvm.lisp @@ -1,7 +1,5 @@ (in-package #:clnl-nvm) -; This is the engine. Yay. - (defvar *current-id* 0) (defstruct turtle who color heading xcor ycor) @@ -9,11 +7,20 @@ (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 @@ -30,15 +37,40 @@ See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#show" (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 @@ -66,36 +98,83 @@ See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#ask" (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)) @@ -113,7 +192,61 @@ See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles" (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") @@ -142,16 +275,7 @@ See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#create-turtles" "\"\"\"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\"" diff --git a/src/main/package.lisp b/src/main/package.lisp index e812ac0..111aa9e 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -1,34 +1,81 @@ (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.")) diff --git a/src/main/parse.lisp b/src/main/parse.lisp index 70e141d..1e5c305 100644 --- a/src/main/parse.lisp +++ b/src/main/parse.lisp @@ -31,6 +31,26 @@ ; 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)))) diff --git a/src/main/random.lisp b/src/main/random.lisp index d8a38c0..fad9431 100644 --- a/src/main/random.lisp +++ b/src/main/random.lisp @@ -1,20 +1,54 @@ (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*))) @@ -26,6 +60,21 @@ ; 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 diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp index e4ca360..b50b4cd 100644 --- a/src/main/transpile.lisp +++ b/src/main/transpile.lisp @@ -1,18 +1,5 @@ (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)) @@ -24,8 +11,23 @@ (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))) @@ -37,6 +39,23 @@ (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 diff --git a/src/test/main.lisp b/src/test/main.lisp index 36952eb..5006e06 100644 --- a/src/test/main.lisp +++ b/src/test/main.lisp @@ -71,12 +71,12 @@ (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" diff --git a/wiki b/wiki new file mode 160000 index 0000000..14906ca --- /dev/null +++ b/wiki @@ -0,0 +1 @@ +Subproject commit 14906cabcb1e40519cffa9fabd26c27067bb08a3