1 open Camlp4 2 3 module Id : Sig.Id = 4 struct 5 let name = "swigp4" 6 let version = "0.1" 7 end 8 9 module Make (Syntax : Sig.Camlp4Syntax) = 10 struct 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 133 end 134 135 module M = Register.OCamlSyntaxExtension(Id)(Make) 136
