Add export to common lisp form, forms

diff --git a/bin/runcmd.scala b/bin/runcmd.scala
index e2d16d78ac099caaa605d2284f955bd73a41fd48..f4668874a455890a89105a628153573e28b19e85 100755 (executable)
--- a/bin/runcmd.scala
+++ b/bin/runcmd.scala
@@ -23,21 +23,63 @@ import org.nlogo.util.Utils.url2String
 
 import collection.JavaConversions._
 
 
 import collection.JavaConversions._
 

+val input = io.Source.stdin.getLines.mkString("\n").split("\\@\\#\\$\\#\\@\\#\\$\\#\\@")
+

 System.out.println("----")
 val workspace = HeadlessWorkspace.newInstance
 workspace.silent = true
 System.out.println("----")
 val workspace = HeadlessWorkspace.newInstance
 workspace.silent = true

-workspace.openFromSource(url2String("file:resources/empty.nlogo"))

 
 

-val input = io.Source.stdin.getLines.mkString("\n").split("\\@\\#\\$\\#\\@\\#\\$\\#\\@")
-val commands = input(0)
+if (input.length > 2 && input(2).length > 0) {
+  val modelSetup = input(2)
+  workspace.openFromSource(modelSetup +
+"""
+@#$#@#$#@
+GRAPHICS-WINDOW
+210
+10
+649
+470
+-1
+-1
+13.0
+1
+10
+1
+1
+1
+0
+1
+1
+1
+-1
+1
+-1
+1
+0
+0
+1
+ticks
+30.0
+
+@#$#@#$#@
+@#$#@#$#@
+@#$#@#$#@
+NetLogo 5.2.0""")
+} else {
+  workspace.openFromSource(url2String("file:resources/empty.nlogo"))
+}

 
 workspace.mainRNG.setSeed(15)
 
 workspace.mainRNG.setSeed(15)

+
+val commands = input(0)

 if(commands.length > 0) {
   workspace.runCompiledCommands(new api.SimpleJobOwner("test", workspace.world.mainRNG, classOf[api.Observer]), workspace.compileCommands(commands))
 }
 if(input.length > 1) {
   val reporter = input(1)
 if(commands.length > 0) {
   workspace.runCompiledCommands(new api.SimpleJobOwner("test", workspace.world.mainRNG, classOf[api.Observer]), workspace.compileCommands(commands))
 }
 if(input.length > 1) {
   val reporter = input(1)

-  System.out.println(org.nlogo.api.Dump.logoObject(workspace.runCompiledReporter(new api.SimpleJobOwner("test", workspace.world.mainRNG, classOf[api.Observer]), workspace.compileReporter(reporter))))
+  if(reporter.length > 0) {
+    System.out.println(org.nlogo.api.Dump.logoObject(workspace.runCompiledReporter(new api.SimpleJobOwner("test", workspace.world.mainRNG, classOf[api.Observer]), workspace.compileReporter(reporter))))
+  }

 }
 
 workspace.world.exportWorld(new java.io.PrintWriter(System.out, true), true)
 }
 
 workspace.world.exportWorld(new java.io.PrintWriter(System.out, true), true)

diff --git a/src/main/code-parse.lisp b/src/main/code-parse.lisp
index 7d9c42c69a21da7815d34ddd19a663e6f153be0a..e9b4d770f43e15c29138045f492794824bdc9649 100644 (file)
--- a/src/main/code-parse.lisp
+++ b/src/main/code-parse.lisp
@@ -7,7 +7,10 @@
 ; other things
 
 (defvar *dynamic-prims* nil)
 ; other things
 
 (defvar *dynamic-prims* nil)

