Apple-2-SW/robotwar
1
0
Fork 0
mirror of https://github.com/richardharrington/robotwar.git synced 2024-06-30 11:29:38 +00:00
Code Issues Projects Releases Wiki Activity

Merge branch 'assembler' -- this is a bad commit; should have merged this branch years ago

Browse Source
This commit is contained in:
Richard Harrington 2013-08-10 14:42:34 -04:00
commit 2d7388f00f
7 changed files with 176 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
project.clj
View File

@ -5,4 +5,5 @@
:url "http://www.eclipse.org/legal/epl-v10.html"}
:dependencies [[org.clojure/clojure "1.5.1"]
[org.clojure/core.match "0.2.0-rc5"]]
:profiles {:dev {:dependencies [[midje "1.5.1"]]}}
:main robotwar.core)

76
src/robotwar/assembler.clj
View File

@ -38,11 +38,10 @@
(re-seq-with-pos lex-re line)))
(defn lex
"Lexes a sequence of lines. After this point, tokens
are no longer grouped by line (line numbers have been
captured in metadata, along with column numbers)."
"Lexes a sequence of lines into a sequence of sequences of tokens
(referred to in docstrings for parsing functions as lines of tokens)."
[lines]
(apply concat (map-indexed lex-line lines)))
(map-indexed lex-line lines))
(defn str->int
"Integer/parseInt, but returns nil on failure"
@ -58,16 +57,15 @@
(def return-err (constantly "Invalid word or symbol"))
(defn parse-token
"takes a vector of reg-names and a token with a token-str field and parses the token.
"parses a token with a token-str field.
needs to work with the original token map by using dissoc and into
(rather than building a new one) because it contains line and column
number metadata."
[{token-str :token-str :as token} reg-names]
[{token-str :token-str :as token}]
(let [parser-priority
[[(set reg-names) :register]
[(set commands) :command]
[[(set commands) :command]
[str->int :number]
[valid-word :label]
[valid-word :identifier]
[return-err :error]]]
(some
(fn [[parser token-type]]
@ -76,19 +74,42 @@
:token-str)))
parser-priority)))
(defn parse
"take the tokens and convert them to structured source code ready for compiling.
if there's an error, returns a different type: just the token,
outside of any sequence."
[initial-tokens reg-names]
(defn parse-line
"takes a line of tokens and runs each token through parse-token for the first
pass of determining its type. Then parse-line further divides :identifier
tokens into two types: :label if it's the only thing on its line or it follows
a 'GOTO' or a 'GOSUB', and :register otherwise.
If we encounter an error, just return the token, not a sequence of tokens."
[initial-tokens]
(loop [[token & tail :as tokens] initial-tokens
parsed-tokens []]
(if (empty? tokens)
parsed-tokens
(let [{token-type :type :as parsed-token} (parse-token token reg-names)]
(if (= token-type :error)
parsed-token
(recur tail (conj parsed-tokens parsed-token)))))))
(let [{token-type :type token-val :val :as parsed-token} (parse-token token)]
(case token-type
:error parsed-token
(:command :number) (recur tail (conj parsed-tokens parsed-token))
:identifier (if (or (= (count initial-tokens) 1)
(#{"GOTO" "GOSUB"} (:val (last parsed-tokens))))
(recur tail (conj parsed-tokens (assoc parsed-token :type :label)))
(recur tail (conj parsed-tokens (assoc parsed-token :type :register)))))))))
(defn parse
"take the lines of tokens and converts them to :val and :type format.
After this point, tokens are no longer separated into sequences of sequences
according to the linebreaks in the original source code --
if we need that information later for error reporting, it's in the metadata.
if there's an error, this function just returns the token,
outside of any sequence."
[initial-token-lines]
(loop [[token-line & tail :as token-lines] initial-token-lines
parsed-token-lines []]
(if (empty? token-lines)
parsed-token-lines
(let [parsed-line (parse-line token-line)]
(if (= (:type parsed-line) :error)
parsed-line
(recur tail (concat parsed-token-lines parsed-line)))))))
(defn disambiguate-minus-signs
[initial-tokens]
@ -118,12 +139,12 @@
(if (empty? tokens)
result
(match [token]
[{:type (:or :number :register)}]
(recur tail (conj result [(into token {:val ",", :type :command}) token]))
[(:or {:type :label} {:type :command, :val "ENDSUB"})]
(recur tail (conj result [token nil]))
[{:type :command}]
(recur (rest tail) (conj result [token (first tail)]))))))
[{:type (:or :number :register)}]
(recur tail (conj result [(into token {:val ",", :type :command}) token]))
[(:or {:type :label} {:type :command, :val "ENDSUB"})]
(recur tail (conj result [token nil]))
[{:type :command}]
(recur (rest tail) (conj result [token (first tail)]))))))
; TODO: preserve :line and :pos metadata with labels,
; when labels are transferred from the instruction list to the label map
@ -143,17 +164,16 @@
(recur tail (assoc-in result [:labels (command :val)] next-instr-num))
(recur tail (assoc-in result [:instrs next-instr-num] instr)))))))
(defn assemble [src-code reg-names]
(defn assemble [src-code]
"compiles robotwar code, with error-checking beginning after the lexing
step. All functions that return errors will return a map with the keyword
:error, and then a token with a :val field containing the error string,
and metadata containing :pos and :line fields containing the location.
So far only parse implements error-checking."
(let [parse-with-reg-names #(parse % reg-names)
lexed (-> src-code split-lines strip-comments lex)]
(let [lexed (-> src-code split-lines strip-comments lex)]
(reduce (fn [result step]
(if (= (:type result) :error)
result
(step result)))
lexed
[parse-with-reg-names disambiguate-minus-signs make-instr-pairs map-labels])))
[parse disambiguate-minus-signs make-instr-pairs map-labels])))

