Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 184 lines (148 sloc) 4.983 kb
adda7d2 jslib + changes from my repository
Jake Donham authored
1 (*
2 * This file is part of ocamljs, OCaml to Javascript compiler
fe7ebed copyrights, miscellany
Jake Donham authored
3 * Copyright (C) 2007-9 Skydeck, Inc
adda7d2 jslib + changes from my repository
Jake Donham authored
4 *
fe7ebed copyrights, miscellany
Jake Donham authored
5 * This library is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU Library General Public
7 * License as published by the Free Software Foundation; either
8 * version 2 of the License, or (at your option) any later version.
adda7d2 jslib + changes from my repository
Jake Donham authored
9 *
fe7ebed copyrights, miscellany
Jake Donham authored
10 * This library is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 * Library General Public License for more details.
14 *
15 * You should have received a copy of the GNU Library General Public
16 * License along with this library; if not, write to the Free
17 * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
18 * MA 02111-1307, USA
adda7d2 jslib + changes from my repository
Jake Donham authored
19 *)
20
21 open Camlp4.PreCast
22 module Jslib_ast =
23 struct
24
25 type loc = Loc.t
26
aa568d8 support for inline javascript
Jake Donham authored
27 INCLUDE "../jslib_ast.incl"
adda7d2 jslib + changes from my repository
Jake Donham authored
28
29 end
30
31 include Jslib_ast
32
3503c9f internal exp list in AST + list antiquotation.
Jake Donham authored
33 external loc_of_exp : exp -> Loc.t = "%field0"
34
35 let rec exp_of_list = function
36 | [] -> Jexp_nil Loc.ghost
37 | [e] -> e
38 | e::es -> Jexp_cons (loc_of_exp e, e, exp_of_list es)
39
40 let rec list_of_exp x acc =
41 match x with
42 | Jexp_nil _ -> acc
43 | Jexp_cons (_, e1, e2) -> list_of_exp e1 (list_of_exp e2 acc)
44 | e -> e :: acc
45
adda7d2 jslib + changes from my repository
Jake Donham authored
46 module Meta =
47 struct
48
49 (* I don't really understand what's going on here but this is how
50 Camlp4Ast.mlast does it. *)
51
52 module type META_LOC =
53 sig
54 val meta_loc_patt : Loc.t -> Loc.t -> Ast.patt
55 val meta_loc_expr : Loc.t -> Loc.t -> Ast.expr
56 end
57
58 module MetaLoc =
59 struct
60 let meta_loc_patt _loc location =
61 let (a, b, c, d, e, f, g, h) = Loc.to_tuple location in
62 <:patt< Loc.of_tuple
63 ($`str:a$, $`int:b$, $`int:c$, $`int:d$,
64 $`int:e$, $`int:f$, $`int:g$,
65 $if h then <:patt< True >> else <:patt< False >> $) >>
66 let meta_loc_expr _loc location =
67 let (a, b, c, d, e, f, g, h) = Loc.to_tuple location in
68 <:expr< Loc.of_tuple
69 ($`str:a$, $`int:b$, $`int:c$, $`int:d$,
70 $`int:e$, $`int:f$, $`int:g$,
71 $if h then <:expr< True >> else <:expr< False >> $) >>
72 end
73
74 module MetaGhostLoc =
75 struct
76 let meta_loc_patt _loc _ = <:patt< Loc.ghost >>
77 let meta_loc_expr _loc _ = <:expr< Loc.ghost >>
78 end
79
80 module MetaLocVar = struct
81 let meta_loc_patt _loc _ = <:patt< $lid:!Loc.name$ >>
82 let meta_loc_expr _loc _ = <:expr< $lid:!Loc.name$ >>
83 end
84
85 module Make (MetaLoc : META_LOC) =
86 struct
87 open MetaLoc
88
89 module Expr =
90 struct
91 let meta_loc = meta_loc_expr
92
93 let meta_option mf_a _loc = function
94 | None -> <:expr< None >>
95 | Some a -> <:expr< Some $mf_a _loc a$ >>
96
97 include Camlp4Filters.MetaGeneratorExpr(Jslib_ast)
98 end
99
100 module Patt =
101 struct
102 let meta_loc = meta_loc_patt
103
104 let meta_option mf_a _loc = function
105 | None -> <:patt< None >>
106 | Some a -> <:patt< Some $mf_a _loc a$ >>
107
108 include Camlp4Filters.MetaGeneratorPatt(Jslib_ast)
109 end
110 end
111
30af97c checkpoint lambda meta generator stuff
Jake Donham authored
112 module MakeLambda (MetaLoc : META_LOC) =
113 struct
114 open MetaLoc
115
116 module Expr =
117 struct
118 let meta_loc = meta_loc_expr
119
120 let meta_option mf_a _loc = function
121 | None -> <:expr< None >>
122 | Some a -> <:expr< Some $mf_a _loc a$ >>
123
124 include LambdaMetaGeneratorExpr(Jslib_ast)
125 end
126
127 module Patt =
128 struct
129 let meta_loc = meta_loc_patt
130
131 let meta_option mf_a _loc = function
132 | None -> <:patt< None >>
133 | Some a -> <:patt< Some $mf_a _loc a$ >>
134
135 include LambdaMetaGeneratorPatt(Jslib_ast)
136 end
137 end
138
139 module MakeAbstractLambda (MetaLoc : META_LOC) =
140 struct
141 open MetaLoc
142
143 module Expr =
144 struct
145 let meta_loc _loc _ =
146 (* XXX translate the argument location *)
147 <:expr<
148 Lambda.Lconst
149 (Lambda.Const_block (0, [
150 Lambda.Const_immstring "ghost-location";
151 Lambda.Const_block (0, [
152 Lambda.Const_base (Asttypes.Const_int 1);
153 Lambda.Const_base (Asttypes.Const_int 0);
154 Lambda.Const_base (Asttypes.Const_int 0);
155 ]);
156 Lambda.Const_block (0, [
157 Lambda.Const_base (Asttypes.Const_int 1);
158 Lambda.Const_base (Asttypes.Const_int 0);
159 Lambda.Const_base (Asttypes.Const_int 0);
160 ]);
161 Lambda.Const_pointer 1;
162 ]))
163 >>
164
165 let meta_option mf_a _loc = function
166 | <:expr< None >> -> <:expr< None >>
167 | <:expr< Some $a$ >> -> <:expr< Some $mf_a _loc a$ >>
168
169 include LambdaAbstractMetaGeneratorExpr(Jslib_ast)
170 end
171
172 module Patt =
173 struct
174 let meta_loc _loc _ = <:patt< _ >>
175
176 let meta_option mf_a _loc = function
177 | <:expr< None >> -> <:patt< None >>
178 | <:expr< Some $a$ >> -> <:patt< Some $mf_a _loc a$ >>
179
180 include LambdaAbstractMetaGeneratorPatt(Jslib_ast)
181 end
182 end
adda7d2 jslib + changes from my repository
Jake Donham authored
183 end
Something went wrong with that request. Please try again.