code generator for TagOut

diff --git a/swflib/OMakefile b/swflib/OMakefile
index a5ee0b6..7484443 100644 (file)
--- a/swflib/OMakefile
+++ b/swflib/OMakefile
@@ -66,6 +66,9 @@ OUnitTest(bitsOut, bitsOut)
 %.inst.h: gen_inst$(EXE) instruction.txt
      ./gen_inst$(EXE) -$> < instruction.txt > $@
 
+%.tag.h: gen_inst$(EXE) instruction.txt
+     ./gen_inst$(EXE) -$> < tag.txt > $@
+
 %.pat.h: gen_inst$(EXE) instruction.txt
      ./gen_inst$(EXE) -pat $> < instruction.txt > $@
 

diff --git a/swflib/gen_inst.ml b/swflib/gen_inst.ml
index a8e1afe..7a88eb1 100644 (file)
--- a/swflib/gen_inst.ml
+++ b/swflib/gen_inst.ml
@@ -150,6 +150,16 @@ let cmds = [
        sprintf "| %s -> %s" pat body
   end;
 
+  begin "-tag", fun {opcode; name; args} ->
+     let pat =
+       make_pat name args in
+     let body =
+       sprintf "(0x%x,[%s])"
+        opcode
+        (call_args "byte" args) in
+       sprintf "| %s -> %s" pat body
+  end;
+
   begin "-compile",fun {name;args}->
     let pat =
       make_pat name args in
@@ -160,12 +170,14 @@ let cmds = [
        sprintf "(%s)" @@ concat_mapi "," (sprintf "arg_%s ctx _%d") args in
       sprintf "| %s -> `%s %s" pat name args'
   end;
+
   begin "-pat",fun {name; args} ->
     let pat =
       make_pat name args in
       sprintf "| %s -> [%s]" pat @@
        call_args Sys.argv.(2) args
   end;
+
   begin "-extra",fun {name; args;extra} ->
     let pat =
       make_pat name args in

diff --git a/swflib/tag.txt b/swflib/tag.txt
new file mode 100644 (file)
index 0000000..c3d8635
--- /dev/null
+++ b/swflib/tag.txt
@@ -0,0 +1,4 @@
+End(0x00)
+ShowFrame(0x01)
+SetBackgroundColor of color(0x09)
+

diff --git a/swflib/tagOut.ml b/swflib/tagOut.ml
deleted file mode 100644 (file)
index 1e9e5ac..0000000
--- a/swflib/tagOut.ml
+++ /dev/null
@@ -1,14 +0,0 @@
-open Base
-
-type t = [
-  `End
-| `SetBackgroundColor of int * int * int
-| `ShowFrame
-]
-let to_base = function
-    `End ->
-      (0,[])
-  | `ShowFrame ->
-      (1,[])
-  | `SetBackgroundColor(r,g,b) ->
-      (9,[`RGB(r,g,b)])

diff --git a/swflib/tagOut.mlp b/swflib/tagOut.mlp
new file mode 100644 (file)
index 0000000..5e2e8ce
--- /dev/null
+++ b/swflib/tagOut.mlp
@@ -0,0 +1,11 @@
+open Base
+
+type color= {r:int; g:int; b:int}
+let byte_color {r;g;b} = `RGB(r,g,b)
+
+type t = [
+#include "type.tag.h"
+]
+
+let to_base = function
+#include "tag.tag.h"

diff --git a/swflib/tagOutTest.ml b/swflib/tagOutTest.ml
index 17cc423..825d7a3 100644 (file)
--- a/swflib/tagOutTest.ml
+++ b/swflib/tagOutTest.ml
@@ -3,15 +3,13 @@ open OUnit
 open TagOut
 
 let ok x y =
-  assert_equal x @@ to_base y
+  assert_equal ~printer:Std.dump x @@ to_base y
 
 let _ = begin "tagOut.ml" >::: [
   "End" >:: begin fun () ->
     ok (0,[]) `End
   end;
   "SetBackgroundColor" >:: begin fun () ->
-    ok (9,[`RGB(0,1,2)]) (`SetBackgroundColor (0,1,2))
+    ok (9,[`RGB(0,1,2)]) @@ `SetBackgroundColor {r=0; g=1; b=2}
   end
 ] end +> run_test_tt_main
-
-