1open Pcaml ;;
2
3let lap x y = x :: y
4let 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$ >>
13let 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
25EXTEND
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    ] ] ;
117END ;;
118      
119