From: Frank Duncan <frank@kank.net>
Date: Mon, 30 May 2016 03:53:54 +0000 (-0500)
Subject: Code reformat - Macro for functions implement commands to return :undefined
X-Git-Tag: v0.1.0~2
X-Git-Url: https://code.consxy.com/gitweb/?a=commitdiff_plain;h=6fc4a1700ede4beee1d2a547d75be6b40488a1f5;p=clnl

Code reformat - Macro for functions implement commands to return :undefined
---

diff --git a/.travis.yml b/.travis.yml
index fa44e4a..d52b800 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -6,7 +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/72aabe5/$(git rev-parse HEAD)/travissbcl
+  - wget http://frank.kank.net/travissbcl/clnl/31bdd7b/$(git rev-parse HEAD)/travissbcl
   - chmod +x travissbcl
 script:
   - ./travissbcl --script bin/all.lisp
diff --git a/bin/buildtravisexec.sh b/bin/buildtravisexec.sh
index a7757e2..5f8b14b 100755
--- a/bin/buildtravisexec.sh
+++ b/bin/buildtravisexec.sh
@@ -26,7 +26,7 @@ mkdir -p tmp/deps/
   tar zxf ../../deps/common-lisp/trivial-features_0.8.tar.gz &&
   tar zxf ../../deps/common-lisp/cl-charms-9bb94ef.tar.gz &&
   tar zxf ../../deps/common-lisp/style-checker_0.1.tar.gz &&
-  tar zxf ../../deps/common-lisp/docgen_0.2.tar.gz &&
+  tar zxf ../../deps/common-lisp/docgen_0.3.tar.gz &&
   tar zxf ../../deps/common-lisp/ieee-floats-92e481a.tar.gz &&
   tar zxf ../../deps/common-lisp/strictmath_0.1.tar.gz
 )
diff --git a/deps/common-lisp/docgen_0.2.tar.gz b/deps/common-lisp/docgen_0.2.tar.gz
deleted file mode 100644
index d1cc757..0000000
Binary files a/deps/common-lisp/docgen_0.2.tar.gz and /dev/null differ
diff --git a/deps/common-lisp/docgen_0.3.tar.gz b/deps/common-lisp/docgen_0.3.tar.gz
new file mode 100644
index 0000000..5833246
Binary files /dev/null and b/deps/common-lisp/docgen_0.3.tar.gz differ
diff --git a/src/main/main.lisp b/src/main/main.lisp
index 5bb9361..a226642 100644
--- a/src/main/main.lisp
+++ b/src/main/main.lisp
@@ -126,7 +126,8 @@ DESCRIPTION:
           (if (getf prim :macro) ; The reason we do this is because with macros, we want to evaluate them in
                                  ; this scope while preserving them for the generational purposes below
            (append (list :macro (eval (getf prim :macro))) prim)
-           prim)) prims))))))
+           prim)) prims)))
+    :undefined)))
 
 (defun model->single-form-lisp (model &key (seed 15) initialize-interface netlogo-callback)
  (multiple-value-bind
diff --git a/src/main/nvm/base.lisp b/src/main/nvm/base.lisp
index 7fec1df..1a80dc3 100644
--- a/src/main/nvm/base.lisp
+++ b/src/main/nvm/base.lisp
@@ -38,6 +38,9 @@ DESCRIPTION:
    (stop (s) (declare (ignore s)) :stop)
    (death (d) (declare (ignore d)) :death)))
 
