Write a first draft of the compiler.

Sorry I haven't been better about these commit messages.
You're not my mom.

1 files changed, 90 insertions, 0 deletions

diff --git a/linker.sml b/linker.sml
new file mode 100644
index 0000000..b52e84b
--- /dev/null
+++ b/linker.sml
@@ -0,0 +1,90 @@
+structure Linker =
+struct
+  fun makeOpcode w code arg1Const arg2Const =
+    if code >= 0x40
+    then raise Fail "code is more than 6 bits"
+    else
+      let
+        val arg1Bit = if arg1Const then 2 else 0
+        val arg2Bit = if arg2Const then 1 else 0
+      in
+        BinIO.output1 (w, Word8.fromInt (code * 4 + arg1Bit + arg2Bit))
+      end
+
+  fun isConst (Syntax.VVar _) = false
+    | isConst _ = true
+
+  fun lowByte w n =
+    BinIO.output1 (w, Word8.fromInt (Word.toInt (Word.andb (n, Word.fromInt 0xff))))
+
+  fun writeInt w i =
+    let
+      val n = Word.fromInt i
+      fun go b =
+        if b < 8
+        then
+          (lowByte w (Word.>> (n, Word.fromInt (8 * b))) ;
+           go (b + 1))
+        else ()
+    in
+      go 0
+    end
+
+  structure IntMap = Map(type k = int val cmp = Int.compare);
+
+  fun encode (m : int IntMap.map) (w : BinIO.outstream) (oper : Syntax.opcode) : unit =
+    let
+      fun writeValue w (Syntax.VVar v) = writeInt w v
+        | writeValue w (Syntax.VLabel l) = writeInt w (getOpt (IntMap.lookup l m, 0))
+        | writeValue w (Syntax.VInt i) = writeInt w i
+        | writeValue w (Syntax.VString _) = raise Fail "I don't support strings yet"
+    in
+      case oper of
+        Syntax.OAlloc (r, v) =>
+          (makeOpcode w 1 (isConst v) false ;
+           writeInt w r ;
+           writeValue w v)
+      | Syntax.OCall =>
+          makeOpcode w 2 false false
+      | Syntax.OPoke (off, p, v) =>
+          (makeOpcode w 3 (isConst v) false ;
+           writeInt w off ;
+           writeInt w p ;
+           writeValue w v)
+      | Syntax.OPeek (r, off, v) =>
+          (makeOpcode w 4 (isConst v) false ;
+           writeInt w r ;
+           writeInt w off ;
+           writeValue w v)
+      | Syntax.OShuf (r, v) =>
+          (makeOpcode w 5 (isConst v) false ;
+           writeInt w r ;
+           writeValue w v)
+      | Syntax.OExit v =>
+          (makeOpcode w 6 (isConst v) false ;
+           writeValue w v)
+      | Syntax.OLabel _ => ()
+    end
+
+  fun link (program : Syntax.opcode list) : Word8Vector.vector =
+    let
+      val (w1, b1) = Buffer.buf ()
+      val labels =
+        foldl
+          (fn (x, acc) =>
+            (encode IntMap.empty w1 x ;
+             case x of
+               Syntax.OLabel l => IntMap.insert l (Word8ArraySlice.length (!b1)) acc
+             | _ => acc))
+          IntMap.empty
+          program
+      val (w, b) = Buffer.buf ()
+      fun go [] = ()
+        | go (oper :: program) =
+            (encode labels w oper ;
+             go program)
+    in
+      go program ;
+      Word8ArraySlice.vector (!b)
+    end
+end