2
src/robotwar/brain.clj
View File

@ -15,7 +15,7 @@
:instr-ptr 0
:call-stack []
:registers registers
:obj-code (assembler/assemble src-code (keys registers))})
:obj-code (assembler/assemble src-code)})
(defn resolve-arg [{arg-val :val arg-type :type} registers labels world read-register]
"resolves an instruction argument to a numeric value

90
test/robotwar/assembler_test.clj
View File

@ -1,8 +1,8 @@
(ns robotwar.assembler-test
(:use (clojure [string :only [join]]
[test])
[robotwar.assembler])
(:require [robotwar.register :as register]))
(:use [clojure.string :only [join]]
[clojure.test]
[midje.sweet]
[robotwar.assembler]))
(def line1 "IF DAMAGE # D GOTO MOVE ; comment or something")
(def line2 "AIM-17 TO AIM ; other comment")
@ -15,37 +15,37 @@
(def line-no-comments3 "IF X<-5 GOTO SCAN")
(def multi-line ["SCAN" "6 TO AIM"])
(def lexed-multi-line [{:token-str "SCAN"}
{:token-str "6"}
{:token-str "TO"}
{:token-str "AIM"}])
(def lexed-multi-line [[{:token-str "SCAN"}]
[{:token-str "6"}
{:token-str "TO"}
{:token-str "AIM"}]])
(def lexed-tokens1 [{:token-str "IF"}
{:token-str "DAMAGE"}
{:token-str "#"}
{:token-str "D"}
{:token-str "GOTO"}
{:token-str "MOVE"}])
(def lexed-tokens1 [[{:token-str "IF"}
{:token-str "DAMAGE"}
{:token-str "#"}
{:token-str "D"}
{:token-str "GOTO"}
{:token-str "MOVE"}]])
(def lexed-tokens2 [{:token-str "AIM"}
{:token-str "-"}
{:token-str "17"}
{:token-str "TO"}
{:token-str "AIM"}])
(def lexed-tokens2 [[{:token-str "AIM"}
{:token-str "-"}
{:token-str "17"}
{:token-str "TO"}
{:token-str "AIM"}]])
(def lexed-tokens3 [{:token-str "IF"}
{:token-str "X"}
{:token-str "<"}
{:token-str "-"}
{:token-str "5"}
{:token-str "GOTO"}
{:token-str "SCAN"}])
(def lexed-tokens3 [[{:token-str "IF"}
{:token-str "X"}
{:token-str "<"}
{:token-str "-"}
{:token-str "5"}
{:token-str "GOTO"}
{:token-str "SCAN"}]])
(def lexed-tokens4 [{:token-str "AIM"}
{:token-str "@"}
{:token-str "17"}
{:token-str "TO"}
{:token-str "AIM"}])
(def lexed-tokens4 [[{:token-str "AIM"}
{:token-str "@"}
{:token-str "17"}
{:token-str "TO"}
{:token-str "AIM"}]])
(def parsed-tokens2 [{:val "AIM", :type :register}
{:val "-", :type :command}
@ -212,47 +212,47 @@
(deftest parse-token-register
(testing "parsing register token"
(is (= (parse-token {:token-str "AIM"} register/reg-names)
{:val "AIM", :type :register}))))
(is (= (parse-token {:token-str "AIM"})
{:val "AIM", :type :identifier}))))
(deftest parse-token-command-word
(testing "parsing command token (word)"
(is (= (parse-token {:token-str "GOTO"} register/reg-names)
(is (= (parse-token {:token-str "GOTO"})
{:val "GOTO", :type :command}))))
(deftest parse-token-command-operator
(testing "parsing command token (operator)"
(is (= (parse-token {:token-str "#"} register/reg-names)
(is (= (parse-token {:token-str "#"})
{:val "#", :type :command}))))
(deftest parse-token-number
(testing "parsing number token"
(is (= (parse-token {:token-str "-17"} register/reg-names)
(is (= (parse-token {:token-str "-17"})
{:val -17, :type :number}))))
(deftest parse-token-label
(testing "parsing label token"
(is (= (parse-token {:token-str "SCAN"} register/reg-names)
{:val "SCAN", :type :label}))))
(is (= (parse-token {:token-str "SCAN"})
{:val "SCAN", :type :identifier}))))
(deftest parse-token-error
(testing "parsing error token"
(is (= (parse-token {:token-str "-GOTO"} register/reg-names)
(is (= (parse-token {:token-str "-GOTO"})
{:val "Invalid word or symbol", :type :error}))))
(deftest parse-tokens-minus-sign
(testing "parsing tokens with a binary minus sign"
(is (= (parse lexed-tokens2 register/reg-names)
(is (= (parse lexed-tokens2)
parsed-tokens2))))
(deftest parse-tokens-negative-sign
(testing "parsing tokens with a unary negative sign"
(is (= (parse lexed-tokens3 register/reg-names)
(is (= (parse lexed-tokens3)
parsed-tokens3))))
(deftest parse-tokens-error
(testing "parsing tokens with an invalid operator"
(is (= (parse lexed-tokens4 register/reg-names)
(is (= (parse lexed-tokens4)
parsed-tokens4))))
(def minus-sign-disambiguated-tokens2 parsed-tokens2)
@ -294,17 +294,17 @@
(deftest assemble-test-success
(testing "compiling successfully"
(is (= (assemble (join "\n" [line1 line2 line3]) register/reg-names)
(is (= (assemble (join "\n" [line1 line2 line3]))
multi-line-assembled))))
(deftest assemble-test-failure
(testing "assemble results in error"
(is (= (assemble (join "\n" [line1 line2 line3 line4]) register/reg-names)
(is (= (assemble (join "\n" [line1 line2 line3 line4]))
multi-line-assembled-error))))
(deftest preserving-line-and-pos-metadata-test
(testing "line and pos metadata preserved through assembly process"
(is (= (meta (get-in (assemble (join "\n" [line1 line2 line3]) register/reg-names)
(is (= (meta (get-in (assemble (join "\n" [line1 line2 line3]))
[:instrs 8 1]))
{:line 3, :pos 14}))))

41
test/robotwar/brain_test.clj
View File

@ -1,34 +1,32 @@
(ns robotwar.brain-test
(:use [clojure.test]
[midje.sweet]
[robotwar.brain])
(:require [robotwar.world :as world]
[robotwar.register :as register]
[robotwar.test-programs :as test-programs]))
(def initial-multi-use-world
(def initial-world
(world/init-world 256 256 [test-programs/multi-use-program]))
(def initial-index-data-world
(world/init-world 256 256 [test-programs/index-data-program]))
(def multi-use-worlds (iterate world/tick-world initial-multi-use-world))
(def index-data-worlds (iterate world/tick-world initial-index-data-world))
(def worlds (iterate world/tick-world initial-world))
(deftest branching-test
(testing "comparison statement should cause jump in instr-ptr"
(is (= (get-in (world/get-world 4 0 multi-use-worlds)
(is (= (get-in (world/get-world 4 0 worlds)
[:robots 0 :brain :instr-ptr])
5))))
(deftest arithmetic-test
(testing "addition"
(is (= (get-in (world/get-world 7 0 multi-use-worlds)
(is (= (get-in (world/get-world 7 0 worlds)
[:robots 0 :brain :acc])
1))))
(deftest gosub-test
(testing "gosub should move instr-ptr and add the return-ptr to the call stack"
(is (let [{:keys [instr-ptr call-stack]}
(get-in (world/get-world 5 0 multi-use-worlds)
(get-in (world/get-world 5 0 worlds)
[:robots 0 :brain])]
(= [instr-ptr call-stack]
[9 [6]])))))
@ -36,36 +34,13 @@
(deftest endsub-test
(testing "endsub pops instr-ptr off call stack and goes there"
(is (let [{:keys [instr-ptr call-stack]}
(get-in (world/get-world 9 0 multi-use-worlds)
(get-in (world/get-world 9 0 worlds)
[:robots 0 :brain])]
(= [instr-ptr call-stack]
[6 []])))))
(deftest push-test
(testing "pushing number to register"
(is (= (get-in (world/get-world 8 0 multi-use-worlds)
(is (= (get-in (world/get-world 8 0 worlds)
[:robots 0 :brain :registers "A" :val])
1))))
(deftest index-data-pair-test
(testing "registers whose index numbers are push to INDEX can
be referenced by accessing DATA"
(is (= (get-in (world/get-world 5 0 index-data-worlds)
[:robots 0 :brain :registers "A" :val])
300))))
; last test will use a different method:
; just push and pull from one sample world and one sample robot
(def initial-multi-use-robot ((:robots initial-multi-use-world) 0))
(deftest random-test
(testing "push to random register and pull a series of numbers all different
from random register"
(let [random-register (get-in initial-multi-use-robot [:brain :registers "RANDOM"])
new-world (register/write-register random-register initial-multi-use-world 1000)
random-nums (repeatedly 5 (partial register/read-register random-register new-world))]
(is (= (get-in new-world [:robots 0 :brain :registers "RANDOM" :val])
1000))
(is (every? #(< -1 % 1000) random-nums)))))

5
test/robotwar/core_test.clj
View File

@ -1,3 +1,4 @@
(ns robotwar.core-test
(:require [clojure.test :refer :all]
[robotwar.core :refer :all]))
(:use [clojure.test]
[midje.sweet]
[robotwar.core]))

70
test/robotwar/register_test.clj Normal file
View File

@ -0,0 +1,70 @@
(ns robotwar.register-test
(:use [clojure.test]
[midje.sweet]
[robotwar.register])
(:require [robotwar.world :as world]))
(def world (world/init-world 256 256 [""]))
(def robot-path [:robots 0])
(def reg-path [:robots 0 :brain :registers])
(def registers (get-in world reg-path))
(def get-registers #(get-in % reg-path))
(deftest storage-register-test
(testing "can write and read to storage register's :val field"
(let [new-world (write-register (registers "A") world 42)
new-registers (get-registers new-world)]
(is (= (read-register (new-registers "A") new-world)
42))
(is (= (get-in new-registers ["A" :val])
42)))))
(deftest index-data-pair-test
(testing "registers whose index numbers are push to INDEX can
be referenced by accessing DATA"
(let [world1 (write-register (registers "A") world 42)
registers1 (get-registers world1)
world2 (write-register (registers1 "INDEX") world1 1)
registers2 (get-registers world2)
world3 (write-register (registers2 "DATA") world2 100)
registers3 (get-registers world3)]
(is (= (read-register (registers2 "DATA") world2)
42))
(is (= (read-register (registers3 "A") world3)
100)))))
(deftest random-test
(testing "write to random register's :val field,
and read a series of numbers all different
from random register"
(let [new-world (write-register (registers "RANDOM") world 1000)
new-registers (get-registers new-world)
random-nums (repeatedly 5 (partial read-register (new-registers "RANDOM") new-world))]
(is (= (get-in new-registers ["RANDOM" :val])
1000))
(is (every? #(< -1 % 1000) random-nums))
(is (apply not= random-nums)))))
(deftest read-only-test
(testing "can read from read-only registers, but not write to them
(and also the robot fields don't get written to)"
(let [world1 (assoc-in world [:robots 0 :damage] 50)
registers1 (get-registers world1)
world2 (write-register (registers "DAMAGE") world1 25)
registers2 (get-registers world2)]
(is (= (read-register (registers1 "DAMAGE") world1)
50))
(is (= (read-register (registers2 "DAMAGE") world2)
50))
(is (= (get-in world2 [:robots 0 :damage])
50)))))
(deftest read-write-test
(testing "can read and write from registers that are interfaces
for robot fields, and also those robot fields get written to"
(let [new-world (write-register (registers "SPEEDX") world 90)
new-registers (get-registers new-world)]
(is (= (read-register (new-registers "SPEEDX") new-world)
90))
(is (= (get-in new-world [:robots 0 :desired-v-x])
90)))))