Skip to content
Switch branches/tags

Name already in use

A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
Go to file
Cannot retrieve contributors at this time
(ns ram
(:require [clojure.math.combinatorics :as c]
[clojure.string :as string]))
; ex v0
; -----
(def ex-state-v0 {:charge-map {:a 1 :b 1 :c 0}
:nand-gates [{:ins [:a :b]
:out :c}]})
; state v0
; ---------------
(def empty-state {:charge-map {} :nand-gates []})
(defn charge [state wire]
(get-in state [:charge-map wire]))
(defn charges [state wires]
(map (partial charge state) wires))
(defn set-charge [state wire charge]
(assoc-in state [:charge-map wire] charge))
(defn wire-nand-gate [state a b o]
(update state :nand-gates conj {:ins [a b] :out o}))
(charges (-> empty-state
(set-charge :a 1)
(set-charge :b 0))
[:a :b])
(wire-nand-gate empty-state :a :b :c))
; trigger v0
; ----------
(defn nand-xf [a b]
(if (= a b 1) 0 1))
(nand-xf 0 0)
(nand-xf 1 1))
(defn dependent-nand-gates [state wire]
(filter (fn [{:keys [ins]}] (some #{wire} ins))
(:nand-gates state)))
(dependent-nand-gates (wire-nand-gate empty-state :a :b :c) :a))
(declare trigger-nand-gate)
(defn trigger
([state wire new-v]
(let [old-c (charge state wire)
state' (set-charge state wire new-v)
new-c (charge state' wire)]
(if (= old-c new-c)
(reduce (fn [s out] (trigger-nand-gate s out))
(dependent-nand-gates state' wire))))))
(defn trigger-nand-gate
[state {:keys [ins out]}]
(let [new-charge (apply nand-xf (charges state ins))]
(trigger state out new-charge)))
(defn trigger-many [state wires charges]
(fn [acc-state [wire charge]]
(trigger acc-state wire charge))
(map vector wires charges)))
; not gate
; --------
(defn wire-not-gate
([state a o]
(wire-nand-gate state a a o)))
; wires v0
; ----------
(def _u (atom {}))
(defn uniq-n [k]
(swap! _u update k (fn [i] (inc (or i 0))))
(get @_u k))
(defn kw [& args]
(->> args
(map (fn [x] (if ((some-fn keyword? symbol?) x)
(name x)
(apply str)
(defn wire
(let [i (uniq-n n)]
(if (> i 1) (kw n "#" i) n))))
[(wire :a)
(wire :a)])
; and gate
; --------
(defn wire-and-gate [state a b o]
(let [nand-o (wire (kw a b :and-nand-o))]
(-> state
(wire-nand-gate a b nand-o)
(wire-not-gate nand-o o))))
; memory-bit
; ----------
(defn wire-memory-bit
([state s i o]
(let [a (wire :a)
b (wire :b)
c (wire :c)]
(-> state
(wire-nand-gate i s a)
(wire-nand-gate a s b)
(wire-nand-gate a c o)
(wire-nand-gate b o c)))))
; wires v1
; ----------
(defn names [n r]
(mapv (fn [i] (kw n "-" i)) (range r)))
(def wires (comp (partial mapv wire) names))
(comment (wires :i 8))
; byte
; ----
(defn wire-byte [state s ins outs]
(reduce (fn [acc-state [i o]]
(wire-memory-bit acc-state s i o))
(map vector ins outs)))
; enabler
; -------
(defn wire-enabler
[state e ins outs]
(fn [acc-state [in out]]
(wire-and-gate acc-state e in out))
(map vector ins outs)))
; register
; --------
(defn wire-register [state s e ins bits outs]
(-> state
(wire-byte s ins bits)
(wire-enabler e bits outs)))
; state v1
; --------
(defn set-charge
([state source wire charge]
(assoc-in state [:charge-map wire source] charge)))
(comment (set-charge empty-state :nand-a :w 1))
(defn charge [{:keys [charge-map]} w]
(when-let [charges (vals (charge-map w))]
(apply max charges)))
(let [s1 (-> empty-state
(set-charge :nand-a :w 1)
(set-charge :nand-b :w 0))]
(charge s1 :w)))
; trigger v1
; ----------
(defn trigger-nand-gate
[state {:keys [ins out]}]
(let [new-charge (apply nand-xf (charges state ins))]
(trigger (apply kw (conj ins out)) state out new-charge)))
(defn trigger
([state wire new-v] (trigger :repl state wire new-v))
([source state wire new-v]
(let [old-c (charge state wire)
state' (set-charge state source wire new-v)
new-c (charge state' wire)]
(if (= old-c new-c)
(reduce (fn [s out] (trigger-nand-gate s out))
(dependent-nand-gates state' wire))))))
; wire-bus
; --------
(defn wire-bus [state bus-wires s e bits]
(wire-register state s e bus-wires bits bus-wires))
; and-n
; -----
(defn wire-and-n [state ins out]
(let [[a b] (take 2 ins)
rem (drop 2 ins)]
(if-not (seq rem)
(wire-and-gate state a b out)
(let [w (wire (kw a b :-and))]
(wire-and-gate state a b w)
(list* w rem)
; decoder
; -------
(def decoder-mapping (partial c/selections [0 1]))
(comment (decoder-mapping 2))
(defn wire-decoder
[state ins outs]
(let [ins-nots (mapv #(wire (kw % :-not)) ins)
state' (reduce
(fn [acc-state [in out]]
(wire-not-gate acc-state in out))
(map vector ins ins-nots))
state'' (reduce
(fn [acc-state [sel out]]
(let [and-ins (map-indexed
(fn [i sign]
(if (= sign 0)
(nth ins-nots i)
(nth ins i)))
(wire-and-n acc-state and-ins out)))
(map vector (decoder-mapping (count ins)) outs))]
; mar
; ---
(defn wire-mar
[state s is os first-4-outs last-4-outs]
(-> state
(wire-byte s is os)
(wire-decoder (take 4 os) first-4-outs)
(wire-decoder (drop 4 os) last-4-outs)))
; io
; --
(defn wire-io
[state io-s io-e ios decoder-o-1 decoder-o-2 register-bits]
(let [x (wire (kw decoder-o-1 decoder-o-2 :x))
s (wire (kw decoder-o-1 decoder-o-2 :s))
e (wire (kw decoder-o-1 decoder-o-2 :e))]
(-> state
(wire-and-gate decoder-o-1 decoder-o-2 x)
(wire-and-gate x io-s s)
(wire-and-gate x io-e e)
(wire-bus ios s e register-bits))))
; ram
; ---
(defn wire-ram [state mar-s mar-is io-s io-e ios]
(let [mar-os (wires :mar-o 8)
mar-first-4-outs (wires :mar-dec-f 16)
mar-last-4-outs (wires :mar-dec-l 16)
state' (wire-mar state mar-s mar-is mar-os mar-first-4-outs mar-last-4-outs)
intersections (c/cartesian-product mar-first-4-outs mar-last-4-outs)
state'' (reduce
(fn [acc-state [fw lw]]
(wire-io acc-state io-s io-e ios fw lw
(wires (kw fw lw :rb) 8)))
; state v2
; ----
(def empty-state {:charge-map {} :in->nand-gate {}})
(defn wire-nand-gate [s a b o]
(fn [acc-state in]
(update-in acc-state
[:in->nand-gate in]
(fn [xs] (conj (or xs []) {:ins [a b] :out o}))))
[a b]))
(defn dependent-nand-gates [s w]
(get-in s [:in->nand-gate w]))
; repl
; ----
(defn initialize-ram [mar-s mar-is io-s io-e ios]
(-> empty-state
(wire-ram mar-s mar-is io-s io-e ios)
(trigger-many mar-is [0 0 0 0 0 0 0 0])
(trigger-many ios [0 0 0 0 0 0 0 0])
(trigger-many [mar-s io-s io-e]
[0 0 0])))
(defn set-mar [state mar-s mar-is mar-vs]
(-> state
(trigger-many mar-is mar-vs)
(trigger mar-s 1)
(trigger mar-s 0)))
(defn handle-read [state mar-s mar-is io-e ios loc ]
(let [charge-bus-with-register (-> state
(set-mar mar-s mar-is loc)
(trigger io-e 1))
next (-> charge-bus-with-register
(trigger io-e 0))]
(println (str "> " (string/join (charges charge-bus-with-register
(defn handle-write [state mar-s mar-is io-s ios loc vs]
(let [next (-> state
(set-mar mar-s mar-is loc)
(trigger-many ios vs)
(trigger io-s 1)
(trigger io-s 0)
(trigger-many ios [0 0 0 0 0 0 0 0]))]
(println "> done")
(defn ram-repl []
(str "🔥 Ram Simulation: Type a command. Here's what you can do: \n"
" (read [1 0 1 0 1 0 1 0]) \n"
" (write [1 0 1 0 1 0 1 0] [1 1 1 1 1 1 1 1]) \n"
" (exit)"))
(let [mar-is (wires :mar-i 8)
ios (wires :mar-io 8)
initial-state (initialize-ram :mar-s mar-is :io-s :io-e ios)]
(loop [state initial-state]
(let [input (read-string (read-line))
cmd (first input)
args (rest input)]
(condp = cmd
(recur (handle-read state :mar-s mar-is :io-e ios (first args)))
(recur (handle-write state :ms mar-is :io-s ios (first args) (second args)))
(println "> Goodbye!"))))))