-(defun global->prim (global) (list :name global))
+
+(defun global->prim (global)
+ (list :name global :type :reporter :macro `(lambda () ',(intern (symbol-name global) clnl:*model-package*))))
+

 (defun breed->prims (breed-list)
  (let
   ((plural-name (symbol-name (car breed-list))))
 (defun breed->prims (breed-list)
  (let
   ((plural-name (symbol-name (car breed-list))))


@@ -17,17 +20,21 @@
    (list :name (intern (format nil "CREATE-~A" plural-name) :keyword) :args '(:number :command-block)))))
 
 (defun parse (lexed-ast &optional external-globals)
    (list :name (intern (format nil "CREATE-~A" plural-name) :keyword) :args '(:number :command-block)))))
 
 (defun parse (lexed-ast &optional external-globals)

- "PARSE LEXED-AST &optional EXTERNAL-GLOBALS => AST
+ "PARSE LEXED-AST &optional EXTERNAL-GLOBALS => AST, PRIMS

 
 ARGUMENTS AND VALUES:
 
   LEXED-AST: An ambigious ast
   EXTERNAL-GLOBALS: A list of symbols in keyword package
   AST: An unambigious ast that represents the code block of a model
 
 ARGUMENTS AND VALUES:
 
   LEXED-AST: An ambigious ast
   EXTERNAL-GLOBALS: A list of symbols in keyword package
   AST: An unambigious ast that represents the code block of a model

+  PRIMS: Primitives that can be sent to the parser and transpiler

 
 DESCRIPTION:
 
   PARSE takes a ambigious LEXED-AST and converts it to an unambigious one.
 
 DESCRIPTION:
 
   PARSE takes a ambigious LEXED-AST and converts it to an unambigious one.

+  It also returns the primitives that are defined in the code file, including
+  ones generated from the EXTERNAL-GLOBALS, that can then be passed to both
+  the parser and the transpiler.

 
   EXTERNAL-GLOBALS is a list of symbols representing global variables that
   are not defined within the code.  Normally these come from widgets defined
 
   EXTERNAL-GLOBALS is a list of symbols representing global variables that
   are not defined within the code.  Normally these come from widgets defined


@@ -38,23 +45,26 @@ DESCRIPTION:
   Rather, the ast that's returned can be queried with other functions included
   in the CLNL-CODE-PARSER package to tease out necessary information.  Some of
   those things will involve code blocks that can then be transpiled."
   Rather, the ast that's returned can be queried with other functions included
   in the CLNL-CODE-PARSER package to tease out necessary information.  Some of
   those things will involve code blocks that can then be transpiled."

- (let
+ (let*

   ((*dynamic-prims*
     (append
      (mapcar #'global->prim external-globals)
   ((*dynamic-prims*
     (append
      (mapcar #'global->prim external-globals)

-     (procedures->prims lexed-ast))))
-  (parse-internal lexed-ast)))
+     (procedures->prims lexed-ast)))
+   (parsed (parse-internal lexed-ast)))
+  (values
+   (butlast parsed)
+   (last parsed))))

 
 (defun procedures->prims (lexed-ast)
  (cond
   ((not lexed-ast) nil)
   ; We'll need argument handling here sometime :)
 
 (defun procedures->prims (lexed-ast)
  (cond
   ((not lexed-ast) nil)
   ; We'll need argument handling here sometime :)

-  ((eql :to (car lexed-ast)) (cons (list :name (cadr lexed-ast)) (procedures-to-prims (cdr lexed-ast))))
-  (t (procedures-to-prims (cdr lexed-ast)))))
+  ((eql :to (car lexed-ast)) (cons (list :name (cadr lexed-ast)) (procedures->prims (cdr lexed-ast))))
+  (t (procedures->prims (cdr lexed-ast)))))

 
 (defun parse-internal (lexed-ast)
  (cond
 
 (defun parse-internal (lexed-ast)
  (cond

-  ((not lexed-ast) nil)
+  ((not lexed-ast) *dynamic-prims*)

   ((eql :to (car lexed-ast)) (parse-procedure lexed-ast))
   ((find (car lexed-ast) '(:globals :turtles-own :patches-own))
    (parse-with-unevaluated-list lexed-ast))
   ((eql :to (car lexed-ast)) (parse-procedure lexed-ast))
   ((find (car lexed-ast) '(:globals :turtles-own :patches-own))
    (parse-with-unevaluated-list lexed-ast))


@@ -113,11 +123,11 @@ DESCRIPTION:
 ARGUMENTS AND VALUES:
 
   MODEL: An ast as created by clnl-code-parse:parse
 ARGUMENTS AND VALUES:
 
   MODEL: An ast as created by clnl-code-parse:parse

-  GLOBAL: A symbol interned in clnl:*model-package*
+  GLOBAL: A symbol interned in :keyword

 
 DESCRIPTION:
 
   Returns the globals that get declared in the code."
  (mapcar
 
 DESCRIPTION:
 
   Returns the globals that get declared in the code."
  (mapcar

-  (lambda (global) (list (intern (symbol-name global) clnl:*model-package*) 0d0))
+  (lambda (global) (list (intern (symbol-name global) :keyword) 0d0))

   (cdr (second (find :globals code-parsed-ast :key #'car)))))
   (cdr (second (find :globals code-parsed-ast :key #'car)))))

diff --git a/src/main/main.lisp b/src/main/main.lisp
index 3acd6e366f193e9fa1e4aaeee248fc24734f7897..f20062b29e2db9530ea13adc11e9c676f6a4662b 100644 (file)
--- a/src/main/main.lisp
+++ b/src/main/main.lisp
@@ -8,7 +8,7 @@
                (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))
                (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)))
+   (transpiled-ast (let ((ast (clnl-transpiler:transpile parsed-ast)))

                     (format t "Via transpiling, AST for~%~S~% became~%~S~%" parsed-ast ast) ast)))
   (eval transpiled-ast)))
 
                     (format t "Via transpiling, AST for~%~S~% became~%~S~%" parsed-ast ast) ast)))
   (eval transpiled-ast)))
 


@@ -29,12 +29,13 @@ DESCRIPTION:
  (sb-thread:make-thread #'clnl-cli:run)
  (clnl-interface:run))
 
  (sb-thread:make-thread #'clnl-cli:run)
  (clnl-interface:run))
 

-(defun boot (&optional file)
- "BOOT &optional FILE => RESULT
+(defun boot (&optional file headless-mode)
+ "BOOT &optional FILE HEADLESS-MODE => RESULT

 
 ARGUMENTS AND VALUES:
 
   FILE: nlogo file with which to initialize state
 
 ARGUMENTS AND VALUES:
 
   FILE: nlogo file with which to initialize state

+  HEADLESS-MODE: a boolean, defaults to nil

   RESULT: undefined
 
 DESCRIPTION:
   RESULT: undefined
 
 DESCRIPTION:


@@ -42,11 +43,15 @@ 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.
 
   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.
 

-  When FILE is not provided, a default model is used."
+  When FILE is not provided, a default model is used.
+
+  When HEADLESS-MODE is set to nil, the opengl interface is initialized.
+  Otherwise, the model will run headlessly, with no view."

  (let
   ((netlogoed-lisp
  (let
   ((netlogoed-lisp

-    (model->lisp
-     (if file (with-open-file (str file) (clnl-model:read-from-nlogo str)) (clnl-model:default-model))))
+    (model->single-form-lisp
+     (if file (with-open-file (str file) (clnl-model:read-from-nlogo str)) (clnl-model:default-model))
+     :initialize-interface (not headless-mode)))

    (*package* *model-package*))
   (eval netlogoed-lisp)))
 
    (*package* *model-package*))
   (eval netlogoed-lisp)))
 


@@ -62,7 +67,7 @@ DESCRIPTION:
 
   RUN-COMMANDS will take NetLogo commands, put them through the various
   stages need to turn them into Common Lisp code, and run it."
 
   RUN-COMMANDS will take NetLogo commands, put them through the various
   stages need to turn them into Common Lisp code, and run it."

- (clnl-nvm:with-stop-handler (eval (clnl-transpiler:transpile-commands (clnl-parser:parse (clnl-lexer:lex cmds))))))
+ (clnl-nvm:with-stop-handler (eval (clnl-transpiler:transpile (clnl-parser:parse (clnl-lexer:lex cmds))))))

 
 (defun run-reporter (reporter)
  "RUN-REPORTER REPORTER => RESULT
 
 (defun run-reporter (reporter)
  "RUN-REPORTER REPORTER => RESULT


@@ -76,14 +81,120 @@ 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."
 
   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))))))
-
-; Everything gets tied together here
-; The intention of this method is to generate the common lisp equivalent of a model file,
-; such that if you decided to no longer use nlogo, you could use the engine without it.
-(defun model->lisp (model)
- `(let
-   ,(clnl-model:globals model)
-   (clnl-random:set-seed 15) ; should the seed always be 15?
-   (clnl-nvm:create-world :dims ',(clnl-model:world-dimensions model))
-   (clnl-interface:initialize :dims ',(clnl-model:world-dimensions model))))
+ (eval (clnl-transpiler:transpile (clnl-parser:parse (clnl-lexer:lex reporter)))))
+
+(defun model->single-form-lisp (model &key (seed 15) initialize-interface netlogo-callback)
+ (multiple-value-bind
+  (code-ast prims)
+  (clnl-code-parser:parse (clnl-lexer:lex (clnl-model:code model)) (clnl-model:widget-globals model))
+  (let
+   ((globals
+     (append
+      (clnl-model:widget-globals model)
+      (clnl-code-parser:globals code-ast))))
+   `(let
+     ,(mapcar (lambda (pair) (list (intern (string-upcase (car pair)) *model-package*) (cadr pair))) globals)
+     (declare (special ,@(mapcar (lambda (pair) (intern (string-upcase (car pair)) *model-package*)) globals)))
+     (clnl-random:set-seed ,seed)
+     (clnl-nvm:create-world
+      :dims ',(clnl-model:world-dimensions model)
+      :globals (list
+                ,@(mapcar
+                   (lambda (pair) `(list ,(car pair) (lambda () ,(intern (string-upcase (car pair)) *model-package*))))
+                   globals)))
+     ,@(when netlogo-callback
+        `((funcall ,netlogo-callback
+           (lambda (netlogo-code)
+            (eval
+             (clnl-transpiler:transpile
+              (clnl-parser:parse
+               (clnl-lexer:lex netlogo-code)
+               (list ,@(mapcar (lambda (prim) `(list ,@prim)) prims)))
+              (list ,@(mapcar (lambda (prim) `(list ,@prim)) prims))))))))
+     ,@(when initialize-interface `((clnl-interface:initialize :dims ',(clnl-model:world-dimensions model))))))))
+
+(setf (documentation 'model->single-form-lisp 'function)
+ "MODEL->SINGLE-FORM-LISP MODEL &key SEED INITIALIZE-INTERFACE NETLOGO-CALLBACK => FORM
+
+ARGUMENTS AND VALUES:
+
+  MODEL: A valid model
+  SEED: An integer, defaults to 15
+  INITIALIZE-INTERFACE: A boolean
+  NETLOGO-CALLBACK: A function of one argument, or a symbol
+  FORM: A common lisp form
+
+DESCRIPTION:
+
+  MODEL->SINGLE-FORM-LISP takes a model and returns a lisp program as a single form,
+  that when executed runs the model.  The SEED passed in is used to start the
+  clnl-random RNG.
+
+  INITIALIZE-INTERFACE, when non nil, leads to initialization code for the
+  opengl interface being included.
+
+  NETLOGO-CALLBACK is a function that when called with a single argument,
+  a function that when called with netlogo code, will compile and run that
+  code in the environment of the model.
+
+  Of note, all globals defined either in the model code or via the widgets
+  are declared special in order to remain in the lexical environment for EVAL.")
+
+(defun model->multi-form-lisp (model boot-fn &key (seed 15) initialize-interface netlogo-callback-fn)
+ (multiple-value-bind
+  (code-ast prims)
+  (clnl-code-parser:parse (clnl-lexer:lex (clnl-model:code model)) (clnl-model:widget-globals model))
+  (let
+   ((globals
+     (append
+      (clnl-model:widget-globals model)
+      (clnl-code-parser:globals code-ast))))
+   `((in-package ,(intern (package-name *model-package*) :keyword))
+     ,@(mapcar
+        (lambda (pair)
+         `(defvar ,(intern (string-upcase (car pair)) *model-package*) ,(cadr pair)))
+        globals)
+     (defun ,boot-fn ()
+      (clnl-random:set-seed ,seed)
+      (clnl-nvm:create-world
+       :dims ',(clnl-model:world-dimensions model)
+       :globals (list
+                 ,@(mapcar
+                    (lambda (pair) `(list ,(car pair) (lambda () ,(intern (string-upcase (car pair)) *model-package*))))
+                    globals)))
+      ,@(when initialize-interface `((clnl-interface:initialize :dims ',(clnl-model:world-dimensions model)))))
+     ,@(when netlogo-callback-fn
+        `((defun ,netlogo-callback-fn (,(intern "NETLOGO-CODE" *model-package*))
+           (eval
+            (clnl-transpiler:transpile
+             (clnl-parser:parse
+              (clnl-lexer:lex ,(intern "NETLOGO-CODE" *model-package*))
+              (list ,@(mapcar (lambda (prim) `(list ,@prim)) prims)))
+             (list ,@(mapcar (lambda (prim) `(list ,@prim)) prims)))))))))))
+
+(setf (documentation 'model->multi-form-lisp 'function)
+ "MODEL->MULTI-FORM-LISP MODEL BOOT-FN &key SEED INITIALIZE-INTERFACE NETLOGO-CALLBACK-FN => FORMS
+
+ARGUMENTS AND VALUES:
+
+  MODEL: A valid model
+  BOOT-FN: A function name
+  SEED: An integer, defaults to 15
+  INITIALIZE-INTERFACE: A boolean
+  NETLOGO-CALLBACK-FN: a symbol
+  FORMS: A list of common lisp form
+
+DESCRIPTION:
+
+  MODEL->MULTI-FORM-LISP takes a model and returns a multi form lisp program,
+  that when executed, sets up the model.  Procedures map to defuns, globals
+  to defvars, etc.  This can be output to load up quickly later.  A function
+  named by BOOT-FN will be set for booting the program.
+
+  The SEED passed in is used to start the clnl-random RNG.
+
+  INITIALIZE-INTERFACE, when non nil, leads to initialization code for the
+  opengl interface being included.
+
+  NETLOGO-CALLBACK-FN is a symbol that will be defined as a function
+  to be called to execute code in the running netlogo instance.")

diff --git a/src/main/model.lisp b/src/main/model.lisp
index 7a18fb0283adb3538e70104b9ec26f3f8d61061e..022a658625af2db43e384fb9c797db9e33a50e26 100644 (file)
--- a/src/main/model.lisp
+++ b/src/main/model.lisp
@@ -27,6 +27,7 @@ DESCRIPTION:
 
   Returns the default startup model."
  (make-model
 
   Returns the default startup model."
  (make-model

+  :code ""

   :interface (list
               (make-view :min-pxcor -5 :max-pxcor 5 :min-pycor -5 :max-pycor 5))))
 
   :interface (list
               (make-view :min-pxcor -5 :max-pxcor 5 :min-pycor -5 :max-pycor 5))))
 


@@ -54,15 +55,7 @@ DESCRIPTION:
           (read-sections (append section (list line))))))))
      (read-sections))))
   (make-model
           (read-sections (append section (list line))))))))
      (read-sections))))
   (make-model

-   :code (clnl-code-parser:parse
-          (clnl-lexer:lex (format nil "~{~A~^~%~}" (nth 0 sections)))
-          (remove nil
-           (mapcar
-            (lambda (widget)
-             (typecase widget
-              (slider (intern (string-upcase (slider-varname widget)) :keyword))
-              (switch (intern (string-upcase (switch-varname widget)) :keyword))))
-            (parse-interface (nth 1 sections)))))
+   :code (format nil "~{~A~^~%~}" (nth 0 sections))

    :interface (parse-interface (nth 1 sections))
    :info (nth 2 sections)
    :turtle-shapes (nth 3 sections)
    :interface (parse-interface (nth 1 sections))
    :info (nth 2 sections)
    :turtle-shapes (nth 3 sections)


@@ -230,33 +223,40 @@ DESCRIPTION:
    :ymin (view-min-pycor view)
    :ymax (view-max-pycor view))))
 
    :ymin (view-min-pycor view)
    :ymax (view-max-pycor view))))
 

-; For now, we keep the code hidden in this package
-(defun globals (model)
- "GLOBALS MODEL => GLOBALS
+(defun widget-globals (model)
+ "WIDGET-GLOBALS MODEL => GLOBALS

 
   GLOBALS: GLOBAL*
 
   GLOBALS: GLOBAL*

+  GLOBAL: (NAME DEFAULT)
+
+ARGUMENTS AND VALUES:
+
+  MODEL: A valid model
+  NAME: A symbol interned in the keyworkd package
+  DEFAULT: The widget default value
+
+DESCRIPTION:
+
+  Returns the globals that get declared in the model from widgets.
+  They are interned in the keyword package package set for clnl, so
+  that they can later be used for multiple purposes."
+ (remove nil
+  (mapcar
+   (lambda (widget)
+    (typecase widget
+     (slider (list (intern (string-upcase (slider-varname widget)) :keyword) (slider-default widget)))
+     (switch (list (intern (string-upcase (switch-varname widget)) :keyword) (switch-on widget)))))
+   (model-interface model))))
+
+(defun code (model)
+ "CODE MODEL => CODE

 
 ARGUMENTS AND VALUES:
 
   MODEL: A valid model
 
 ARGUMENTS AND VALUES:
 
   MODEL: A valid model

-  GLOBAL: A symbol interned in clnl:*model-package*
+  CODE: The string representing the netlogo code in this model

 
 DESCRIPTION:
 
 
 DESCRIPTION:
 

-  Returns the globals that get declared in the model, from widgets or
-  from code.  They are interned in the package set for clnl, so
-  that they can later be used by functions in that package."
- (mapcar
-  (lambda (pair)
-   (list
-    (intern (string-upcase (car pair)) clnl:*model-package*)
-    (cadr pair)))
-  (append
-   (clnl-code-parser:globals (model-code model))
-   (remove nil
-    (mapcar
-     (lambda (widget)
-      (typecase widget
-       (slider (list (slider-varname widget) (slider-default widget)))
-       (switch (list (switch-varname widget) (switch-on widget)))))
-     (model-interface model))))))
+  Returns the code from the model."
+ (model-code model))

diff --git a/src/main/nvm/base.lisp b/src/main/nvm/base.lisp
index fc2db581e6395ae764753febb0c8d8f52e308626..af87bc27e167f68c320a51009d59087bb22b60d6 100644 (file)
--- a/src/main/nvm/base.lisp
+++ b/src/main/nvm/base.lisp
@@ -7,6 +7,7 @@
 (defvar *myself* nil)
 (defvar *self* nil)
 (defvar *dimensions* nil)
 (defvar *myself* nil)
 (defvar *self* nil)
 (defvar *dimensions* nil)

+(defvar *globals* nil)

 (defvar *topology* :torus)
 (defvar *ticks* nil)
 (defvar *breeds* nil)
 (defvar *topology* :torus)
 (defvar *ticks* nil)
 (defvar *breeds* nil)


@@ -26,7 +27,7 @@ DESCRIPTION:
   WITH-STOP-HANDLER is a convenience macro to handle when
   programs issue a stop condition.  When one does, a simple
   :stop is returned."
   WITH-STOP-HANDLER is a convenience macro to handle when
   programs issue a stop condition.  When one does, a simple
   :stop is returned."

- `(handler-case (progn ,@forms) (stop (s) :stop)))
+ `(handler-case (progn ,@forms) (stop (s) (declare (ignore s)) :stop)))

 
 (defstruct turtle who color heading xcor ycor (label "") (label-color 9.9d0) (size 1d0) shape)
 (defstruct patch color xcor ycor)
 
 (defstruct turtle who color heading xcor ycor (label "") (label-color 9.9d0) (size 1d0) shape)
 (defstruct patch color xcor ycor)

diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp
index a272a34526490aa84b4d189831beef373dd1fa54..766df5379bf232623274271bbc58c7273cdf23ce 100644 (file)
--- a/src/main/nvm/nvm.lisp
+++ b/src/main/nvm/nvm.lisp
@@ -647,10 +647,12 @@ DESCRIPTION:
 (defun clear-ticks ()
  (setf *ticks* nil))
 
 (defun clear-ticks ()
  (setf *ticks* nil))
 

-(defun create-world (&key dims)
- "CREATE-WORLD &key DIMS => RESULT
+(defun create-world (&key dims globals)
+ "CREATE-WORLD &key DIMS GLOBALS => RESULT

 
   DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
 
   DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)

+  GLOBALS: GLOBAL*
+  GLOBAL: (NAME ACCESS-FUNC)

 
 ARGUMENTS AND VALUES:
 
 
 ARGUMENTS AND VALUES:
 


@@ -659,6 +661,8 @@ ARGUMENTS AND VALUES:
   XMAX: An integer representing the maximum patch coord in X
   YMIN: An integer representing the minimum patch coord in Y
   YMAX: An integer representing the maximum patch coord in Y
   XMAX: An integer representing the maximum patch coord in X
   YMIN: An integer representing the minimum patch coord in Y
   YMAX: An integer representing the maximum patch coord in Y

+  NAME: Symbol for the global in the keyword package
+  ACCESS-FUNC: Function to get the value of the global

 
 DESCRIPTION:
 
 
 DESCRIPTION:
 


@@ -667,6 +671,7 @@ DESCRIPTION:
   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 *dimensions* dims)
   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 *dimensions* dims)

+ (setf *globals* globals)

  (setf *breeds* (list (list :turtles "default")))
  (clear-ticks)
  (clear-patches)
  (setf *breeds* (list (list :turtles "default")))
  (clear-ticks)
  (clear-patches)


@@ -794,11 +799,13 @@ DESCRIPTION:
    (format nil "~S" (clnl-random:export))
    ""
    (format nil "~S" "GLOBALS")
    (format nil "~S" (clnl-random:export))
    ""
    (format nil "~S" "GLOBALS")

-   (format nil "~A~A"
+   (format nil "~A~A~{\"~A\"~^,~}"

     "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\","
     "\"min-pxcor\",\"max-pxcor\",\"min-pycor\",\"max-pycor\",\"perspective\",\"subject\","

-    "\"nextIndex\",\"directed-links\",\"ticks\",")
-   (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"-1\""
-    (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id*)
+    "\"nextIndex\",\"directed-links\",\"ticks\","
+    (mapcar #'string-downcase (mapcar #'car *globals*)))
+   (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"0\",\"nobody\",\"~A\",\"\"\"NEITHER\"\"\",\"~A\"~{,\"~A\"~}"
+    (min-pxcor) (max-pxcor) (min-pycor) (max-pycor) *current-id* (dump-object (or *ticks* -1d0))
+    (mapcar #'dump-object (mapcar #'funcall (mapcar #'cadr *globals*))))

    ""
    (format nil "~{~A~^~%~}" (export-turtles))
    ""
    ""
    (format nil "~{~A~^~%~}" (export-turtles))
    ""

diff --git a/src/main/package.lisp b/src/main/package.lisp
index 89a0ab3c82c61fc575006009fa97944488d9beec..f3aef8a0e9d318d9703e7151c657d122d2ddd164 100644 (file)
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -1,5 +1,7 @@
 (defpackage #:clnl (:use :common-lisp)
 (defpackage #:clnl (:use :common-lisp)

- (:export #:run #:boot #:run-commands #:run-reporter #:*model-package*)
+ (:export
+  #:run #:boot #:run-commands #:run-reporter #:*model-package*
+  #:model->multi-form-lisp #:model->single-form-lisp)

  (:documentation
   "Main CLNL package
 
  (:documentation
   "Main CLNL package
 


@@ -43,7 +45,7 @@ to match how java.util.Random works.  Turtles, all the way down."))
 
 (defpackage #:clnl-transpiler
  (:use :common-lisp)
 
 (defpackage #:clnl-transpiler
  (:use :common-lisp)

- (:export #:transpile-commands #:transpile-reporter)
+ (:export #:transpile #:reporter-p #:command-list-p)

  (:documentation
   "CLNL Transpiler
 
  (:documentation
   "CLNL Transpiler
 


@@ -129,7 +131,7 @@ is where all the features that the traditional NetLogo UI lives."))
 
 (defpackage #:clnl-model
  (:use :common-lisp)
 
 (defpackage #:clnl-model
  (:use :common-lisp)

- (:export #:default-model #:read-from-nlogo #:world-dimensions #:globals)
+ (:export #:default-model #:read-from-nlogo #:world-dimensions #:widget-globals #:code)

  (:documentation
   "CLNL Model
 
  (:documentation
   "CLNL Model
 

diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp
index b0fcb47790654cbc05e6868b20c732b1533caab1..327bdbd6d96c43e86a12394a5631cf994fbf67a8 100644 (file)
--- a/src/main/transpile.lisp
+++ b/src/main/transpile.lisp
@@ -1,40 +1,103 @@
 (in-package #:clnl-transpiler)
 
 (defparameter *prims* nil)
 (in-package #:clnl-transpiler)
 
 (defparameter *prims* nil)

-(defparameter *prim-aliases* nil)

 
 (defvar *local-variables* nil)
 
 (defvar *local-variables* nil)

+(defvar *dynamic-prims* nil)

 
 (defun prim-name (prim) (getf prim :name))
 (defun prim-type (prim) (getf prim :type))
 (defun prim-func (prim) (getf prim :func))
 
 (defun prim-name (prim) (getf prim :name))
 (defun prim-type (prim) (getf prim :type))
 (defun prim-func (prim) (getf prim :func))

-(defun is-reporter (prim) (eql :reporter (getf prim :type)))
-(defun is-command (prim) (eql :command (getf prim :type)))
+(defun prim-reporter-p (prim) (eql :reporter (getf prim :type)))
+(defun prim-command-p (prim) (eql :command (getf prim :type)))

 
 (defun find-prim (symb)
  (when symb
   (find-if
    (lambda (prim-name) (or (eql symb prim-name) (and (listp prim-name) (find symb prim-name))))
 
 (defun find-prim (symb)
  (when symb
   (find-if
    (lambda (prim-name) (or (eql symb prim-name) (and (listp prim-name) (find symb prim-name))))

-   *prims* :key #'prim-name)))
+   (append *prims* *dynamic-prims*)
+   :key #'prim-name)))

 
 

-; Let this grow, slowly but surely, eventually taking on calling context, etc.
-; For now, it's just a
-(defun transpile-commands (parsed-ast)
- "TRANSPILE-COMMANDS PARSED-AST => AST
+(defun transpile (parsed-ast &optional dynamic-prims)
+ "TRANSPILE PARSED-AST &optional DYNAMIC-PRIMS => AST
+
+  DYNAMIC-PRIMS: DYNAMIC-PRIM*
+  DYNAMIC-PRIM: (:name NAME :type TYPE :macro MACRO :func FUNC)
+  TYPE: :reporter | :command

 
 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
 
 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

+  NAME: A symbol in the keyword package
+  MACRO: A macro that will be called with the arguments ast
+  FUNC: A function that will be called with the transpiled arguments

 
 DESCRIPTION:
 
 
 DESCRIPTION:
 

-  TRANSPILE-COMMANDS takes a unambigious PARSED-AST and converts it to
-  Common Lisp code.
+  TRANSPILE takes a unambigious PARSED-AST and converts it to
+  Common Lisp code.  The PARSED-AST must be either a list of commands,
+  or a single reporter.
+
+  When a set of DYNAMIC-PRIMS is included, external language constructs
+  can be also transpiled.  The provided functions will be inserted into
+  the returned AST with a call to FUNCALL.  If :macro is included, instead
+  of having a call to FUNCALL provided, the macro will be run at netlogo
+  transpile time, with the arguments it should have specified to the
+  parser.  The result of that function call will then be dropped into
+  the ast.

 
   Calling eval on that code should work correctly as long as you have a
 
   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."
+  running engine."
+
+ (let
+  ((*dynamic-prims*
+    (mapcar
+     (lambda (prim)
+      (if (getf prim :macro)
+       (append (list :func (getf prim :macro)) prim)
+       (append (list :func (lambda (&rest args) `(funcall ,(getf prim :func) ,@args))) prim)))
+     dynamic-prims)))
+  (cond
+   ((command-list-p parsed-ast) (transpile-commands parsed-ast))
+   ((and (listp parsed-ast) (= 1 (length parsed-ast)) (reporter-p (car parsed-ast)))
+    (transpile-reporter (car parsed-ast)))
+   (t (error "Is neither a list of commands nor a reporter: ~S" parsed-ast)))))
+
+(defun command-list-p (parsed-ast)
+ "COMMAND-LIST-P PARSED-AST => RESULT
+
+ARGUMENTS AND VALUES:
+
+  PARSED-AST: An ast as returned by the parser
+  RESULT: A boolean
+
+DESCRIPTION:
+
+  COMMAND-LIST-P returns whether the parsed-ast is a valid list
+  of commands."
+ (and
+  (every #'listp parsed-ast)
+  (every #'prim-command-p (mapcar #'find-prim (mapcar #'car parsed-ast)))))
+
+(defun reporter-p (parsed-ast)
+ "REPORTER-P PARSED-AST => RESULT
+
+ARGUMENTS AND VALUES:
+
+  PARSED-AST: An ast as returned by the parser
+  RESULT: A boolean
+
+DESCRIPTION:
+
+  REPORTER-P returns whether the parsed-ast is a valid reporter."
+ (and
+  (symbolp (car parsed-ast))
+  (prim-reporter-p (find-prim (car parsed-ast)))))
+
+; Let this grow, slowly but surely, eventually taking on calling context, etc.
+; For now, it's just a
+(defun transpile-commands (parsed-ast)

  `(progn
    ,@(transpile-commands-inner parsed-ast)))
 
  `(progn
    ,@(transpile-commands-inner parsed-ast)))
 


@@ -67,27 +130,10 @@ DESCRIPTION:
  (cond
   ((not (listp command)) (error "Expected a statement of some sort"))
   ((not (find-prim (car command))) (error "Couldn't find the command for ~S" (car command)))
  (cond
   ((not (listp command)) (error "Expected a statement of some sort"))
   ((not (find-prim (car command))) (error "Couldn't find the command for ~S" (car command)))

-  ((not (is-command (find-prim (car command)))) (error "Expected command, got ~S" (car command)))
+  ((not (prim-command-p (find-prim (car command)))) (error "Expected command, got ~S" (car command)))

   (t (apply (prim-func (find-prim (car command))) (mapcar #'transpile-reporter (cdr command))))))
 
 (defun transpile-reporter (reporter)
   (t (apply (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
   ((stringp reporter) reporter)
  (cond
   ((numberp reporter) reporter) ; The parser converts to double for us
   ((stringp reporter) reporter)


@@ -100,7 +146,7 @@ DESCRIPTION:
   ((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)))

-  ((not (is-reporter (find-prim (car reporter)))) (error "Expected reporter, got ~S" (car reporter)))
+  ((not (prim-reporter-p (find-prim (car reporter)))) (error "Expected reporter, got ~S" (car reporter)))

   (t (apply (prim-func (find-prim (car reporter))) (mapcar #'transpile-reporter (cdr reporter))))))
 
 (defun transpile-command-block (block)
   (t (apply (prim-func (find-prim (car reporter))) (mapcar #'transpile-reporter (cdr reporter))))))
 
 (defun transpile-command-block (block)


@@ -124,9 +170,6 @@ DESCRIPTION:
 (defmacro defkeywordprim (name)
  `(defprim ,name :reporter (lambda () ',name)))
 
 (defmacro defkeywordprim (name)
  `(defprim ,name :reporter (lambda () ',name)))
 

-(defmacro defprim-alias (name real-symb)
- `(push (list :name ,name :real-symb ,real-symb) *prim-aliases*))
-

 (defmacro defagentvalueprim (name)
  `(defprim ,name :reporter (lambda () `(clnl-nvm:agent-value ,,name))))
 
 (defmacro defagentvalueprim (name)
  `(defprim ,name :reporter (lambda () `(clnl-nvm:agent-value ,,name))))
 


@@ -159,6 +202,7 @@ DESCRIPTION:
 
 (defagentvalueprim :label)
 (defagentvalueprim :label-color)
 
 (defagentvalueprim :label)
 (defagentvalueprim :label-color)

+(defsimpleprim :let :command nil)

 (defsimpleprim :lt :command clnl-nvm:turn-left)
 (defsimpleprim :not :reporter cl:not)
 (defkeywordprim :nobody)
 (defsimpleprim :lt :command clnl-nvm:turn-left)
 (defsimpleprim :not :reporter cl:not)
 (defkeywordprim :nobody)

diff --git a/src/test/clnl-test.asd b/src/test/clnl-test.asd
index 8e0a9dda7559ac516c2cef3035e21b5d9b7484ba..774f153298bc23aa7ab12337381cb159b382d5b8 100644 (file)
--- a/src/test/clnl-test.asd
+++ b/src/test/clnl-test.asd
@@ -6,5 +6,6 @@
  :components ((:file "package")
               (:file "main")
               (:file "simpletests")
  :components ((:file "package")
               (:file "main")
               (:file "simpletests")

+              (:file "modeltests")

               (:file "viewtests"))
  :depends-on (#-travis :ironclad :clnl))
               (:file "viewtests"))
  :depends-on (#-travis :ironclad :clnl))

diff --git a/src/test/main.lisp b/src/test/main.lisp
index 99dfe184a59cdfeb6be718bd0003cc3cc9adf8e6..e02a5d45dc20bb234703ae90172f825fe0e98a47 100644 (file)
--- a/src/test/main.lisp
+++ b/src/test/main.lisp
@@ -53,11 +53,11 @@
  `(defsimpletest
    (format nil "Simple Command - ~A" ,name)
    (lambda ()
  `(defsimpletest
    (format nil "Simple Command - ~A" ,name)
    (lambda ()

-    (clnl:boot "resources/empty.nlogo")
+    (clnl:boot "resources/empty.nlogo" t)

     (clnl:run-commands ,commands)
     (checksum= ,checksum (checksum-world)))
    (lambda ()
     (clnl:run-commands ,commands)
     (checksum= ,checksum (checksum-world)))
    (lambda ()

-    (clnl:boot "resources/empty.nlogo")
+    (clnl:boot "resources/empty.nlogo" t)

     (clnl:run-commands ,commands)
     (format nil "~A~A"
      (clnl-nvm:export-world)
     (clnl:run-commands ,commands)
     (format nil "~A~A"
      (clnl-nvm:export-world)


@@ -69,37 +69,102 @@
  `(defsimpletest
    (format nil "Simple Reporter - ~A" ,name)
    (lambda ()
  `(defsimpletest
    (format nil "Simple Reporter - ~A" ,name)
    (lambda ()

-    (clnl:boot "resources/empty.nlogo")
+    (clnl:boot "resources/empty.nlogo" t)

     (and
      (string= (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter)) ,value)
      (checksum= ,checksum (checksum-world))))
    (lambda ()
     (and
      (string= (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter)) ,value)
      (checksum= ,checksum (checksum-world))))
    (lambda ()

-    (clnl:boot "resources/empty.nlogo")
+    (clnl:boot "resources/empty.nlogo" t)

     (format nil "~A~%~A~A"
      (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter))
      (clnl-nvm:export-world)
      (checksum-world)))
    "bin/runcmd.scala"
     (format nil "~A~%~A~A"
      (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter))
      (clnl-nvm:export-world)
      (checksum-world)))
    "bin/runcmd.scala"

-   (format nil "~%@#$#@#$#@~A~%" ,reporter)))
+   (format nil "@#$#@#$#@~A" ,reporter)))

 
 (defmacro defreportertestwithsetup (name setup reporter value checksum)
  `(defsimpletest
    (format nil "Reporter With Setup - ~A" ,name)
    (lambda ()
 
 (defmacro defreportertestwithsetup (name setup reporter value checksum)
  `(defsimpletest
    (format nil "Reporter With Setup - ~A" ,name)
    (lambda ()

-    (clnl:boot "resources/empty.nlogo")
+    (clnl:boot "resources/empty.nlogo" t)

     (clnl:run-commands ,setup)
     (and
      (string= (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter)) ,value)
      (checksum= ,checksum (checksum-world))))
    (lambda ()
     (clnl:run-commands ,setup)
     (and
      (string= (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter)) ,value)
      (checksum= ,checksum (checksum-world))))
    (lambda ()

-    (clnl:boot "resources/empty.nlogo")
+    (clnl:boot "resources/empty.nlogo" t)

     (clnl:run-commands ,setup)
     (format nil "~A~%~A~A"
      (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter))
      (clnl-nvm:export-world)
      (checksum-world)))
    "bin/runcmd.scala"
     (clnl:run-commands ,setup)
     (format nil "~A~%~A~A"
      (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter))
      (clnl-nvm:export-world)
      (checksum-world)))
    "bin/runcmd.scala"

-   (format nil "~A~%@#$#@#$#@~A" ,setup ,reporter)))
+   (format nil "~A@#$#@#$#@~A" ,setup ,reporter)))
+
+(defun model-code->nlogo (code)
+ (format nil
+  "~A
+@#$#@#$#@
+GRAPHICS-WINDOW~%210~%10~%649~%470~%-1~%-1~%13.0~%1~%10~%1~%1~%1~%0~%1~%1~%1~%-1~%1~%-1~%1~%0~%0~%1~%ticks~%30.0~%
+@#$#@#$#@
+"
+  code))
+
+(defmacro defmodeltest (name model commands reporter value checksum)
+ `(defsimpletest
+   ,name
+   (lambda ()
+    (let
+     ((model (with-input-from-string (str ,(model-code->nlogo model)) (clnl-model:read-from-nlogo str))))
+     (and
+      (let
+       ((callback nil))
+       (declaim (sb-ext:muffle-conditions cl:warning))
+       (eval (clnl:model->single-form-lisp model :netlogo-callback (lambda (f) (setf callback f))))
+       (when ,commands (funcall callback ,commands))
+       (and
+        (or (not ,reporter) (string= (funcall (intern "DUMP-OBJECT" :clnl-nvm) (funcall callback ,reporter)) ,value))
+        (checksum= ,checksum (checksum-world))))
+      (let*
+       ((pkg (make-package (gensym)))
+        (clnl:*model-package* pkg)
+        (prev-package *package*))
+       (eval
+        (cons
+         'progn
+         (clnl:model->multi-form-lisp model (intern "BOOT-ME" pkg)
+          :netlogo-callback-fn (intern "NETLOGO-CALLBACK" pkg))))
+       (eval `(in-package ,(package-name prev-package)))
+       (funcall (symbol-function (intern "BOOT-ME" pkg)))
+       (when ,commands (funcall (symbol-function (intern "NETLOGO-CALLBACK" pkg)) ,commands))
+       (and
+        (or
+         (not ,reporter)
+         (string=
+          (funcall (intern "DUMP-OBJECT" :clnl-nvm) (funcall (intern "NETLOGO-CALLBACK" pkg) ,reporter))
+          ,value))
+        (checksum= ,checksum (checksum-world)))))))
+   (lambda ()
+    (let
+     ((callback nil))
+     (declaim (sb-ext:muffle-conditions cl:warning))
+     (eval
+      (clnl:model->single-form-lisp
+       (with-input-from-string (str ,(model-code->nlogo model)) (clnl-model:read-from-nlogo str))
+       :netlogo-callback (lambda (f) (setf callback f))))
+     (when ,commands (funcall callback ,commands))
+     (format nil "~A~A~A"
+      (if ,reporter (format nil "~A~%" (funcall (intern "DUMP-OBJECT" :clnl-nvm) (funcall callback ,reporter))) "")
+      (clnl-nvm:export-world)
+      (checksum-world))))
+   "bin/runcmd.scala"
+   (format nil "~A@#$#@#$#@~A@#$#@#$#@~A" ,commands (or ,reporter "") ,model)))
+
+(defmacro defmodelcommandtest (name model commands checksum)
+ `(defmodeltest (format nil "Model Command - ~A" ,name) ,model ,commands nil nil ,checksum))
+
+(defmacro defmodelreportertest (name model commands reporter value checksum)
+ `(defmodeltest (format nil "Model Reporter - ~A" ,name) ,model ,commands ,reporter ,value ,checksum))

 
 (defmacro defviewtest (name commands checksum)
  `(defsimpletest
 
 (defmacro defviewtest (name commands checksum)
  `(defsimpletest

diff --git a/src/test/modeltests.lisp b/src/test/modeltests.lisp
new file mode 100644 (file)
index 0000000..0ec8d01
--- /dev/null
+++ b/src/test/modeltests.lisp
@@ -0,0 +1,13 @@
+(in-package #:clnl-test)
+
+(defmodelcommandtest "globals 1"
+ "globals [a]"
+ "set a 5 crt a"
+ "4D66EDE80A8F4CA820D80853E763446502EA4E4E")
+
+(defmodelreportertest "globals 2"
+ "globals [a]"
+ "set a 5"
+ "a"
+ "5"
+ "F8507A0D88D681CCBF01898FEA263791F9DDCE63")

diff --git a/src/test/simpletests.lisp b/src/test/simpletests.lisp
index 378385a68fa31480218a93611c2f50ec2fd52a76..49631642fb7220e13a0daca9ee62b550a3e1f67d 100644 (file)
--- a/src/test/simpletests.lisp
+++ b/src/test/simpletests.lisp
@@ -160,10 +160,10 @@
  "4ABB6822402929878AB9E5A1084B9E4AE1F01D5B")
 
 (defsimplecommandtest "ticks 1" "reset-ticks tick"
  "4ABB6822402929878AB9E5A1084B9E4AE1F01D5B")
 
 (defsimplecommandtest "ticks 1" "reset-ticks tick"

- "E1DE30F072D785E0D0B59F28B0F7853E3D3E0D8B")
+ "22A78AC53B666DE94611D566D814AD3EA7CC26AB")

 
 (defreportertestwithsetup "ticks 2" "reset-ticks tick tick" "ticks" "2"
 
 (defreportertestwithsetup "ticks 2" "reset-ticks tick tick" "ticks" "2"

- "E1DE30F072D785E0D0B59F28B0F7853E3D3E0D8B")
+ "296AE6F478D03264745B0331EC5CEF578C37CAB9")

 
 (defreportertestwithsetup "of / who 1" "crt 10" "[ who ] of turtles" "[5 9 4 3 7 0 1 2 6 8]"
  "3F39BD2D8D5A1B2333E6C0DB665DBE3DCD5A75CE")
 
 (defreportertestwithsetup "of / who 1" "crt 10" "[ who ] of turtles" "[5 9 4 3 7 0 1 2 6 8]"
  "3F39BD2D8D5A1B2333E6C0DB665DBE3DCD5A75CE")