swflib/gen_typemap.ml

   1 open Base
   2 open Str
   3 open ExtList
   4 open Printf
   5
   6 let write name ~ocaml ~byte =
   7   printf "type %s = %s\n" name ocaml;
   8   printf "let write_%s= %s\n" name byte
   9
  10 let u30 name =
  11   write name ~ocaml:"int" ~byte:"u30"
  12
  13 let base name ~cpool=
  14   printf "let c_%s _x = %s\n" name cpool
  15
  16 let high name ~ocaml ~cpool =
  17   printf "type %s = %s\n" name ocaml;
  18   base name ~cpool
  19
  20 let lit name ~ocaml =
  21   high name ~ocaml ~cpool:"None"
  22
  23 let cpool name ~ocaml ~entry =
  24   high name ~ocaml ~cpool:(sprintf "Some (`%s _x)" entry)
  25
  26 let _ =
  27   match Sys.argv.(1) with
  28       "-low" ->
  29         u30 "method_";
  30         u30 "class_";
  31         u30 "c_int";
  32         u30 "c_uint";
  33         u30 "c_string";
  34         u30 "c_float";
  35         u30 "namespace";
  36         u30 "multiname";
  37         u30 "u30";
  38         write "u8" ~ocaml:"int" ~byte:"u8";
  39         write "label"
  40           ~ocaml:"(Label.t,int) either"
  41           ~byte:"function
  42                    Left  label   -> label_ref label
  43                  | Right address -> s24 address"
  44     | "-high" ->
  45         cpool "c_int" ~ocaml:"int" ~entry:"Int";
  46         cpool "c_uint" ~ocaml:"int" ~entry:"Int";
  47         cpool "c_string" ~ocaml:"string" ~entry:"String";
  48         cpool "c_float" ~ocaml:"float" ~entry:"Double";
  49         cpool "namespace" ~ocaml:"Cpool.namespace" ~entry:"Namespace";
  50         cpool "multiname" ~ocaml:"Cpool.multiname" ~entry:"Multiname";
  51         lit "label" ~ocaml:"Label.t";
  52         lit "u30" ~ocaml:"int";
  53         lit "u8" ~ocaml:"int";
  54         base "label" ~cpool:"None";
  55         base "method_" ~cpool:"None";
  56         base "class_" ~cpool:"None";
  57     | _ ->
  58         exit 1