+(defmacro defcommand (name args docstring &rest body)
+ `(defun ,name ,args ,docstring ,@body :undefined))
+
 (defstruct turtle who breed color heading xcor ycor (label "") label-color size shape own-vars)
 (defstruct patch color xcor ycor own-vars turtles)
 
diff --git a/src/main/nvm/controlflow.lisp b/src/main/nvm/controlflow.lisp
index a1df63b..b4368fd 100644
--- a/src/main/nvm/controlflow.lisp
+++ b/src/main/nvm/controlflow.lisp
@@ -1,14 +1,14 @@
 (in-package #:clnl-nvm)
 
-(defun ask (agent-or-agentset fn)
+(defcommand ask (agent-or-agentset fn)
  "ASK AGENT-OR-AGENTSET FN => RESULT
 
   AGENT-OR-AGENTSET: AGENT | AGENTSET
+  RESULT: :undefined
 
 ARGUMENTS AND VALUES:
 
   FN: a function, run on each agent
-  RESULT: undefined, commands don't return
   AGENT: a NetLogo agent
   AGENTSET: a NetLogo agentset
 
@@ -35,12 +35,10 @@ DESCRIPTION:
   (t
    (error "Ask requires an agentset or agent but got: ~A" agent-or-agentset))))
 
-(defun stop ()
+(defcommand stop ()
  "STOP => RESULT
 
-ARGUMENTS AND VALUES:
-
-  RESULT: undefined
+  RESULT: :undefined
 
 DESCRIPTION:
 
diff --git a/src/main/nvm/inout.lisp b/src/main/nvm/inout.lisp
index 7a78cf2..b8f88d4 100644
--- a/src/main/nvm/inout.lisp
+++ b/src/main/nvm/inout.lisp
@@ -80,13 +80,14 @@ DESCRIPTION:
     "\"end1\",\"end2\",\"color\",\"label\",\"label-color\",\"hidden?\",\"breed\",\"thickness\",\"shape\",\"tie-mode\""
     ""))))
 
-(defun show (value)
+(defcommand show (value)
  "SHOW VALUE => RESULT
 
+  RESULT: :undefined
+
 ARGUMENTS AND VALUES:
 
   VALUE: a NetLogo value
-  RESULT: undefined
 
 DESCRIPTION:
 
diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp
index 7927909..e3f582d 100644
--- a/src/main/nvm/nvm.lisp
+++ b/src/main/nvm/nvm.lisp
@@ -76,7 +76,7 @@ DESCRIPTION:
      ((= i (length copy)) (incf i) (car (last copy)))
      (t (let ((result agent)) (fetch) result)))))))
 
-(defun create-world (&key dims globals turtles-own-vars patches-own-vars breeds)
+(defcommand create-world (&key dims globals turtles-own-vars patches-own-vars breeds)
  "CREATE-WORLD &key DIMS GLOBALS TURTLES-OWN-VARS PATCHES-OWN-VARS BREEDS => RESULT
 
   DIMS: (:xmin XMIN :xmax XMAX :ymin YMIN :ymax YMAX)
@@ -84,11 +84,11 @@ DESCRIPTION:
   TURTLES-OWN-VARS: TURTLES-OWN-VAR*
   PATCHES-OWN-VARS: PATCHES-OWN-VAR*
   BREEDS: BREED*
+  RESULT: :undefined
   GLOBAL: (GLOBAL-NAME GLOBAL-ACCESS-FUNC)
 
 ARGUMENTS AND VALUES:
 
-  RESULT: undefined
   XMIN: An integer representing the minimum patch coord in X
   XMAX: An integer representing the maximum patch coord in X
   YMIN: An integer representing the minimum patch coord in Y
diff --git a/src/main/nvm/turtles.lisp b/src/main/nvm/turtles.lisp
index cdaa2c7..49c1834 100644
--- a/src/main/nvm/turtles.lisp
+++ b/src/main/nvm/turtles.lisp
@@ -1,14 +1,15 @@
 (in-package #:clnl-nvm)
 
-(defun create-turtles (n &optional breed fn)
+(defcommand create-turtles (n &optional breed fn)
  "CREATE-TURTLES N &optional BREED FN => RESULT
 
+  RESULT: :undefined
+
 ARGUMENTS AND VALUES:
 
   N: an integer, the numbers of turtles to create
   BREED: a breed
   FN: A function, applied to each turtle after creation
-  RESULT: undefined
 
 DESCRIPTION:
 
@@ -24,12 +25,10 @@ DESCRIPTION:
   ((new-turtles (loop :repeat n :collect (create-turtle breed))))
   (when fn (ask (list->agentset new-turtles :turtles) fn))))
 
-(defun die ()
+(defcommand die ()
  "DIE => RESULT
 
-ARGUMENTS AND VALUES:
-
-  RESULT: undefined, commands don't return
+  RESULT: :undefined
 
 DESCRIPTION:
 
@@ -51,14 +50,15 @@ DESCRIPTION:
   (setf (patch-turtles patch) (remove *self* (patch-turtles patch))))
  (error (make-condition 'death)))
 
-(defun hatch (n &optional fn)
+(defcommand hatch (n &optional fn)
  "HATCH N &optional FN => RESULT
 
+  RESULT: :undefined
+
 ARGUMENTS AND VALUES:
 
   N: an integer, the numbers of turtles to hatch
   FN: A function, applied to each turtle after creation
-  RESULT: undefined
 
 DESCRIPTION:
 
@@ -73,13 +73,14 @@ DESCRIPTION:
   ((new-turtles (loop :repeat n :collect (create-turtle nil *self*))))
   (when fn (ask (list->agentset new-turtles :turtles) fn))))
 
-(defun forward (n)
+(defcommand forward (n)
  "FORWARD N => RESULT
 
+  RESULT: :undefined
+
 ARGUMENTS AND VALUES:
 
   N: a double, the amount the turtle moves forward
-  RESULT: undefined
 
 DESCRIPTION:
 
@@ -153,14 +154,15 @@ DESCRIPTION:
    (max (+ (max-pycor) 0.5d0)))
   (+ min (clnl-random:next-double (- max min)))))
 
-(defun set-default-shape (breed shape)
+(defcommand set-default-shape (breed shape)
  "SET-DEFAULT-SHAPE BREED SHAPE => RESULT
 
+  RESULT: :undefined
+
 ARGUMENTS AND VALUES:
 
   BREED: a valid breed
   SHAPE: a string
-  RESULT: undefined
 
 DESCRIPTION:
 
@@ -173,14 +175,15 @@ DESCRIPTION:
  (when (not (breed-p breed)) (error "Need a valid breed"))
  (setf (breed-default-shape breed) shape))
 
-(defun setxy (x y)
+(defcommand setxy (x y)
  "SETXY X Y => RESULT
 
+  RESULT: :undefined
+
 ARGUMENTS AND VALUES:
 
   X: a double
   Y: a double
-  RESULT: undefined
 
 DESCRIPTION:
 
@@ -212,13 +215,14 @@ DESCRIPTION:
    (if breed (remove breed patch-turtles :key #'turtle-breed :test-not #'eql) patch-turtles)
    (or breed :turtles))))
 
-(defun turn-right (n)
+(defcommand turn-right (n)
  "TURN-RIGHT N => RESULT
 
+  RESULT: :undefined
+
 ARGUMENTS AND VALUES:
 
   N: a double, the amount the turtle turns
-  RESULT: undefined
 
 DESCRIPTION:
 
@@ -234,13 +238,14 @@ DESCRIPTION:
     ((>= new-heading 360) (mod new-heading 360))
     (t new-heading)))))
 
-(defun turn-left (n)
+(defcommand turn-left (n)
  "TURN-LEFT N => RESULT
 
+  RESULT: :undefined
+
 ARGUMENTS AND VALUES:
 
   N: a double, the amount the turtle turns
-  RESULT: undefined
 
 DESCRIPTION:
 
diff --git a/src/main/nvm/world.lisp b/src/main/nvm/world.lisp
index 6dfa214..5bac9b4 100644
--- a/src/main/nvm/world.lisp
+++ b/src/main/nvm/world.lisp
@@ -19,12 +19,10 @@
 (defun clear-ticks ()
  (setf *ticks* nil))
 
-(defun clear-all ()
+(defcommand clear-all ()
  "CLEAR-ALL => RESULT
 
-ARGUMENTS AND VALUES:
-
-  RESULT: undefined
+  RESULT: :undefined
 
 DESCRIPTION:
 
@@ -35,12 +33,10 @@ DESCRIPTION:
  (clear-patches)
  (clear-ticks))
 
-(defun display ()
+(defcommand display ()
  "DISPLAY => RESULT
 
-ARGUMENTS AND VALUES:
-
-  RESULT: undefined
+  RESULT: :undefined
 
 DESCRIPTION:
 
@@ -50,12 +46,10 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#display"
  nil)
 
-(defun reset-ticks ()
+(defcommand reset-ticks ()
  "RESET-TICKS => RESULT
 
-ARGUMENTS AND VALUES:
-
-  RESULT: undefined
+  RESULT: :undefined
 
 DESCRIPTION:
 
@@ -64,12 +58,10 @@ DESCRIPTION:
   See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#reset-ticks"
  (setf *ticks* 0d0))
 
-(defun tick ()
+(defcommand tick ()
  "RESET-TICKS => RESULT
 
-ARGUMENTS AND VALUES:
-
-  RESULT: undefined
+  RESULT: :undefined
 
 DESCRIPTION: