Lib/ocaml/swigp4.ml.in

   1 open Pcaml ;;
   2
   3 let lap x y = x :: y
   4 let c_ify e @OCAMLLOC@ =
   5   match e with
   6       <:expr< $int:_$ >> -> <:expr< (C_int $e$) >>
   7     | <:expr< $str:_$ >> -> <:expr< (C_string $e$) >>
   8     | <:expr< $chr:_$ >> -> <:expr< (C_char $e$) >>
   9     | <:expr< $flo:_$ >> -> <:expr< (C_double $e$) >>
  10     | <:expr< True    >> -> <:expr< (C_bool $e$) >>
  11     | <:expr< False   >> -> <:expr< (C_bool $e$) >>
  12     | _ -> <:expr< $e$ >>
  13 let mk_list args @OCAMLLOC@ f =
  14   let rec mk_list_inner args @OCAMLLOC@ f =
  15     match args with
  16         [] -> <:expr< [] >>
  17       | x :: xs ->
  18           (let @OCAMLLOC@ = MLast.loc_of_expr x in
  19              <:expr< [ ($f x @OCAMLLOC@$) ] @ ($mk_list_inner xs @OCAMLLOC@ f$) >>) in
  20     match args with
  21         [] -> <:expr< (Obj.magic C_void) >>
  22       | [ a ] -> <:expr< (Obj.magic $f a @OCAMLLOC@$) >>
  23       | _ -> <:expr< (Obj.magic (C_list ($mk_list_inner args @OCAMLLOC@ f$))) >>
  24
  25 EXTEND
  26   expr:
  27   [ [ e1 = expr ; "'" ; "[" ; e2 = expr ; "]" ->
  28         <:expr< (invoke $e1$) "[]" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  29     | e1 = expr ; "->" ; l = LIDENT ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
  30         <:expr< (invoke $e1$) $str:l$ ($mk_list args @OCAMLLOC@ c_ify$) >>
  31     | e1 = expr ; "->" ; u = UIDENT ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
  32         <:expr< (invoke $e1$) $str:u$ ($mk_list args @OCAMLLOC@ c_ify$) >>
  33     | e1 = expr ; "->" ; s = expr LEVEL "simple" ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
  34         <:expr< (invoke $e1$) $s$ ($mk_list args @OCAMLLOC@ c_ify$) >>
  35     | e1 = expr ; "'" ; "." ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
  36         <:expr< (invoke $e1$) "()" ($mk_list args @OCAMLLOC@ c_ify$) >>
  37     | e1 = expr ; "'" ; "->" ; l = LIDENT ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
  38         <:expr< (invoke ((invoke $e1$) "->" C_void)) $str:l$ ($mk_list args @OCAMLLOC@ c_ify$) >>
  39     | e1 = expr ; "'" ; "->" ; u = UIDENT ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
  40         <:expr< (invoke ((invoke $e1$) "->" C_void)) $str:u$ ($mk_list args @OCAMLLOC@ c_ify$) >>
  41     | e1 = expr ; "'" ; "->" ; s = expr LEVEL "simple" ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
  42         <:expr< (invoke ((invoke $e1$) "->" C_void)) $s$ ($mk_list args @OCAMLLOC@ c_ify$) >>
  43     | e1 = expr ; "'" ; "++" ->
  44         <:expr< (invoke $e1$) "++" C_void >>
  45     | e1 = expr ; "'" ; "--" ->
  46         <:expr< (invoke $e1$) "--" C_void >>
  47     | e1 = expr ; "'" ; "-" ; e2 = expr ->
  48         <:expr< (invoke $e1$) "-" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  49     | e1 = expr ; "'" ; "+" ; e2 = expr -> <:expr< (invoke $e1$) "+" (C_list [ $c_ify e2 @OCAMLLOC@$ ])  >>
  50     | e1 = expr ; "'" ; "*" ; e2 = expr -> <:expr< (invoke $e1$) "*" (C_list [ $c_ify e2 @OCAMLLOC@$ ])  >>
  51     | "'" ; "&" ; e1 = expr ->
  52         <:expr< (invoke $e1$) "&" C_void >>
  53     | "'" ; "!" ; e1 = expr ->
  54         <:expr< (invoke $e1$) "!" C_void >>
  55     | "'" ; "~" ; e1 = expr ->
  56         <:expr< (invoke $e1$) "~" C_void >>
  57     | e1 = expr ; "'" ; "/" ; e2 = expr ->
  58         <:expr< (invoke $e1$) "/" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  59     | e1 = expr ; "'" ; "%" ; e2 = expr ->
  60         <:expr< (invoke $e1$) "%" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  61     | e1 = expr ; "'" ; "lsl" ; e2 = expr ->
  62         <:expr< (invoke $e1$) ("<" ^ "<") (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  63     | e1 = expr ; "'" ; "lsr" ; e2 = expr ->
  64         <:expr< (invoke $e1$) (">" ^ ">") (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  65     | e1 = expr ; "'" ; "<" ; e2 = expr ->
  66         <:expr< (invoke $e1$) "<" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  67     | e1 = expr ; "'" ; "<=" ; e2 = expr ->
  68         <:expr< (invoke $e1$) "<=" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  69     | e1 = expr ; "'" ; ">" ; e2 = expr ->
  70         <:expr< (invoke $e1$) ">" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  71     | e1 = expr ; "'" ; ">=" ; e2 = expr ->
  72         <:expr< (invoke $e1$) ">=" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  73     | e1 = expr ; "'" ; "==" ; e2 = expr ->
  74         <:expr< (invoke $e1$) "==" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  75     | e1 = expr ; "'" ; "!=" ; e2 = expr ->
  76         <:expr< (invoke $e1$) "!=" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  77     | e1 = expr ; "'" ; "&" ; e2 = expr ->
  78         <:expr< (invoke $e1$) "&" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  79     | e1 = expr ; "'" ; "^" ; e2 = expr ->
  80         <:expr< (invoke $e1$) "^" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  81     | e1 = expr ; "'" ; "|" ; e2 = expr ->
  82         <:expr< (invoke $e1$) "|" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  83     | e1 = expr ; "'" ; "&&" ; e2 = expr ->
  84         <:expr< (invoke $e1$) "&&" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  85     | e1 = expr ; "'" ; "||" ; e2 = expr ->
  86         <:expr< (invoke $e1$) "||" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  87     | e1 = expr ; "'" ; "=" ; e2 = expr ->
  88         <:expr< (invoke $e1$) "=" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  89     | e1 = expr ; "'" ; "+=" ; e2 = expr ->
  90         <:expr< (invoke $e1$) "+=" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  91     | e1 = expr ; "'" ; "-=" ; e2 = expr ->
  92         <:expr< (invoke $e1$) "-=" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  93     | e1 = expr ; "'" ; "*=" ; e2 = expr ->
  94         <:expr< (invoke $e1$) "*=" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  95     | e1 = expr ; "'" ; "/=" ; e2 = expr ->
  96         <:expr< (invoke $e1$) "/=" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  97     | e1 = expr ; "'" ; "%=" ; e2 = expr ->
  98         <:expr< (invoke $e1$) "%=" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
  99     | e1 = expr ; "'" ; "lsl" ; "=" ; e2 = expr ->
 100         <:expr< (invoke $e1$) ("<" ^ "<=") (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
 101     | e1 = expr ; "'" ; "lsr" ; "=" ; e2 = expr ->
 102         <:expr< (invoke $e1$) (">" ^ ">=") (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
 103     | e1 = expr ; "'" ; "&=" ; e2 = expr ->
 104         <:expr< (invoke $e1$) "&=" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
 105     | e1 = expr ; "'" ; "^=" ; e2 = expr ->
 106         <:expr< (invoke $e1$) "^=" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
 107     | e1 = expr ; "'" ; "|=" ; e2 = expr ->
 108         <:expr< (invoke $e1$) "|=" (C_list [ $c_ify e2 @OCAMLLOC@$ ]) >>
 109     | "'" ; e = expr -> c_ify e @OCAMLLOC@
 110     | c = expr ; "as" ; id = LIDENT -> <:expr< $lid:"get_" ^ id$ $c$ >>
 111     | c = expr ; "to" ; id = LIDENT -> <:expr< $uid:"C_" ^ id$ $c$ >>
 112     | "`" ; "`" ; l = LIDENT -> <:expr< C_enum `$lid:l$ >>
 113     | "`" ; "`" ; u = UIDENT -> <:expr< C_enum `$uid:u$ >>
 114     | f = expr ; "'" ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
 115         <:expr< $f$ ($mk_list args @OCAMLLOC@ c_ify$) >>
 116     ] ] ;
 117 END ;;
 118