A slightly interesting VHDL generator

It can now generate a multiplexer from multiplexer.clj.

Indentation is a mess at this point

Author: epall

mux.vhd

@@ -0,0 +1,56 @@
+-------------------------------------------------
+-- VHDL code for 4:1 multiplexor
+-- (ESD book figure 2.5)
+-- by Weijun Zhang, 04/2001
+--
+-- Multiplexor is a device to select different
+-- inputs to outputs. we use 3 bits vector to 
+-- describe its I/O ports 
+-------------------------------------------------
+
+library ieee;
+use ieee.std_logic_1164.all;
+
+-------------------------------------------------
+
+entity Mux is
+port(	I3: 	in std_logic_vector(2 downto 0);
+	I2: 	in std_logic_vector(2 downto 0);
+	I1: 	in std_logic_vector(2 downto 0);
+	I0: 	in std_logic_vector(2 downto 0);
+	S:	in std_logic_vector(1 downto 0);
+	O:	out std_logic_vector(2 downto 0)
+);
+end Mux;  
+
+-------------------------------------------------
+
+architecture behv1 of Mux is
+begin
+    process(I3,I2,I1,I0,S)
+    begin
+    
+        -- use case statement
+        case S is
+	    when "00" =>	O <= I0;
+	    when "01" =>	O <= I1;
+	    when "10" =>	O <= I2;
+	    when "11" =>	O <= I3;
+	    when others =>	O <= "ZZZ";
+	end case;
+
+    end process;
+end behv1;
+
+architecture behv2 of Mux is
+begin
+
+    -- use when.. else statement
+    O <=	I0 when S="00" else
+		I1 when S="01" else
+		I2 when S="10" else
+		I3 when S="11" else
+		"ZZZ";
+
+end behv2;
+--------------------------------------------------

src/computer-build/vhdl.clj

@@ -0,0 +1,75 @@
+(ns computer_build.vhdl)
+
+(defn lines [& strings]
+  (apply str (interpose "\n" strings))
+  )
+
+(defn indented-lines [indent & strings]
+  (apply lines (map #(str "  " %) strings))
+  )
+
+(defn spaces [& strings]
+  (apply str (interpose " " strings))
+  )
+
+(defn keyword-to-str [sym]
+  (if (keyword? sym) (apply str (rest (str sym))) (str \" sym \"))
+  )
+
+(defmulti to-vhdl first)
+(defmethod to-vhdl :default [arg] "unimplemented")
+(defmethod to-vhdl 'entity [entity]
+  (let [[type name ports & architecture] entity]
+    (lines
+      (spaces "entity" name "is")
+      "port("
+      ;(spaces (concat '(port) (first ports)))
+      ;(interpose " " (concat '(port) (first ports)))
+      (apply str (interpose ";\n" (map to-vhdl (map #(cons 'port %) ports))))
+      ");"
+      (str "end " name ";")
+
+      (str "architecture arch_" name " of " name " is")
+      "begin"
+      (apply lines (map to-vhdl architecture))
+      (str "end arch_" name ";")
+
+      ;(lines (map to-vhdl (map ports #(concat '(port) %))))
+  )))
+(defmethod to-vhdl 'port [port]
+  (let [[type id direction type] port]
+    (str "  " (keyword-to-str id) ": " (keyword-to-str direction) " " type)
+    ))
+
+(defmethod to-vhdl 'process [process]
+  (let [[type ports & definition] process]
+    (indented-lines 1
+      (str "process(" (apply str (interpose "," (map keyword-to-str ports))) ")")
+      "begin"
+      (apply lines (map to-vhdl definition))
+      "end process;"
+      )))
+
+(defmethod to-vhdl 'case [statement]
+  (let [[type target & cases] statement]
+    (indented-lines 2
+      (spaces "case" (keyword-to-str target) "is")
+      ;(lines (map #(str "when" (str "\"" (first %) "\""))
+      (apply lines (map #(str "when \"" (first %) "\" => " (to-vhdl (second %)) \;)
+           (partition 2 cases)))
+      "end case;"
+    )))
+
+(defmethod to-vhdl '<= [statement]
+  (let [[type target expression] statement]
+    (str (keyword-to-str target) " <= " (keyword-to-str expression))
+    ))
+
+(defn generate-vhdl [& entities]
+  (do
+    (println "library ieee;")
+    (println "use ieee.std_logic_1164.all;")
+    (println (to-vhdl (first entities)))
+    ;(println (lines (map to-vhdl entities)))
+    )
+  )

src/computer-build/main.clj renamed to src/computer_build/main.clj

@@ -0,0 +1,25 @@
+(use 'computer_build.vhdl)
+
+(generate-vhdl
+  '(entity "Mux"
+           ;; ports
+           [
+            [:I3 :in "std_logic_vector(2 downto 0)"]
+            [:I2 :in "std_logic_vector(2 downto 0)"]
+            [:I1 :in "std_logic_vector(2 downto 0)"]
+            [:I0 :in "std_logic_vector(2 downto 0)"]
+            [:S :in "std_logic_vector(1 downto 0)"]
+            [:O :out "std_logic_vector(2 downto 0)"]
+            ]
+           ;; architecture
+           (process [:I3 :I2 :I1 :I0 :S]
+                    (case :S
+                          "00" (<= :O :I0)
+                          "01" (<= :O :I1)
+                          "10" (<= :O :I2)
+                          "11" (<= :O :I3)
+                          "others" (<= :O "ZZZ")
+                          )
+                    )
+           )
+  )