482 - cleanup

Now chessboard is faster than in my super-late-bound language
(https://gist.github.com/akkartik/1291243). Reassuring.

2 files changed, 101 insertions, 102 deletions

diff --git a/chessboard-rawterm.mu b/chessboard-rawterm.mu
index 5493104a..cf74bea6 100644
--- a/chessboard-rawterm.mu
+++ b/chessboard-rawterm.mu
@@ -13,25 +13,25 @@
   ; assert(length(initial-position) == 64)
 ;?   (print-primitive (("list-length\n" literal)))
   (len:integer <- list-length initial-position:list-address)
-;?   (correct-length?:boolean <- equal len:integer 64:literal)
-;? ;?   (correct-length?:boolean <- equal len:integer 4:literal)
-;?   (assert correct-length?:boolean (("chessboard had incorrect size" literal)))
-;?   (b:board-address <- new board:literal 8:literal)
-;? ;?   (b:board-address <- new board:literal 2:literal)
-;?   (col:integer <- copy 0:literal)
-;?   (curr:list-address <- copy initial-position:list-address)
-;?   { begin
-;?     (done?:boolean <- equal col:integer 8:literal)
-;? ;?     (done?:boolean <- equal col:integer 2:literal)
-;?     (break-if done?:boolean)
-;? ;?     (print-primitive col:integer)
-;? ;?     (print-primitive (("\n" literal)))
-;?     (file:file-address-address <- index-address b:board-address/deref col:integer)
-;?     (file:file-address-address/deref curr:list-address <- read-file curr:list-address)
-;?     (col:integer <- add col:integer 1:literal)
-;?     (loop)
-;?   }
-;?   (reply b:board-address)
+  (correct-length?:boolean <- equal len:integer 64:literal)
+;?   (correct-length?:boolean <- equal len:integer 4:literal)
+  (assert correct-length?:boolean (("chessboard had incorrect size" literal)))
+  (b:board-address <- new board:literal 8:literal)
+;?   (b:board-address <- new board:literal 2:literal)
+  (col:integer <- copy 0:literal)
+  (curr:list-address <- copy initial-position:list-address)
+  { begin
+    (done?:boolean <- equal col:integer 8:literal)
+;?     (done?:boolean <- equal col:integer 2:literal)
+    (break-if done?:boolean)
+;?     (print-primitive col:integer)
+;?     (print-primitive (("\n" literal)))
+    (file:file-address-address <- index-address b:board-address/deref col:integer)
+    (file:file-address-address/deref curr:list-address <- read-file curr:list-address)
+    (col:integer <- add col:integer 1:literal)
+    (loop)
+  }
+  (reply b:board-address)
 ])
 
 (function read-file [
@@ -195,14 +195,14 @@
 ;?   (print-primitive (("\u2654 \u265a" literal)))
   (default-scope:scope-address <- new scope:literal 30:literal)
   (b:board-address <- read-board)
-;?   (console-on)
-;?   { begin
-;?     (clear-screen)
-;?     (print-board b:board-address)
-;?     (print-primitive (("? " literal)))
-;?     (m:move-address <- read-move)
-;?     (b:board-address <- make-move b:board-address m:move-address)
-;?     (loop)
-;?   }
-;?   (console-off)
+  (console-on)
+  { begin
+    (clear-screen)
+    (print-board b:board-address)
+    (print-primitive (("? " literal)))
+    (m:move-address <- read-move)
+    (b:board-address <- make-move b:board-address m:move-address)
+    (loop)
+  }
+  (console-off)
 ])
diff --git a/mu.arc b/mu.arc
index 74922b84..6b3091ab 100644
--- a/mu.arc
+++ b/mu.arc
@@ -29,7 +29,7 @@
 
 ;; what happens when our virtual machine starts up
 (= initialization-fns* (queue))
-(deftimed reset ()
+(def reset ()
   (each f (as cons initialization-fns*)
     (f)))
 
@@ -50,37 +50,36 @@
   (= curr-trace-file* nil)
   (= traces* (queue)))
 
