SHOW:
|
|
- or go back to the newest paste.
| 1 | ;;; compiles a simple array dsl to clojure code | |
| 2 | ; | |
| 3 | ; ; Each command operates on an implicit global 2d array of 256 rows and 256 columns | |
| 4 | ; SetCol 32 20 (set each slot in the 32nd column to 20) | |
| 5 | ; SetRow 20 12 (set each slot in the 20th row to 12) | |
| 6 | ; QueryRow 20 (sum each slot in the 20th row and print result) | |
| 7 | ; QueryCol 12 (sum each slot in the 12th column and print result) | |
| 8 | ||
| 9 | ||
| 10 | ;; load up a couple of string and io functions | |
| 11 | (use '[clojure.string :only (split-lines split trim)]) | |
| 12 | (use 'clojure.java.io) | |
| 13 | ||
| 14 | ||
| 15 | (defn split-by-spc [str] | |
| 16 | (split str #" ")) | |
| 17 | ||
| 18 | ;; split into separate strings by newline, then trim and split each line by spaces | |
| 19 | (defn tokenize-prog [str] | |
| 20 | (map (comp split-by-spc trim) (split-lines str))) | |
| 21 | ||
| 22 | ||
| 23 | ;; expands to a fast unboxed-array read with type hints | |
| 24 | (defmacro fast-aget | |
| 25 | ([hint array idx] | |
| 26 | `(aget ~(vary-meta array assoc :tag hint) ~idx)) | |
| 27 | ([hint array idx & idxs] | |
| 28 | `(let [a# (aget ~(vary-meta array assoc :tag 'objects) ~idx)] | |
| 29 | (fast-aget ~hint a# ~@idxs)))) | |
| 30 | ||
| 31 | ||
| 32 | ;; expands to a fast unboxed-array set with type hints | |
| 33 | (defmacro fast-aset [hint array & idxsv] | |
| 34 | (let [hints '{doubles double ints int}
| |
| 35 | [v idx & sxdi] (reverse idxsv) | |
| 36 | idxs (reverse sxdi) | |
| 37 | v (if-let [h (hints hint)] (list h v) v) | |
| 38 | nested-array (if (seq idxs) | |
| 39 | `(fast-aget ~'objects ~array ~@idxs) | |
| 40 | array) | |
| 41 | a-sym (with-meta (gensym "a") {:tag hint})]
| |
| 42 | `(let [~a-sym ~nested-array] | |
| 43 | (aset ~a-sym ~idx ~v)))) | |
| 44 | ||
| 45 | ||
| 46 | ||
| 47 | ;; case dispatch on 'opcode' (SetCol, SetRow, etc) | |
| 48 | ;; and return quoted code that, when evaluated, performs the operation | |
| 49 | (defn compile-code [[opcode op1 op2]] | |
| 50 | ;; parse integers from string | |
| 51 | (let [op1 (read-string op1) | |
| 52 | op2 (if op2 (read-string op2) )] | |
| 53 | (case opcode | |
| 54 | ||
| 55 | ;; loop over column and set values | |
| 56 | "SetCol" ` (let [~'x (int ~op1)] | |
| 57 | (dotimes [~'y (int 256)] | |
| 58 | (fast-aset ~'ints ~'matrix ~'y ~'x ~op2))) | |
| 59 | ||
| 60 | ;; loop over row | |
| 61 | "SetRow" `(let [~'y (int ~op1)] | |
| 62 | (dotimes [~'x (int 256)] | |
| 63 | (fast-aset ~'ints ~'matrix ~'y ~'x ~op2))) | |
| 64 | ||
| 65 | ;; sum values in column and print | |
| 66 | "QueryCol" `(println (let [~'x (int ~op1)] | |
| 67 | (loop [~'sum (int 0) ~'y 0] | |
| 68 | (if (>= ~'y (int 256)) | |
| 69 | ~'sum | |
| 70 | (recur (unchecked-add ~'sum (fast-aget ~'ints ~'matrix ~'y ~'x)) | |
| 71 | (unchecked-inc ~'y)))))) | |
| 72 | ||
| 73 | ;; sum values in row and print | |
| 74 | "QueryRow" `(println (let [~'y (int ~op1)] | |
| 75 | (loop [~'sum (int 0) ~'x (int 0)] | |
| 76 | (if (>= ~'x (int 256)) | |
| 77 | ~'sum | |
| 78 | (recur (unchecked-add ~'sum (fast-aget ~'ints ~'matrix ~'y ~'x)) | |
| 79 | (unchecked-inc ~'x))))))))) | |
| 80 | ||
| 81 | ||
| 82 | ||
| 83 | ;; get lines of file into list | |
| 84 | (defn get-lines [file] | |
| 85 | (with-open [rdr (clojure.java.io/reader file)] | |
| 86 | (reduce conj [] (line-seq rdr)))) | |
| 87 | ||
| 88 | ;; compile array dsl into clojure code and evaluate | |
| 89 | ;; result of compilation will be something like | |
| 90 | ;; (let [matrix ...] | |
| 91 | ;; array loops and stuff | |
| 92 | - | (compile-array-dsl-file (first *command-line-args*)) |
| 92 | + | |
| 93 | ;; | |
| 94 | - | (System/exit 0) |
| 94 | + | |
| 95 | (defn compile-array-dsl-file [file] | |
| 96 | (let [lines (get-lines file)] | |
| 97 | (eval | |
| 98 | `(let [~'matrix (make-array Integer/TYPE 256 256)] | |
| 99 | ~@(map (comp compile-code split-by-spc) lines))))) | |
| 100 | ||
| 101 | (compile-array-dsl-file "some-file.txt") |