From: mzp <mzpppp@gmail.com>
Date: Tue, 15 Sep 2009 11:23:23 +0000 (+0900)
Subject: add bytesIn module
X-Git-Url: http://git.osdn.net/view?a=commitdiff_plain;h=0481c4f70b8be97131750a2f52bad3799002aa43;p=happyabc%2Fhappyabc.git

add bytesIn module
---

diff --git a/swflib/OMakefile b/swflib/OMakefile
index 1eda172..7004d4f 100644
--- a/swflib/OMakefile
+++ b/swflib/OMakefile
@@ -6,6 +6,7 @@ OCAMLPACKS[] =
 	str
 
 FILES[] =
+	bytesIn
 	bytesOut
 	label
 	abcType
@@ -35,6 +36,7 @@ OCamlProgram(gen_typemap,gen_typemap)
 # test
 OUnitTest(label    , label)
 OUnitTest(bytesOut , bytesOut label)
+OUnitTest(bytesIn  , bytesIn)
 OUnitTest(lowInst  , lowInst bytesOut)
 OUnitTest(highInst , highInst label cpool revList)
 OUnitTest(abcOut   , abcOut label bytesOut)
diff --git a/swflib/bytesIn.ml b/swflib/bytesIn.ml
new file mode 100644
index 0000000..73fbf87
--- /dev/null
+++ b/swflib/bytesIn.ml
@@ -0,0 +1,78 @@
+open Base
+
+let rec repeat n f stream =
+  if n <= 0 then
+    []
+  else
+    match stream with parser
+	[<c = f>] ->
+	  c::repeat (n-1) f stream
+      | [<>] ->
+	  raise (Stream.Error "invalid format")
+
+
+let of_channel ch =
+  Stream.from (fun _ -> try
+		 Some (input_byte ch)
+	       with End_of_file ->
+		 None)
+
+let (++) x y =
+  (x lsl 8) + y
+
+let byte =
+  Stream.next
+
+let u8 =
+  parser [<c = byte>] -> c
+
+let u16 =
+  parser [<n2 = byte; n1 = byte >] ->
+    n1 ++ n2
+
+let size =
+  Sys.word_size - 24 - 1
+
+let s_extend d =
+  (d lsl size) asr size
+
+let s24 =
+  parser [<n3 = byte; n2 = byte; n1 = byte>] ->
+    s_extend (n1 ++ n2 ++ n3)
+
+let leq n stream =
+  match Stream.peek stream with
+      Some m when m <= n ->
+	Stream.next stream
+    | _ ->
+	raise Stream.Failure
+
+let (+++) x y =
+  Int32.logor (Int32.shift_left x 7) (Int32.logand y 0x7Fl)
+
+let rec read_u32 stream =
+  match stream with parser
+      [<n = leq 0x7F >] ->
+	Int32.of_int n
+    | [<n = byte>] ->
+	(read_u32 stream) +++ (Int32.of_int n)
+    | [<>] ->
+	raise (Stream.Error "invalid format")
+
+let u30 =
+  Int32.to_int $ read_u32
+
+let u32 =
+  read_u32
+
+let s32 =
+  read_u32
+
+let d64 =
+  let shift_or x y =
+    Int64.logor (Int64.shift_left y 8) (Int64.of_int x) in
+    parser
+	[<d = repeat 8 byte>] ->
+	  Int64.float_of_bits @@ List.fold_right shift_or d 0L
+
+
diff --git a/swflib/bytesIn.mli b/swflib/bytesIn.mli
new file mode 100644
index 0000000..7d8471f
--- /dev/null
+++ b/swflib/bytesIn.mli
@@ -0,0 +1,6 @@
+val u8  : int Stream.t -> int
+val u16 : int Stream.t -> int
+val s24 : int Stream.t -> int
+val u30 : int Stream.t -> int
+val u32 : int Stream.t -> int32
+val d64 : int Stream.t -> float
diff --git a/swflib/bytesInTest.ml b/swflib/bytesInTest.ml
new file mode 100644
index 0000000..306b92c
--- /dev/null
+++ b/swflib/bytesInTest.ml
@@ -0,0 +1,47 @@
+open OUnit
+open Base
+open BytesIn
+
+let of_list xs =
+  Stream.of_list xs
+
+let ok x y =
+  OUnit.assert_equal ~printer:Std.dump x y
+
+let tests = ("byte.ml" >::: [
+  "u8 is single byte" >::
+    (fun _ ->
+       ok 0 (u8 @@ of_list [0]));
+  "u16 is little endian" >::
+    (fun _ ->
+       ok 0x0100 (u16 @@ of_list [0;1] ));
+  "s24" >::
+    (fun _ ->
+       ok 0x000001 (s24 @@ of_list [1;0;0] );
+       ok ~-1 (s24 @@ of_list [0xFF;0xFF;0xFF] ));
+  "u30 is single byte when value < 0x7F" >::
+    (fun _ ->
+       ok 0    (u30 @@ of_list [0]);
+       ok 0x7F (u30 @@ of_list [0x7F]));
+  "u30 is 2 bytes when value <= 0x7F 0xFF"  >::
+    (fun _ ->
+       ok 0xFF    (u30 @@ of_list [0xFF;0x01]);
+       ok 0x3F_FF (u30 @@ of_list [0xFF;0x7F]));
+  "u30 is 3 bytes when value <= 0x7F 0xFF 0xFF" >::
+    (fun _ ->
+       ok 0x7FFF    (u30 @@ of_list [0xFF;0xFF;0x01]);
+       ok 0x1F_FFFF (u30 @@ of_list [0xFF;0xFF;0x7F]));
+  "u30 is 4 bytes when value <= 0x7F 0xFF 0xFF 0xFF" >::
+    (fun _ ->
+       ok 0x003F_FFFF (u30 @@ of_list [0xFF;0xFF;0xFF;0x01]);
+       ok 0x0FFF_FFFF (u30 @@ of_list [0xFF;0xFF;0xFF;0x7F]));
+  "u30 is 5 bytes when value <= 0x7F 0xFF 0xFF 0xFF 0xFF" >::
+    (fun _ ->
+       ok 0x1FFF_FFFF (u30 @@ of_list [0xFF;0xFF;0xFF;0xFF;0x01]));
+  "u32" >::
+    (fun _ ->
+       ok 0xFFFF_FFFFl (u32 @@ of_list [0xFF;0xFF;0xFF;0xFF;0xF]));
+  "d64 is float(IEEE 754 format)" >::
+    (fun _ ->
+       ok 0.75 (d64 @@ of_list [0;0;0;0;0;0;0xe8;0x3f]))
+]) +> run_test_tt_main