-(deftimed new-trace (filename)
+(def new-trace (filename)
   (prn "== @filename")
 ;?   )
   (= curr-trace-file* filename))
 
 (= dump-trace* nil)
 (def trace (label . args)
-  nil)
-;?   (when (or (is dump-trace* t)
-;?             (and dump-trace* (is label "-"))
-;?             (and dump-trace* (pos label dump-trace*!whitelist))
-;?             (and dump-trace* (no dump-trace*!whitelist) (~pos label dump-trace*!blacklist)))
-;?     (apply prn label ": " args))
-;?   (enq (list label (apply tostring:prn args))
-;?        traces*))
+  (when (or (is dump-trace* t)
+            (and dump-trace* (is label "-"))
+            (and dump-trace* (pos label dump-trace*!whitelist))
+            (and dump-trace* (no dump-trace*!whitelist) (~pos label dump-trace*!blacklist)))
+    (apply prn label ": " args))
+  (enq (list label (apply tostring:prn args))
+       traces*))
 
 (redef tr args  ; why am I still returning to prn when debugging? Will this help?
   (do1 nil
        (apply trace "-" args)))
 
-(deftimed tr2 (msg arg)
+(def tr2 (msg arg)
   (tr msg arg)
   arg)
 
-(deftimed check-trace-contents (msg expected-contents)
+(def check-trace-contents (msg expected-contents)
   (unless (trace-contents-match expected-contents)
     (prn "F - " msg)
     (prn "  trace contents")
     (print-trace-contents-mismatch expected-contents)))
 
-(deftimed trace-contents-match (expected-contents)
+(def trace-contents-match (expected-contents)
   (each (label msg) (as cons traces*)
     (when (and expected-contents
                (is label expected-contents.0.0)
@@ -88,7 +87,7 @@
       (pop expected-contents)))
   (no expected-contents))
 
-(deftimed print-trace-contents-mismatch (expected-contents)
+(def print-trace-contents-mismatch (expected-contents)
   (each (label msg) (as cons traces*)
     (whenlet (expected-label expected-msg)  expected-contents.0
       (if (and (is label expected-label)
@@ -106,7 +105,7 @@
 ; things that a future assembler will need separate memory for:
 ;   code; types; args channel
 ;   at compile time: mapping names to locations
-(deftimed clear ()
+(def clear ()
   (= type* (table))  ; name -> type info
   (= memory* (table))  ; address -> value
   (= function* (table))  ; name -> [instructions]
@@ -203,7 +202,7 @@
 (defextend empty (x)  (isa x 'routine)
   (no rep.x!call-stack))
 
-(deftimed stack (routine)
+(def stack (routine)
   ((rep routine) 'call-stack))
 
 (mac push-stack (routine op)
@@ -213,10 +212,10 @@
 (mac pop-stack (routine)
   `(pop ((rep ,routine) 'call-stack)))
 
-(deftimed top (routine)
+(def top (routine)
   stack.routine.0)
 
-(deftimed body (routine)
+(def body (routine)
   (function* stack.routine.0!fn-name))
 
 (mac pc (routine (o idx 0))  ; assignable
@@ -235,10 +234,10 @@
 (mac results (routine)  ; assignable
   `((((rep ,routine) 'call-stack) 0) 'results))
 
-(deftimed waiting-for-exact-cycle? (routine)
+(def waiting-for-exact-cycle? (routine)
   (is 'literal rep.routine!sleep.1))
 
-(deftimed ready-to-wake-up (routine)
+(def ready-to-wake-up (routine)
   (assert no.routine*)
   (if (is 'literal rep.routine!sleep.1)
     (> curr-cycle* rep.routine!sleep.0)
@@ -291,7 +290,7 @@
 ;   wake up any necessary sleeping routines (which might be waiting for a
 ;     particular time or for a particular memory location to change)
 ;   detect deadlock: kill all sleeping routines when none can be woken
-(deftimed update-scheduler-state ()
+(def update-scheduler-state ()
 ;?   (trace "schedule" curr-cycle*)
   (when routine*
     (if
@@ -325,7 +324,7 @@
 ;?   (tr 114)
   )
 
-(deftimed detect-deadlock ()
+(def detect-deadlock ()
   (when (and (empty running-routines*)
              (~empty sleeping-routines*)
              (~some 'literal (map (fn(_) rep._!sleep.1)
@@ -335,7 +334,7 @@
       (= rep.routine!error "deadlock detected")
       (push routine completed-routines*))))
 
-(deftimed die (msg)
+(def die (msg)
   (tr "die: " msg)
   (= rep.routine*!error msg)
   (= rep.routine*!stack-trace rep.routine*!call-stack)
@@ -352,7 +351,7 @@
 
 ; routines consist of instrs
 ; instrs consist of oargs, op and args
-(deftimed parse-instr (instr)
+(def parse-instr (instr)
 ;?   (prn instr)
   (iflet delim (pos '<- instr)
     (list (cut instr 0 delim)  ; oargs
@@ -360,29 +359,29 @@
           (cut instr (+ delim 2)))  ; args
     (list nil (v car.instr) cdr.instr)))
 
-(deftimed metadata (operand)
+(def metadata (operand)
   cdr.operand)
 
-(deftimed ty (operand)
+(def ty (operand)
   (cdr operand.0))
 
-(deftimed literal? (operand)
+(def literal? (operand)
   (in ty.operand.0 'literal 'offset 'fn))
 
-(deftimed typeinfo (operand)
+(def typeinfo (operand)
   (or (type* ty.operand.0)
       (err "unknown type @(tostring prn.operand)")))
 
 ; operand accessors
-(deftimed nondummy (operand)  ; precondition for helpers below
+(def nondummy (operand)  ; precondition for helpers below
   (~is '_ operand))
 
 ; just for convenience, 'new' instruction sometimes takes a raw string and
 ; allocates just enough space to store it
-(deftimed not-raw-string (operand)
+(def not-raw-string (operand)
   (~isa operand 'string))
 
-(deftimed address? (operand)
+(def address? (operand)
   (or (is ty.operand.0 'location)
       typeinfo.operand!address))
 
@@ -391,7 +390,7 @@
 (= Viewport nil)
 
 ; run instructions from 'routine*' for 'time-slice'
-(deftimed run-for-time-slice (time-slice)
+(def run-for-time-slice (time-slice)
   (point return
     (for ninstrs 0 (< ninstrs time-slice) (++ ninstrs)
       (if (empty body.routine*) (err "@stack.routine*.0!fn-name not defined"))
@@ -683,7 +682,7 @@
         (++ pc.routine*)))
     (return time-slice)))
 
-(deftimed prepare-reply (args)
+(def prepare-reply (args)
   (= results.routine*
      (accum yield
        (each a args
@@ -695,7 +694,7 @@
 ;   indirect addressing - 'deref'
 ;   relative addressing - if routine* has 'default-scope'
 
-(deftimed m (loc)  ; read memory, respecting metadata
+(def m (loc)  ; read memory, respecting metadata
   (point return
     (when (literal? loc)
       (return v.loc))
@@ -712,7 +711,7 @@
             (annotate 'record
                       (map memory* (addrs addr n)))))))
 
-(deftimed setm (loc val)  ; set memory, respecting metadata
+(def setm (loc val)  ; set memory, respecting metadata
   (point return
     (when (is v.loc 'default-scope)
       (assert (is 1 sizeof.loc) "can't store compounds in default-scope @loc")
@@ -744,22 +743,22 @@
                 (trace "setm" loc ": setting " dest " to " src)
                 (= memory*.dest src))))))))
 
-(deftimed typeof (operand)
+(def typeof (operand)
   (let loc absolutize.operand
     (while (pos '(deref) metadata.loc)
       (zap deref loc))
     ty.loc.0))
 
-(deftimed addr (operand)
+(def addr (operand)
   (v canonize.operand))
 
-(deftimed addrs (n sz)
+(def addrs (n sz)
   (accum yield
     (repeat sz
       (yield n)
       (++ n))))
 
-(deftimed canonize (operand)
+(def canonize (operand)
 ;?   (tr "0: @operand")
   (ret operand
 ;?     (prn "1: " operand)
@@ -771,7 +770,7 @@
 ;?       (tr "3: @(tostring write.operand)")
       )))
 
-(deftimed array-len (operand)
+(def array-len (operand)
   (trace "array-len" operand)
   (zap canonize operand)
   (if typeinfo.operand!array
@@ -779,7 +778,7 @@
       :else
         (err "can't take len of non-array @operand")))
 
-(deftimed sizeof (x)
+(def sizeof (x)
   (trace "sizeof" x)
   (assert acons.x)
   (zap canonize x)
@@ -799,7 +798,7 @@
 ;?   (tr "sizeof: @x is a primitive")
   (return typeinfo.x!size)))
 
-(deftimed absolutize (operand)
+(def absolutize (operand)
   (if (no routine*)
         operand
       (is '_ v.operand)
@@ -819,7 +818,7 @@
                         space.operand)
           operand)))
 
-(deftimed lookup-space (operand base space)
+(def lookup-space (operand base space)
   (if (is 0 space)
     ; base case
     (if (< v.operand memory*.base)
@@ -831,17 +830,17 @@
     (lookup-space operand (memory* (+ base 1))  ; location 0 points to parent space
                   (- space 1))))
 
-(deftimed space (operand)
+(def space (operand)
   (or (alref operand 'space)
       0))
 
-(deftimed deref (operand)
+(def deref (operand)
   (assert (pos '(deref) metadata.operand))
   (assert address?.operand)
   (cons `(,(memory* v.operand) ,@typeinfo.operand!elem)
         (drop-one '(deref) metadata.operand)))
 
-(deftimed drop-one (f x)
+(def drop-one (f x)
   (when acons.x  ; proper lists only
     (if (testify.f car.x)
       cdr.x
@@ -849,18 +848,18 @@
 
 ; memory allocation
 
-(deftimed new-scalar (type)
+(def new-scalar (type)
 ;?   (tr "new scalar: @type")
   (ret result rep.routine*!alloc
     (++ rep.routine*!alloc (sizeof `((_ ,type))))))
 
-(deftimed new-array (type size)
+(def new-array (type size)
 ;?   (tr "new array: @type @size")
   (ret result rep.routine*!alloc
     (++ rep.routine*!alloc (+ 1 (* (sizeof `((_ ,@type*.type!elem))) size)))
     (= memory*.result size)))
 
-(deftimed new-string (literal-string)
+(def new-string (literal-string)
 ;?   (tr "new string: @literal-string")
   (ret result rep.routine*!alloc
     (= (memory* rep.routine*!alloc) len.literal-string)
@@ -871,7 +870,7 @@
 
 ;; desugar structured assembly based on blocks
 
-(deftimed convert-braces (instrs)
+(def convert-braces (instrs)
 ;?   (prn "convert-braces " instrs)
   (let locs ()  ; list of information on each brace: (open/close pc)
     (let pc 0
@@ -942,7 +941,7 @@
                   (yield instr)))
             (++ pc))))))))
 
-(deftimed close-offset (pc locs nblocks)
+(def close-offset (pc locs nblocks)
   (or= nblocks 1)
 ;?   (tr nblocks)
   (point return
@@ -961,13 +960,13 @@
 ;?         (tr "close now " loc)
         (return (- loc pc 1))))))))
 
-(deftimed open-offset (pc stack nblocks)
+(def open-offset (pc stack nblocks)
   (or= nblocks 1)
   (- (stack (- nblocks 1)) 1 pc))
 
 ;; convert jump targets to offsets
 
-(deftimed convert-labels (instrs)
+(def convert-labels (instrs)
 ;?   (tr "convert-labels " instrs)
   (let labels (table)
     (let pc 0
@@ -992,7 +991,7 @@
 
 ;; convert symbolic names to raw memory locations
 
-(deftimed add-closure-generator (instrs name)
+(def add-closure-generator (instrs name)
 ;?   (prn "== @name")
   (each instr instrs
     (when acons.instr
@@ -1015,7 +1014,7 @@
     )
   (replace-names-with-location instrs name))
 
-(deftimed assign-names-to-location (instrs name)
+(def assign-names-to-location (instrs name)
   (ret location (table)
     (with (isa-field  (table)
            idx  1)  ; 0 always reserved for parent scope
@@ -1064,7 +1063,7 @@
                 ; todo: can't allocate arrays on the stack
                 (++ idx (sizeof `((_ ,@ty.arg)))))))))))))
 
-(deftimed replace-names-with-location (instrs name)
+(def replace-names-with-location (instrs name)
   (each instr instrs
     (when (acons instr)
       (let (oargs op args)  (parse-instr instr)
@@ -1075,7 +1074,7 @@
   instrs)
 
 ; assign an index to an arg
-(deftimed maybe-add (arg location idx)
+(def maybe-add (arg location idx)
   (trace "maybe-add" arg)
   (when (and nondummy.arg
 ;?              (prn arg " " (assoc 'space arg))
@@ -1088,7 +1087,7 @@
     (= (location v.arg) idx)))
 
 ; convert the arg to corresponding index
-(deftimed convert-name (arg default-name)
+(def convert-name (arg default-name)
 ;?   (prn "111 @arg @default-name")
   (when (and nondummy.arg not-raw-string.arg
              (~is ty.arg.0 'literal))  ; can't use 'literal?' because we want to rename offsets
@@ -1103,7 +1102,7 @@
 ;?       (prn 115)
       )))
 
-(deftimed space-to-name (arg default-name)
+(def space-to-name (arg default-name)
   (ret name default-name
     (when (~is space.arg 'global)
       (repeat space.arg
@@ -1111,7 +1110,7 @@
 
 ;; literate tangling system for reordering code
 
-(deftimed convert-quotes (instrs)
+(def convert-quotes (instrs)
   (let deferred (queue)
     (each instr instrs
       (when (acons instr)
@@ -1173,7 +1172,7 @@
 
 ;; loading code into the virtual machine
 
-(deftimed add-code (forms)
+(def add-code (forms)
   (each (op . rest)  forms
     (case op
       ; function <name> [ <instructions> ]
@@ -1231,7 +1230,7 @@
           (push fragment after*.label))
       )))
 
-(deftimed freeze (function-table)
+(def freeze (function-table)
   (each (name body)  canon.function-table
 ;?     (prn "freeze " name)
     (= function-table.name (convert-labels:convert-braces:tokenize-args:insert-code body name)))
@@ -1244,7 +1243,7 @@
   ; we could clear location* at this point, but maybe we'll find a use for it
   )
 
-(deftimed tokenize-arg (arg)
+(def tokenize-arg (arg)
 ;?   (tr "tokenize-arg " arg)
   (if (in arg '<- '_)
         arg
@@ -1255,7 +1254,7 @@
       :else
         arg))
 
-(deftimed tokenize-args (instrs)
+(def tokenize-args (instrs)
 ;?   (tr "tokenize-args " instrs)
 ;?   (prn2 "@(tostring prn.instrs) => "
   (accum yield
@@ -1272,15 +1271,15 @@
   (pr msg)
   (apply prn args))
 
-(deftimed canon (table)
+(def canon (table)
   (sort (compare < [tostring (prn:car _)]) (as cons table)))
 
-(deftimed int-canon (table)
+(def int-canon (table)
   (sort (compare < car) (as cons table)))
 
 ;; test helpers
 
-(deftimed memory-contains (addr value)
+(def memory-contains (addr value)
 ;?   (prn "Looking for @value starting at @addr")
   (loop (addr addr
          idx  0)
@@ -1293,7 +1292,7 @@
         :else
           (recur (+ addr 1) (+ idx 1)))))
 
-(deftimed memory-contains-array (addr value)
+(def memory-contains-array (addr value)
 ;?   (prn "Looking for @value starting at @addr, size @memory*.addr vs @len.value")
   (and (>= memory*.addr len.value)
        (loop (addr (+ addr 1)
@@ -1316,7 +1315,7 @@
 (mac init-fn (name . body)
   `(= (system-function* ',name) ',body))
 
-(deftimed load-system-functions ()
+(def load-system-functions ()
   (each (name f) system-function*
     (= (function* name)
        (system-function* name))))
@@ -1783,10 +1782,10 @@
 ;?   (freeze function*)
 ;?   (prn function*!factorial)
   (run 'main)
-;?   (if ($.current-charterm) ($.close-charterm))
-;?   (prn "\nmemory: " int-canon.memory*)
+  (if ($.current-charterm) ($.close-charterm))
+  (prn "\nmemory: " int-canon.memory*)
   (each routine completed-routines*
     (aif rep.routine!error (prn "error - " it)))
 )
-;? (reset)
-(print-times)
+(reset)
+;? (print-times)