bring work up to date, added sample program, create runtime, used key…

…words for enums
wspace · Apr 2, 2018 · 3004353 · 3004353
1 parent 493199b
commit 3004353
Show file tree

Hide file tree

Showing 5 changed files with 72 additions and 36 deletions.
diff --git a/src/clj_whitespace/compiler.clj b/src/clj_whitespace/compiler.clj
@@ -3,10 +3,12 @@
     (:require [clj-whitespace.parser :as parser])
     (:gen-class))
 
-(defn compile [cmds program labels]
+(defn compile-program [cmds program labels]
     (match [cmds]
-        [(['("LABEL" l) & xs] :seq)] (recur (xs) (program) (conj labels {l (lazy-seq xs)}))
-        [([x & xs] :seq)] (recur (xs) (conj x program) (labels))
+        [([([:label l] :as x) & xs] :seq)] (if (contains? labels l) 
+                                        ((throw (Exception. "label already present in global table")))
+                                        (recur xs (conj program x) (conj labels {l xs})))
+        [([x & xs] :seq)] (recur xs (conj program x) labels)
         :else [program labels]
         ))
 
diff --git a/src/clj_whitespace/core.clj b/src/clj_whitespace/core.clj
@@ -1,5 +1,8 @@
 (ns clj-whitespace.core
   (:require [clj-whitespace.parser :as parser])
+  (:require [clj-whitespace.compiler :as compiler])
+  (:require [clj-whitespace.programs :as programs])
+  (:require [clj-whitespace.runtime :as runtime])
   (:import [jline.console ConsoleReader])
   (:gen-class))
 

diff --git a/src/clj_whitespace/parser.clj b/src/clj_whitespace/parser.clj
@@ -1,5 +1,6 @@
 (ns clj-whitespace.parser
     (:require [clojure.core.match :refer [match]])
+    (:require [clojure.pprint])
     (:gen-class))
 
 (def parse-stack-cmds)
@@ -8,76 +9,80 @@
 (def parse-arithmetic-cmds)
 (def parse-io-cmds)
 (def parse-parameter)
+(def parse)
 
-(defn tokenize-string [s] (re-seq #"[ \t\n]" s))
+(defn tokenize-string [s] (replace {"\t" :t, "\n" :n, " " :s} (re-seq #"[ \t\n]" s)))
 
 (defn tokenize-file [f] (tokenize-string (slurp f)))
 
 (defn parse [stream]
     (match [stream]
-        [([" " & xs] :seq)]       (parse-stack-cmds xs)
-        [(["\t" " " & xs] :seq)]  (parse-arithmetic-cmds xs)
-        [(["\t" "\t" & xs] :seq)] (parse-heap-cmds)
-        [(["\n" & xs] :seq)]      (parse-flow-cmds xs)
-        [(["\t" "\n" & xs] :seq)] (parse-io-cmds xs)
+        [([:s & xs] :seq)]    (parse-stack-cmds xs)
+        [([:t :s & xs] :seq)] (parse-arithmetic-cmds xs)
+        [([:t :t & xs] :seq)] (parse-heap-cmds xs)
+        [([:n & xs] :seq)]    (parse-flow-cmds xs)
+        [([:t :n & xs] :seq)] (parse-io-cmds xs)
         :else (throw (Exception. "unexpected token encountered while determining next op"))))
 
 (defn parse-stack-cmds [stream] 
     (match [stream]
-        [([" " & xs] :seq)] (let [[val rest] (parse-parameter xs)]
+        [([:s & xs] :seq)] (let [[val rest] (parse-parameter xs)]
                                 (let [[sign & num] val]
                                     (def sign' (if (= "0" sign) 1 (-1)))
                                     (def num' (Integer/parseInt (apply str num) 2))
                                     (def number (* sign' num'))
-                                    (cons '("PUSH" number) (parse rest))))
-        [(["\n" " " & xs] :seq)] (cons "DUP" (parse xs))
-        [(["\n" "\t" & xs] :seq)] (cons "SWAP" (parse xs))
-        [(["\n" "\n" & xs] :seq)] (cons "POP" (parse xs))
+                                    (cons [:push number] (parse rest))))
+        [([:n :s & xs] :seq)] (cons :dup (parse xs))
+        [([:n :t & xs] :seq)] (cons :swap (parse xs))
+        [([:n :n & xs] :seq)] (cons :pop (parse xs))
         :else (throw (Exception. "unexpected token encountered while parsing stack op"))))
 
 (defn parse-arithmetic-cmds [stream] 
     (match [stream]
-        [([" " " " & xs] :seq)]  (cons "ADD" (parse xs))
-        [([" " "\t" & xs] :seq)] (cons "SUB" (parse xs))
-        [([" " "\n" & xs] :seq)] (cons "MUL" (parse xs))
-        [(["\t" " " & xs] :seq)] (cons "DIV" (parse xs))
-        [(["\t" "\t" & xs] :seq)] (cons "MOD" (parse xs))
+        [([:s :s & xs] :seq)] (cons :add (parse xs))
+        [([:s :t & xs] :seq)] (cons :sub (parse xs))
+        [([:s :n & xs] :seq)] (cons :mul (parse xs))
+        [([:t :s & xs] :seq)] (cons :div (parse xs))
+        [([:t :t & xs] :seq)] (cons :mod (parse xs))
         :else (throw (Exception. "unexpected token encountered while parsing arith op"))))
 
 (defn parse-heap-cmds [stream] 
     (match [stream]
-        [([" " & xs] :seq)]  (cons "STORE" (parse xs))
-        [(["\t" & xs] :seq)] (cons "LOAD" (parse xs))
+        [([:s & xs] :seq)] (cons :store (parse xs))
+        [([:t & xs] :seq)] (cons :load (parse xs))
         :else (throw (Exception. "unexpected newline encountered while parsing heap op"))))
 
 (defn parse-flow-cmds [stream] 
     (match [stream]
-        [([" " " " & xs] :seq)] (let [[val rest] (parse-parameter xs)] (cons '("LABEL" val) (parse rest)))
-        [([" " "\t" & xs] :seq)] (let [[val rest] (parse-parameter xs)] (cons '("CALL" val) (parse rest)))
-        [([" " "\n" & xs] :seq)] (let [[val rest] (parse-parameter xs)] (cons '("JUMP" val) (parse rest)))
-        [(["\t" " " & xs] :seq)] (let [[val rest] (parse-parameter xs)] (cons '("JUMP-IF-ZERO" val) (parse rest)))
-        [(["\t" "\t" & xs] :seq)] (let [[val rest] (parse-parameter xs)] (cons '("JUMP-IF-NEG" val) (parse rest)))
-        [(["\t" "\n" & xs] :seq)] (cons "RETURN" (parse xs))
-        [(["\n" "\n"] :seq)] (cons "END" (sequence nil))
+        [([:s :s & xs] :seq)] (let [[val rest] (parse-parameter xs)] (cons [:label (Long/parseLong (apply str val) 2)] (parse rest)))
+        [([:s :t & xs] :seq)] (let [[val rest] (parse-parameter xs)] (cons [:call (Long/parseLong (apply str val) 2)] (parse rest)))
+        [([:s :n & xs] :seq)] (let [[val rest] (parse-parameter xs)] (cons [:jump (Long/parseLong (apply str val) 2)] (parse rest)))
+        [([:t :s & xs] :seq)] (let [[val rest] (parse-parameter xs)] (cons [:jump-if-zero (Long/parseLong (apply str val) 2)] (parse rest)))
+        [([:t :t & xs] :seq)] (let [[val rest] (parse-parameter xs)] (cons [:jump-if-neg (Long/parseLong (apply str val) 2)] (parse rest)))
+        [([:t :n & xs] :seq)] (cons :return (parse xs))
+        [([:n :n & xs] :seq)] (cons :end (sequence nil))
         :else (throw (Exception. "unexpected token encountered with parsing flow control op"))))
 
 (defn parse-io-cmds [stream] 
     (match [stream]
-        [([" " " " & xs] :seq)] (cons "PRINT-CHAR" (parse xs))
-        [([" " "\t" & xs] :seq)] (cons "PRINT-INT" (parse xs))
-        [(["\t" " " & xs] :seq)] (cons "READ-CHAR" (parse xs))
-        [(["\t" "\t" & xs] :seq)] (cons "READ-INT" (parse xs))
+        [([:s :s & xs] :seq)] (cons :print-char (parse xs))
+        [([:s :t & xs] :seq)] (cons :print-int (parse xs))
+        [([:t :s & xs] :seq)] (cons :read-char (parse xs))
+        [([:t :t & xs] :seq)] (cons :read-int (parse xs))
         :else (throw (Exception. "unexpected newline encountered while parsing io op"))))
 
 (defn parse-parameter [stream]
-    (let [[x xs] (split-with (partial not= "\n") stream)] 
+    (let [[x xs] (split-with (partial not= :n) stream)] 
         (if (< (count x) 2) (throw (Exception. "malformed parameter before linefeed")))
-        (def values (map (fn [chr] (if (= chr " ") "0" "1")) x))
+        (def values (map (fn [chr] (if (= chr :s) "0"  "1")) x))
         (def xs' (drop 1 xs))
         [values xs']))
 
 (defn parse-string [s] 
-    (let [[tokens] (tokenize-string s)] (parse tokens)))
+    (let [tokens (tokenize-string s)] (apply list(parse tokens))))
 
 (defn parse-file [f] 
-    (let [[tokens] (tokenize-file f)] (parse tokens)))
+    (let [tokens (tokenize-file f)] 
+        (def output (apply list (parse tokens)))
+        (spit (str f ".clj") (str "'" (with-out-str (clojure.pprint/pprint output))))
+        output))
diff --git a/src/clj_whitespace/programs.clj b/src/clj_whitespace/programs.clj
@@ -0,0 +1,4 @@
+(ns clj-whitespace.programs
+    (:gen-class))
+
+(def hello-world "   \t      \t \n   \t\t\t \t\t   \t\t  \t \n    \n\t\t    \t  \t   \n\t\n     \t\t  \t \t\n\t\n     \t\t \t\t  \n \n \t\n  \t\n     \t\t \t\t\t\t\n\t\n     \t     \n\t\n     \t \t \t\t\t\n\t\n     \t\t \t\t\t\t\n\t\n     \t\t\t  \t \n\t\n     \t\t \t\t  \n\t\n     \t\t  \t  \n\t\n     \t    \t\n\t\n     \t \t \n\t\n  \n\n\n\n    ")
diff --git a/src/clj_whitespace/runtime.clj b/src/clj_whitespace/runtime.clj
@@ -0,0 +1,22 @@
+(ns clj-whitespace.runtime
+    (:require [clojure.core.match :refer [match]])
+    (:gen-class))
+
+(defn routine [prgm stack table labels call-stack]
+    (if (empty? prgm)
+        (do ())
+        (match [prgm]
+            [([[:push v] & xs] :seq)] (routine xs (conj stack v) table labels call-stack)
+            [([:dup & xs] :seq)] (let [x (peek stack)] (routine xs (conj stack x) table labels call-stack))
+            [([:swap & xs] :seq)] (let [a (first stack) b (second stack)] (routine xs (concat [b a] (nnext stack)) table labels call-stack))
+            [([:pop & xs] :seq)] (routine xs (pop stack) table labels call-stack) 
+            [([:add & xs] :seq)] (let [a (first stack) b (second stack)] (routine xs (conj (nnext stack) (+ b a)) table labels call-stack))
+            [([:sub & xs] :seq)] (let [a (first stack) b (second stack)] (routine xs (conj (nnext stack) (- b a)) table labels call-stack))
+            [([:mul & xs] :seq)] (let [a (first stack) b (second stack)] (routine xs (conj (nnext stack) (* b a)) table labels call-stack))
+            [([:div & xs] :seq)] (let [a (first stack) b (second stack)] (routine xs (conj (nnext stack) (/ b a)) table labels call-stack))
+            [([:mod & xs] :seq)] (let [a (first stack) b (second stack)] (routine xs (conj (nnext stack) (mod b a)) table labels call-stack))
+            [([:print-char & xs] :seq)] (do (print (char (first stack))) (routine xs stack table labels call-stack))
+            [([:print-int & xs] :seq)] (do (print (first stack)) (routine xs stack table labels call-stack))
+            :else (throw (Exception. "[runtime/routine] unexpected or malformed op!")))))
+
+(defn exec [prgm labels] (routine prgm '() {} labels nil))