(ero "initializing mu.. (takes ~5s)") ;; profiler (http://arclanguage.org/item?id=11556) ; Keeping this right on top as a reminder to profile before guessing at why my ; program is slow. (mac proc (name params . body) `(def ,name ,params ,@body nil)) (mac filter-log (msg f x) `(ret x@ ,x (prn ,msg (,f x@)))) (= times* (table)) (mac deftimed (name args . body) `(do (def ,(sym (string name "_core")) ,args ,@body) (def ,name ,args (let t0 (msec) (ret ans ,(cons (sym (string name "_core")) args) (update-time ,(string name) t0)))))) (proc update-time(name t0) ; call directly in recursive functions (or= times*.name (list 0 0)) (with ((a b) times*.name timing (- (msec) t0)) (= times*.name (list (+ a timing) (+ b 1))))) (def print-times() (prn (current-process-milliseconds)) (prn "gc " (current-gc-milliseconds)) (each (name time) (tablist times*) (prn name " " time))) ;; what happens when our virtual machine starts up (= initialization-fns* (queue)) (def reset () (each f (as cons initialization-fns*) (f))) (mac on-init body `(enq (fn () ,@body) initialization-fns*)) ;; persisting and checking traces for each test (= traces* (queue)) (= trace-dir* ".traces/") (ensure-dir trace-dir*) (= curr-trace-file* nil) (on-init (awhen curr-trace-file* (tofile (+ trace-dir* it) (each (label trace) (as cons traces*) (pr label ": " trace)))) (= curr-trace-file* nil) (= traces* (queue))) (def new-trace (filename) (prn "== @filename") ;? ) (= curr-trace-file* filename)) (= dump-trace* nil) (def trace (label . args) (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*) (car args)) (on-init (wipe dump-trace*)) (redef tr args ; why am I still returning to prn when debugging? Will this help? (do1 nil (apply trace "-" args))) (def tr2 (msg arg) (tr msg arg) arg) (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))) (def trace-contents-match (expected-contents) (each (label msg) (as cons traces*) (when (and expected-contents (is label expected-contents.0.0) (posmatch expected-contents.0.1 msg)) (pop expected-contents))) (no 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) (posmatch expected-msg msg)) (do (pr " * ") (pop expected-contents)) (pr " ")) (pr label ": " msg))) (prn " couldn't find") (each (expected-label expected-msg) expected-contents (prn " ! " expected-label ": " expected-msg))) (def check-trace-doesnt-contain (msg (label unexpected-contents)) (when (some (fn ((l s)) (and (is l label) (posmatch unexpected-contents msg))) (as cons traces*)) (prn "F - " msg) (prn " trace contents") (each (l msg) (as cons traces*) (if (and (is l label) (posmatch unexpected-contents msg)) (pr " X ") (pr " ")) (pr label ": " msg)))) ;; virtual machine state ; things that a future assembler will need separate memory for: ; code; types; args channel ; at compile time: mapping names to locations (on-init (= type* (table)) ; name -> type info (= memory* (table)) ; address -> value (make this a vector?) (= function* (table)) ; name -> [instructions] ; transforming mu programs (= location* (table)) ; function -> {name -> index into default-space} (= next-space-generator* (table)) ; function -> name of function generating next space ; each function's next space will usually always come from a single function (= next-routine-id* 0) (= continuation* (table)) ) (on-init (= type* (obj ; Each type must be scalar or array, sum or product or primitive type (obj size 1) ; implicitly scalar and primitive type-address (obj size 1 address t elem '(type)) type-array (obj array t elem '(type)) type-array-address (obj size 1 address t elem '(type-array)) location (obj size 1 address t elem '(location)) ; assume it points to an atom integer (obj size 1) boolean (obj size 1)
#!/bin/sh
# Translate SubX into minified ELF binaries for Linux.
set -e
grep -vh '^\s*#\|^\s*$' $* > a.in
cat a.in |tools/treeshake > a.treeshake
./translate_subx a.treeshake