1 files changed, 146 insertions, 0 deletions
diff --git a/emit.fun b/emit.fun
new file mode 100644
index 0000000..cb77061
--- /dev/null
+++ b/emit.fun
@@ -0,0 +1,146 @@
+functor Emit(I: IL) = struct
+  structure I = I
+
+  structure P = I.P
+  structure D = P.D
+  structure PP = P.P
+
+  val file = ref NONE
+
+  local
+    fun output s =
+    let
+      val outstream = valOf $ !file
+    in
+      TextIO.output (outstream, s)
+    end
+
+    val ctx = ((false, makePrintfBase output),
+      fn (_: bool * ((string -> unit) * (unit -> unit))) => ())
+  in
+    fun fprint g = Fold.fold ctx g
+  end
+
+  fun fprintt g = fprint `"\t" g
+
+  fun fprinttn g =
+    fprintt (fn (a, _) => g (a, fn (_, out) => (Printf out `"\n" %)))
+
+  fun handleBSS objsZI =
+  let
+    val () = fprint `"section .bss\n" %
+
+    fun handleObj (id, _, t, _, _) =
+    let
+      val align = P.alignOfType t
+      val size = P.sizeOfType t
+    in
+      fprinttn `"align\t" W align %;
+      fprint PP.? id `":\tresb " W size `"\n" %
+    end
+  in
+    List.app handleObj objsZI
+  end
+
+  fun dd size w =
+  let
+    val cmd =
+      case size of
+        0w1 => "db"
+      | 0w2 => "dw"
+      | 0w4 => "dd"
+      | 0w8 => "dq"
+      | _ => raise Unreachable
+  in
+    fprint `cmd `" " W w %
+  end
+
+  fun emitScalarIni size w = (
+    fprint `"\t" %; dd size w; fprint `"\n" %
+  )
+
+  fun emitAggrLayout id =
+  let
+    val (_, size, layout) = D.get P.iniLayouts id
+
+    val () = fprint `"\n" %
+
+    fun getPadding offset t [] = size - (offset + P.sizeOfType t)
+      | getPadding offset t ({ offset = offset', ... } :: _) =
+        offset' - (offset + P.sizeOfType t)
+
+    fun emitScalars ({ offset, t, value } :: tail) =
+    let
+      val () = fprint `"\t" %
+      val () = dd (P.sizeOfType t) value
+      val padding = getPadding offset t tail
+    in
+      if padding > 0w0 then
+        fprint `"\n\tresb " W padding `"\n" %
+      else
+        fprint `"\n" %;
+      emitScalars tail
+    end
+      | emitScalars [] = ()
+  in
+    emitScalars layout
+  end
+
+  fun handleData objs =
+  let
+    val () = fprint `"section .data\n" %
+
+    fun emitLayout (id, _, t, ini, _) =
+    let
+      val align = P.alignOfType t
+      val size = P.sizeOfType t
+      val () = fprinttn `"align\t" W align %
+      val () = fprint PP.? id `":" %
+    in
+      case ini of
+        P.CiniConst w => emitScalarIni size w
+      | P.CiniLayout id => emitAggrLayout id
+      | P.CiniExpr _ => raise Unreachable
+    end
+  in
+    List.app emitLayout objs
+  end
+
+  fun handleStrlits strlits =
+  let
+    fun f id = fprint `".S" I id `":\tdb " `(PP.?? id) `", 0\n" %
+  in
+    fprint `"\n" %;
+    List.app f strlits
+  end
+
+  fun handleLocalIniLayouts () =
+  let
+    fun f (_, (true, _, _)) = ()
+      | f (n, (false, _, _)) = (
+        fprint `"\talign 16\n" %;
+        fprint `".I" I n `":" %;
+        emitAggrLayout n
+      )
+  in
+    D.appi f P.iniLayouts
+  end
+
+  fun openFile fname = file := SOME (TextIO.openOut fname)
+
+  fun emit fname
+    (I.Ctx { globSyms, extSyms, objsZI, objs, strlits, ... }) =
+  let
+    val () = openFile fname
+
+    val () = List.app (fn gs => fprint `"global " PP.? gs `"\n" %) globSyms
+    val () = List.app (fn es => fprint `"extern " PP.? es `"\n" %) extSyms
+
+    val () = handleBSS objsZI
+    val () = handleData objs
+    val () = handleStrlits strlits
+    val () = handleLocalIniLayouts ()
+  in
+    ()
+  end
+end