PageRenderTime 36ms CodeModel.GetById 24ms app.highlight 5ms RepoModel.GetById 1ms app.codeStats 0ms

/trunk/Lib/ocaml/swigp4.ml.in

#
Autoconf | 135 lines | 128 code | 7 blank | 0 comment | 0 complexity | d01245e894a1e5b91428326b9514de8e MD5 | raw file
  1open Camlp4
  2  
  3module Id : Sig.Id = 
  4struct 
  5  let name = "swigp4" 
  6  let version = "0.1" 
  7end 
  8  
  9module Make (Syntax : Sig.Camlp4Syntax) = 
 10struct 
 11  open Sig 
 12  include Syntax 
 13
 14  let _loc = Loc.ghost
 15  let lap x y = x :: y
 16  let c_ify e loc = 	  
 17    match e with
 18        <:expr< $int:_$ >> -> <:expr< (C_int $e$) >>
 19      | <:expr< $str:_$ >> -> <:expr< (C_string $e$) >>
 20      | <:expr< $chr:_$ >> -> <:expr< (C_char $e$) >>
 21      | <:expr< $flo:_$ >> -> <:expr< (C_double $e$) >>
 22      | <:expr< True    >> -> <:expr< (C_bool $e$) >>
 23      | <:expr< False   >> -> <:expr< (C_bool $e$) >>
 24      | _ -> <:expr< $e$ >>
 25        let mk_list args loc f =
 26          let rec mk_list_inner args loc f =
 27            match args with
 28	              [] -> <:expr< [] >>
 29              | x :: xs ->
 30	              (let loc = Ast.loc_of_expr x in
 31	               <:expr< [ ($f x _loc$) ] @ ($mk_list_inner xs loc f$) >>) in
 32          match args with
 33	            [] -> <:expr< (Obj.magic C_void) >>
 34            | [ a ] -> <:expr< (Obj.magic $f a _loc$) >>
 35            | _ -> <:expr< (Obj.magic (C_list ($mk_list_inner args loc f$))) >> ;;
 36  
 37  EXTEND Gram
 38    GLOBAL: expr;
 39
 40    expr: LEVEL "top"
 41    [ [ e1 = expr ; "'" ; "[" ; e2 = expr ; "]" ->
 42	  <:expr< (invoke $e1$) "[]" (C_list [ $c_ify e2 _loc$ ]) >>
 43      | e1 = expr ; "->" ; l = LIDENT ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
 44	    <:expr< (invoke $e1$) $str:l$ ($mk_list args _loc c_ify$) >>
 45      | e1 = expr ; "->" ; u = UIDENT ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
 46	    <:expr< (invoke $e1$) $str:u$ ($mk_list args _loc c_ify$) >>
 47      | e1 = expr ; "->" ; s = expr LEVEL "simple" ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
 48	    <:expr< (invoke $e1$) $s$ ($mk_list args _loc c_ify$) >>
 49      | e1 = expr ; "'" ; "." ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
 50	    <:expr< (invoke $e1$) "()" ($mk_list args _loc c_ify$) >>
 51      | e1 = expr ; "'" ; "->" ; l = LIDENT ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
 52	    <:expr< (invoke ((invoke $e1$) "->" C_void)) $str:l$ ($mk_list args _loc c_ify$) >>
 53      | e1 = expr ; "'" ; "->" ; u = UIDENT ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
 54	    <:expr< (invoke ((invoke $e1$) "->" C_void)) $str:u$ ($mk_list args _loc c_ify$) >>
 55      | e1 = expr ; "'" ; "->" ; s = expr LEVEL "simple" ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" ->
 56	    <:expr< (invoke ((invoke $e1$) "->" C_void)) $s$ ($mk_list args _loc c_ify$) >>
 57      | e1 = expr ; "'" ; "++" ->
 58	    <:expr< (invoke $e1$) "++" C_void >>
 59      | e1 = expr ; "'" ; "--" ->
 60	    <:expr< (invoke $e1$) "--" C_void >>
 61      | e1 = expr ; "'" ; "-" ; e2 = expr ->
 62	    <:expr< (invoke $e1$) "-" (C_list [ $c_ify e2 _loc$ ]) >>
 63      | e1 = expr ; "'" ; "+" ; e2 = expr -> <:expr< (invoke $e1$) "+" (C_list [ $c_ify e2 _loc$ ])  >> 
 64      | e1 = expr ; "'" ; "*" ; e2 = expr -> <:expr< (invoke $e1$) "*" (C_list [ $c_ify e2 _loc$ ])  >> 
 65      | "'" ; "&" ; e1 = expr -> 
 66	    <:expr< (invoke $e1$) "&" C_void >> 
 67      | "'" ; "!" ; e1 = expr ->
 68	    <:expr< (invoke $e1$) "!" C_void >>
 69      | "'" ; "~" ; e1 = expr ->
 70	    <:expr< (invoke $e1$) "~" C_void >>
 71      | e1 = expr ; "'" ; "/" ; e2 = expr ->
 72	    <:expr< (invoke $e1$) "/" (C_list [ $c_ify e2 _loc$ ]) >>
 73      | e1 = expr ; "'" ; "%" ; e2 = expr ->
 74	    <:expr< (invoke $e1$) "%" (C_list [ $c_ify e2 _loc$ ]) >>
 75      | e1 = expr ; "'" ; "lsl" ; e2 = expr ->
 76	    <:expr< (invoke $e1$) ("<" ^ "<") (C_list [ $c_ify e2 _loc$ ]) >>
 77      | e1 = expr ; "'" ; "lsr" ; e2 = expr ->
 78	    <:expr< (invoke $e1$) (">" ^ ">") (C_list [ $c_ify e2 _loc$ ]) >>
 79      | e1 = expr ; "'" ; "<" ; e2 = expr ->
 80	    <:expr< (invoke $e1$) "<" (C_list [ $c_ify e2 _loc$ ]) >>
 81      | e1 = expr ; "'" ; "<=" ; e2 = expr ->
 82	    <:expr< (invoke $e1$) "<=" (C_list [ $c_ify e2 _loc$ ]) >>
 83      | e1 = expr ; "'" ; ">" ; e2 = expr ->
 84	    <:expr< (invoke $e1$) ">" (C_list [ $c_ify e2 _loc$ ]) >>
 85      | e1 = expr ; "'" ; ">=" ; e2 = expr ->
 86	    <:expr< (invoke $e1$) ">=" (C_list [ $c_ify e2 _loc$ ]) >>
 87      | e1 = expr ; "'" ; "==" ; e2 = expr ->
 88	    <:expr< (invoke $e1$) "==" (C_list [ $c_ify e2 _loc$ ]) >>
 89      | e1 = expr ; "'" ; "!=" ; e2 = expr ->
 90	    <:expr< (invoke $e1$) "!=" (C_list [ $c_ify e2 _loc$ ]) >>
 91      | e1 = expr ; "'" ; "&" ; e2 = expr ->
 92	    <:expr< (invoke $e1$) "&" (C_list [ $c_ify e2 _loc$ ]) >>
 93      | e1 = expr ; "'" ; "^" ; e2 = expr ->
 94	    <:expr< (invoke $e1$) "^" (C_list [ $c_ify e2 _loc$ ]) >>
 95      | e1 = expr ; "'" ; "|" ; e2 = expr ->
 96	    <:expr< (invoke $e1$) "|" (C_list [ $c_ify e2 _loc$ ]) >>
 97      | e1 = expr ; "'" ; "&&" ; e2 = expr ->
 98	    <:expr< (invoke $e1$) "&&" (C_list [ $c_ify e2 _loc$ ]) >>
 99      | e1 = expr ; "'" ; "||" ; e2 = expr ->
100	    <:expr< (invoke $e1$) "||" (C_list [ $c_ify e2 _loc$ ]) >>
101      | e1 = expr ; "'" ; "=" ; e2 = expr ->
102	    <:expr< (invoke $e1$) "=" (C_list [ $c_ify e2 _loc$ ]) >>
103      | e1 = expr ; "'" ; "+=" ; e2 = expr ->
104	    <:expr< (invoke $e1$) "+=" (C_list [ $c_ify e2 _loc$ ]) >>
105      | e1 = expr ; "'" ; "-=" ; e2 = expr ->
106	    <:expr< (invoke $e1$) "-=" (C_list [ $c_ify e2 _loc$ ]) >>
107      | e1 = expr ; "'" ; "*=" ; e2 = expr ->
108	    <:expr< (invoke $e1$) "*=" (C_list [ $c_ify e2 _loc$ ]) >>
109      | e1 = expr ; "'" ; "/=" ; e2 = expr ->
110	    <:expr< (invoke $e1$) "/=" (C_list [ $c_ify e2 _loc$ ]) >>
111      | e1 = expr ; "'" ; "%=" ; e2 = expr ->
112	    <:expr< (invoke $e1$) "%=" (C_list [ $c_ify e2 _loc$ ]) >>
113      | e1 = expr ; "'" ; "lsl" ; "=" ; e2 = expr ->
114	    <:expr< (invoke $e1$) ("<" ^ "<=") (C_list [ $c_ify e2 _loc$ ]) >>
115      | e1 = expr ; "'" ; "lsr" ; "=" ; e2 = expr ->
116	    <:expr< (invoke $e1$) (">" ^ ">=") (C_list [ $c_ify e2 _loc$ ]) >>
117      | e1 = expr ; "'" ; "&=" ; e2 = expr ->
118	    <:expr< (invoke $e1$) "&=" (C_list [ $c_ify e2 _loc$ ]) >>
119      | e1 = expr ; "'" ; "^=" ; e2 = expr ->
120	    <:expr< (invoke $e1$) "^=" (C_list [ $c_ify e2 _loc$ ]) >> 
121      | e1 = expr ; "'" ; "|=" ; e2 = expr ->
122	    <:expr< (invoke $e1$) "|=" (C_list [ $c_ify e2 _loc$ ]) >>
123      | "'" ; e = expr -> c_ify e _loc
124      | c = expr ; "as" ; id = LIDENT -> <:expr< $lid:"get_" ^ id$ $c$ >>
125      | c = expr ; "to" ; id = LIDENT -> <:expr< $uid:"C_" ^ id$ $c$ >>
126      | "`" ; "`" ; l = LIDENT -> <:expr< C_enum `$lid:l$ >>
127      | "`" ; "`" ; u = UIDENT -> <:expr< C_enum `$uid:u$ >>
128      | f = expr ; "'" ; "(" ; args = LIST0 (expr LEVEL "simple") SEP "," ; ")" -> 
129	    <:expr< $f$ ($mk_list args _loc c_ify$) >>
130      ] ] ;
131    END ;;
132  
133end 
134  
135module M = Register.OCamlSyntaxExtension(Id)(Make)