Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 297 lines (274 sloc) 12.427 kb
062dee3 @dsheets Update source license headers to reference BSD-3-Clause
dsheets authored
1 (* Copyright (c) 2012 Ashima Arts. All rights reserved.
2 * Author: David Sheets
3 * Use of this source code is governed by a BSD-style license that can be
4 * found in the LICENSE file.
5 *)
6
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
7 (* Let's link some glo! *)
e6fd054 @dsheets glol bits
dsheets authored
8 open Glo_lib
9
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
10 (* We'll need some maps from strings to structures. *)
fceaaf2 @dsheets glol sketch
dsheets authored
11 module M = Map.Make(String)
b281e9d @dsheets fix tabs
dsheets authored
12
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
13 (* Each unit of SL source belongs to a labeled glo and has a (mostly)
b870e76 @dsheets Fix glol concat bug, continue extensive algorithm comments
dsheets authored
14 meaningless glo index that determines link precedence. *)
fceaaf2 @dsheets glol sketch
dsheets authored
15 type unit_addr = string * int
b281e9d @dsheets fix tabs
dsheets authored
16
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
17 (* To satisfy the various symbol dependency constraints, we zip through the
18 link list tracking Required symbols, Top symbols satisfied, and Bottom symbols
19 exposed by the above teeth. *)
20 type tooth = { rsym : string list; rmac : string list;
fceaaf2 @dsheets glol sketch
dsheets authored
21 tsym : unit_addr M.t; tmac : unit_addr M.t;
b281e9d @dsheets fix tabs
dsheets authored
22 bsym : unit_addr M.t; bmac : unit_addr M.t;
23 addr : unit_addr }
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
24 (* Bottom * Top *)
fceaaf2 @dsheets glol sketch
dsheets authored
25 type zipper = tooth list * tooth list
26
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
27 exception MissingSymbol of unit_addr * string
28 exception MissingMacro of unit_addr * string
fceaaf2 @dsheets glol sketch
dsheets authored
29 exception CircularDependency of unit_addr list
30 exception SymbolConflict of string * string * unit_addr * unit_addr
91e5df8 @dsheets Special fields for universal directives
dsheets authored
31 exception UnknownBehavior of unit_addr * string
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
32 exception UnknownGloVersion of string * version
fceaaf2 @dsheets glol sketch
dsheets authored
33
0764db6 @dsheets gloc error message breakout, minor bug fixes
dsheets authored
34 let string_of_error = function
35 | CircularDependency ual -> List.fold_left
36 (fun s (fn,un) ->
37 Printf.sprintf "%s%s#n=%d\n" s fn un
38 ) "Circular dependency linking:\n" ual
39 | MissingMacro ((fn,un),mn) ->
40 Printf.sprintf "%s#n=%d requires macro '%s' which cannot be found.\n" fn un mn
41 | MissingSymbol ((fn,un),mn) ->
42 Printf.sprintf "%s#n=%d requires symbol '%s' which cannot be found.\n" fn un mn
43 | SymbolConflict (ssym,csym,(sfn,sun),(cfn,cun)) ->
44 Printf.sprintf "%s#n=%d provides '%s' but exposes '%s' which conflicts with %s#n=%d\n"
45 sfn sun ssym csym cfn cun
46 | UnknownBehavior ((fn,un),b) ->
47 Printf.sprintf "%s#n=%d uses unknown extension behavior '%s'.\n" fn un b
48 | UnknownGloVersion (fn,(maj,min,rev)) ->
49 Printf.sprintf "%s declares unsupported version %d.%d.%d.\n"
50 fn maj min rev
51 | exn -> raise exn
52
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
53 (* Prepare the packaged source for string concatenation. *)
24644c2 @dsheets gloc command functorization for posix and js platforms; gloc command …
dsheets authored
54 let armor meta (url,linkmap,fs_ct) opmac s =
b870e76 @dsheets Fix glol concat bug, continue extensive algorithm comments
dsheets authored
55 (* Replace special symbols in line directives to satisfy linkmap *)
c123b2d @dsheets Add filenumber annotations, abstract error codes, safer fd handling, …
dsheets authored
56 (*required regexp (greetz jwz) instead of macros due to ANGLE bug 183*)
67201e9 @dsheets glom model clean-up, xml generation, begin gloxml->html xslt for glos…
dsheets authored
57 let intpatt = Re_str.regexp "GLOC_\\([0-9]+\\)" in
c123b2d @dsheets Add filenumber annotations, abstract error codes, safer fd handling, …
dsheets authored
58 let offset s =
67201e9 @dsheets glom model clean-up, xml generation, begin gloxml->html xslt for glos…
dsheets authored
59 let fn = int_of_string (Re_str.string_after (Re_str.matched_string s) 5) in
24644c2 @dsheets gloc command functorization for posix and js platforms; gloc command …
dsheets authored
60 let anno = try "/* "^url^(List.assoc (string_of_int fn) linkmap)^" */"
c123b2d @dsheets Add filenumber annotations, abstract error codes, safer fd handling, …
dsheets authored
61 with Not_found -> ""
62 in (string_of_int (fn + fs_ct))^anno
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
63 in
67201e9 @dsheets glom model clean-up, xml generation, begin gloxml->html xslt for glos…
dsheets authored
64 let s = Re_str.global_substitute intpatt offset s in
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
65 let head = match meta with None -> "" | Some meta ->
66 let field name (entity,href) = "// "^name^": "^entity^" <"^href^">\n" in
67 let authors = List.fold_left
68 (fun s link -> s^(field "Author" link))
69 "" meta.author in
70 let license = match meta.license with None -> ""
71 | Some link -> field "License" link in
72 let library = match meta.library with None -> ""
73 | Some link -> field "Library" link in
74 let version = match meta.version with None -> ""
24644c2 @dsheets gloc command functorization for posix and js platforms; gloc command …
dsheets authored
75 | Some (v,url) ->
76 "// Version: "^(string_of_version v)^" <"^url^">\n" in
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
77 let build = match meta.build with None -> ""
24644c2 @dsheets gloc command functorization for posix and js platforms; gloc command …
dsheets authored
78 | Some link -> field "Build" link in
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
79 let (year,(holder,url)) = meta.copyright in
80 "// Copyright "^(string_of_int year)^" "^holder^" <"^url^"> "
81 ^"All rights reserved.\n"^license^authors^library^version^build
82 in let s = head^s in
83 (* Undefine local open macros so they do not leak *)
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
84 List.fold_left (fun s mac -> s^"\n#undef "^mac) s opmac
fceaaf2 @dsheets glol sketch
dsheets authored
85
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
86 (* Search a glo for a unit satisfying the supplied predicate p. *)
87 let search p glo =
88 let rec loop = function
89 | [] -> None
90 | (i,u)::r -> if p u then Some i else loop r
91 in loop (Array.to_list (Array.mapi (fun i u -> (i,u)) glo.units))
92
bbfa62c @dsheets Monkey-patching test, shadow glom order test, fix required symbol ord…
dsheets authored
93 (* Linearly search for an exported macro. *)
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
94 let rec satisfy_mac addr macro = function
95 | (name,glo)::rest ->
96 begin match search (fun u -> List.mem macro u.outmac) glo with
b281e9d @dsheets fix tabs
dsheets authored
97 | Some i -> (name,i)
98 | None -> satisfy_mac addr macro rest
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
99 end
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
100 | [] -> raise (MissingMacro (addr, macro))
fceaaf2 @dsheets glol sketch
dsheets authored
101
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
102 (* Linearly search for an exported symbol or macro. *)
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
103 let rec satisfy_sym addr sym = function
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
104 | (name,glo)::rest ->
105 begin match search
b281e9d @dsheets fix tabs
dsheets authored
106 (fun u -> (List.mem sym u.outmac) || (List.mem sym u.outsym)) glo
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
107 with
b281e9d @dsheets fix tabs
dsheets authored
108 | Some i -> (name,i)
109 | None -> satisfy_sym addr sym rest
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
110 end
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
111 | [] -> raise (MissingSymbol (addr, sym))
fceaaf2 @dsheets glol sketch
dsheets authored
112
113 let map_of_list v = List.fold_left (fun m n -> M.add n v m) M.empty
114
bbfa62c @dsheets Monkey-patching test, shadow glom order test, fix required symbol ord…
dsheets authored
115 (* Construct the constraint data structure from a glo unit. *)
fceaaf2 @dsheets glol sketch
dsheets authored
116 let tooth addr u =
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
117 { rsym=u.insym; (* to be satisfied *)
118 rmac=u.inmac;
119 tsym=M.empty; (* locally satisfied *)
fceaaf2 @dsheets glol sketch
dsheets authored
120 tmac=M.empty;
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
121 bsym=map_of_list addr u.outsym; (* cumulatively satisfies *)
fceaaf2 @dsheets glol sketch
dsheets authored
122 bmac=map_of_list addr u.outmac;
123 addr }
124
0764db6 @dsheets gloc error message breakout, minor bug fixes
dsheets authored
125 let lookup glo_alist (n,u) = try (List.assoc n glo_alist).units.(u) with _ -> raise (Failure "lookup")
91e5df8 @dsheets Special fields for universal directives
dsheets authored
126 let tooth_of_addr glo_alist addr = tooth addr (lookup glo_alist addr)
fceaaf2 @dsheets glol sketch
dsheets authored
127 let has_addr addr_a ({addr=addr_b}) = addr_a = addr_b
bbfa62c @dsheets Monkey-patching test, shadow glom order test, fix required symbol ord…
dsheets authored
128 (* Advertize prior units to later units. *)
fceaaf2 @dsheets glol sketch
dsheets authored
129 let mergeb b = function [] -> b
130 | {bsym; bmac}::r -> {b with bsym=M.fold M.add b.bsym bsym;
b281e9d @dsheets fix tabs
dsheets authored
131 bmac=M.fold M.add b.bmac bmac}
bbfa62c @dsheets Monkey-patching test, shadow glom order test, fix required symbol ord…
dsheets authored
132 (* Satisfy a macro dependency with an already included dependency. *)
fceaaf2 @dsheets glol sketch
dsheets authored
133 let connect_mac b n addr =
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
134 {b with rmac=List.filter (fun m -> not (m=n)) b.rmac; tmac=M.add n addr b.tmac}
bbfa62c @dsheets Monkey-patching test, shadow glom order test, fix required symbol ord…
dsheets authored
135 (* Satisfy a symbol dependency with an already included dependency. *)
fceaaf2 @dsheets glol sketch
dsheets authored
136 let connect_sym b n addr =
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
137 {b with rsym=List.filter (fun m -> not (m=n)) b.rsym; tsym=M.add n addr b.tsym}
bbfa62c @dsheets Monkey-patching test, shadow glom order test, fix required symbol ord…
dsheets authored
138 (* Search for an already included macro. *)
fceaaf2 @dsheets glol sketch
dsheets authored
139 let provided_mac n = function [] -> None
140 | t::r -> try let addr = M.find n t.bmac in Some addr
141 with Not_found -> None
bbfa62c @dsheets Monkey-patching test, shadow glom order test, fix required symbol ord…
dsheets authored
142 (* Search for an already included symbol. *)
fceaaf2 @dsheets glol sketch
dsheets authored
143 let provided_sym n = function [] -> None
144 | t::r -> try let addr = M.find n t.bmac in Some addr
145 with Not_found -> try let addr = M.find n t.bsym in Some addr
146 with Not_found -> None
bbfa62c @dsheets Monkey-patching test, shadow glom order test, fix required symbol ord…
dsheets authored
147 (* Given a tooth and a prefix tooth list, find conflicts. *)
fceaaf2 @dsheets glol sketch
dsheets authored
148 let conflicted a = function [] -> None
149 | t::r -> let keys = List.map fst ((M.bindings a.bsym)@(M.bindings a.bmac)) in
150 begin match List.filter (fun (sym,addr) -> List.mem sym keys)
b281e9d @dsheets fix tabs
dsheets authored
151 ((M.bindings t.bsym)@(M.bindings t.bmac))
fceaaf2 @dsheets glol sketch
dsheets authored
152 with [] -> None | b::_ -> Some b end
153
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
154 (* Check for symbol conflicts *)
155 let check_conflicts n tooth (b,t) = match conflicted tooth t with
156 | Some (sym, caddr) -> raise (SymbolConflict (n,sym,tooth.addr,caddr))
157 | None -> ()
158
543407b @dsheets glol.js exceptions, comments; close copyrighted sections
dsheets authored
159 (* Check for circular dependency *)
160 let check_circdep addr (b,t) =
161 if List.exists (has_addr addr) b
162 then raise (CircularDependency (List.map (fun {addr} -> addr) b))
163
bbfa62c @dsheets Monkey-patching test, shadow glom order test, fix required symbol ord…
dsheets authored
164 (* Build a list of units with internal requirements satisfied. *)
fceaaf2 @dsheets glol sketch
dsheets authored
165 let rec satisfy_zipper glo_alist = function
bbfa62c @dsheets Monkey-patching test, shadow glom order test, fix required symbol ord…
dsheets authored
166 (* At the bottom of the zipper, we must be done. *)
fceaaf2 @dsheets glol sketch
dsheets authored
167 | ([],t) -> ([],t)
543407b @dsheets glol.js exceptions, comments; close copyrighted sections
dsheets authored
168 (* Without further needs from below, we must be ready to descend. *)
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
169 | (({rmac=[]; rsym=[]} as b)::r,t) ->
170 satisfy_zipper glo_alist (r,(mergeb b t)::t)
bbfa62c @dsheets Monkey-patching test, shadow glom order test, fix required symbol ord…
dsheets authored
171 (* Subsequent units require a macro. *)
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
172 | (({rmac=n::_} as b)::r,t) ->
173 begin match provided_mac n t with
b281e9d @dsheets fix tabs
dsheets authored
174 | Some addr -> satisfy_zipper glo_alist ((connect_mac b n addr)::r,t)
175 | None -> let addr = satisfy_mac b.addr n glo_alist in
176 check_circdep addr (b::r,t);
177 let tooth = tooth_of_addr glo_alist addr in
178 check_conflicts n tooth (b::r,t);
179 satisfy_zipper glo_alist(tooth::(connect_mac b n addr)::r,t)
fceaaf2 @dsheets glol sketch
dsheets authored
180 end
bbfa62c @dsheets Monkey-patching test, shadow glom order test, fix required symbol ord…
dsheets authored
181 (* Subsequent units require a symbol. *)
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
182 | (({rmac=[]; rsym=n::_} as b)::r,t) ->
183 begin match provided_sym n t with
b281e9d @dsheets fix tabs
dsheets authored
184 | Some addr -> satisfy_zipper glo_alist ((connect_sym b n addr)::r,t)
185 | None -> let addr = satisfy_sym b.addr n glo_alist in
186 check_circdep addr (b::r,t);
187 let tooth = tooth_of_addr glo_alist addr in
188 check_conflicts n tooth (b::r,t);
189 satisfy_zipper glo_alist (tooth::(connect_sym b n addr)::r,t)
fceaaf2 @dsheets glol sketch
dsheets authored
190 end
191
bbfa62c @dsheets Monkey-patching test, shadow glom order test, fix required symbol ord…
dsheets authored
192 (* Generate a list of unit addresses from a list of required symbols and
193 a search list. *)
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
194 let sort required glo_alist =
195 let addrs = List.fold_left
67201e9 @dsheets glom model clean-up, xml generation, begin gloxml->html xslt for glos…
dsheets authored
196 (fun al sym -> let addr = satisfy_sym ("[-u "^sym^"]",0) sym glo_alist in
a7a1f53 @dsheets command line interface and fleshing out linker
dsheets authored
197 if List.mem addr al then al else addr::al)
0764db6 @dsheets gloc error message breakout, minor bug fixes
dsheets authored
198 [] (List.rev required) in
bbfa62c @dsheets Monkey-patching test, shadow glom order test, fix required symbol ord…
dsheets authored
199 let z = satisfy_zipper glo_alist
200 (List.rev_map (tooth_of_addr glo_alist) addrs,[])
201 in List.rev_map (fun tooth -> tooth.addr) (snd z)
fceaaf2 @dsheets glol sketch
dsheets authored
202
91e5df8 @dsheets Special fields for universal directives
dsheets authored
203 (* Generate the shader preamble. *)
204 let preamble glol =
205 (* Precedence for conflicting behaviors *)
206 let b_order = ["require"; "warn"; "enable"; "disable"] in
207 let rec b_max x y = function [] -> x
208 | b::r when b=x -> x
209 | b::r when b=y -> y
210 | _::r -> b_max x y r
211 in
212 let ext_merge addr m (ext,b) =
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
213 match (try Some (M.find ext m) with Not_found -> None) with
214 | None -> if List.mem b b_order
b281e9d @dsheets fix tabs
dsheets authored
215 then M.add ext b m
216 else raise (UnknownBehavior (addr, b))
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
217 | Some pb -> M.add ext (b_max b pb b_order) m
91e5df8 @dsheets Special fields for universal directives
dsheets authored
218 in
219 let ext_decl ext b = "#extension "^ext^" : "^b^"\n" in
220 let ext_segment m =
221 (try ext_decl "all" (M.find "all" m) with Not_found -> "")
222 ^(M.fold (fun ext b s -> if ext="all" then s else s^(ext_decl ext b)) m "")
223 in
224 let (version,pragmas,exts) = List.fold_left
0764db6 @dsheets gloc error message breakout, minor bug fixes
dsheets authored
225 (fun (version,pragmas,exts) ((name,i),glo) -> let u = try glo.units.(i) with _ -> raise (Failure "preamble") in
91e5df8 @dsheets Special fields for universal directives
dsheets authored
226 (begin match u.vdir,version with
b281e9d @dsheets fix tabs
dsheets authored
227 | None,v -> v
228 | Some uv,None -> Some uv
229 | Some uv,Some pv -> Some (max uv pv)
230 end,
231 List.fold_left (fun p s -> p^s^"\n") pragmas u.pdir,
232 List.fold_left (ext_merge (name,i)) exts u.edir
91e5df8 @dsheets Special fields for universal directives
dsheets authored
233 )
234 ) (None,"",M.empty) glol
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
235 in (match version with Some v -> "#version "^(string_of_int v)^"\n"
b281e9d @dsheets fix tabs
dsheets authored
236 | None -> "")^pragmas^(ext_segment exts)
91e5df8 @dsheets Special fields for universal directives
dsheets authored
237
bbfa62c @dsheets Monkey-patching test, shadow glom order test, fix required symbol ord…
dsheets authored
238 (* Produce a string representing a valid SL program given a list of required
239 symbols and a search list. *)
91e5df8 @dsheets Special fields for universal directives
dsheets authored
240 let link prologue required glo_alist =
67201e9 @dsheets glom model clean-up, xml generation, begin gloxml->html xslt for glos…
dsheets authored
241 let required = if (List.length required) = 0 then ["main"] else required in
24644c2 @dsheets gloc command functorization for posix and js platforms; gloc command …
dsheets authored
242 let support = [|[||];[|true|]|] in
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
243 let () = List.iter
244 (fun (name,glo) -> let (maj,min,_) = glo.glo in
245 if try not support.(maj).(min) with Invalid_argument _ -> true
246 then raise (UnknownGloVersion (name,glo.glo))) glo_alist in
9da7afc @dsheets Version and behavior errors
dsheets authored
247 let glol = List.map
ee0302d @dsheets Nested glom support, metadata support, fragment API change, small fixes
dsheets authored
248 (fun (name,u) -> ((name,u),List.assoc name glo_alist))
249 (sort required glo_alist)
91e5df8 @dsheets Special fields for universal directives
dsheets authored
250 in fst begin List.fold_left
b281e9d @dsheets fix tabs
dsheets authored
251 begin fun (src,(pname,o)) ((name,u),glo) ->
252 let sup = List.fold_left
253 (fun sup (is,_) -> max sup (int_of_string is))
254 0 glo.linkmap
255 in
256 let meta = if name=pname then None else glo.meta in
257 let u = try glo.units.(u) with _ -> raise (Failure "u") in
258 let unit_begin = if name=pname || pname=""
259 then "" else "// End: Copyright\n"
24644c2 @dsheets gloc command functorization for posix and js platforms; gloc command …
dsheets authored
260 in (src^unit_begin^(armor meta (name, glo.linkmap, o) u.opmac u.source)^"\n",
b281e9d @dsheets fix tabs
dsheets authored
261 (name,o+sup+1))
262 end ((preamble glol)^prologue,("",0)) glol
91e5df8 @dsheets Special fields for universal directives
dsheets authored
263 end
67201e9 @dsheets glom model clean-up, xml generation, begin gloxml->html xslt for glos…
dsheets authored
264
0764db6 @dsheets gloc error message breakout, minor bug fixes
dsheets authored
265 (* Some link-time functions *)
266
67201e9 @dsheets glom model clean-up, xml generation, begin gloxml->html xslt for glos…
dsheets authored
267 (* Flatten a glom into an association list and remove non-glo elements *)
268 let flatten prefix glom =
0764db6 @dsheets gloc error message breakout, minor bug fixes
dsheets authored
269 let rec descend prefix l = function
270 | (n,Glo glo) -> (prefix^n, glo)::l
271 | (n,Glom glom) -> List.fold_left
272 (fun l p -> descend (prefix^n^"/") l p) l glom
273 | (n,Source _) | (n,Other _) -> l
274 in match glom with
275 | Glom glom -> List.rev
276 (List.fold_left
b281e9d @dsheets fix tabs
dsheets authored
277 (fun l p -> descend prefix l p) [] glom)
0764db6 @dsheets gloc error message breakout, minor bug fixes
dsheets authored
278 | Glo glo -> [prefix,glo]
279 | Source _ | Other _ -> []
67201e9 @dsheets glom model clean-up, xml generation, begin gloxml->html xslt for glos…
dsheets authored
280
0764db6 @dsheets gloc error message breakout, minor bug fixes
dsheets authored
281 (* Nest a glo alist back into a glom *)
282 let nest glo_alist =
283 let rec group prefix prev = function
284 | ((_::[],_)::_) as glom -> (glom, List.rev prev)
285 | (x::xs,glo)::r when x=prefix -> group prefix ((xs,glo)::prev) r
286 | glom -> (glom,List.rev prev)
287 in
288 let rec nest prev = function
289 | [] -> Glom (List.rev prev)
290 | (([],glo)::r) -> nest (("", glo)::prev) r
291 | ((x::[],glo)::r) -> nest ((x, glo)::prev) r
292 | ((x::_,_)::_) as r ->
293 let (rest,g) = group x [] r in
294 nest ((x, nest [] g)::prev) rest
295 in let split s = Re_str.split (Re_str.regexp_string "/") s in
296 nest [] (List.map (fun (n,glo) -> (split n, glo)) glo_alist)
Something went wrong with that request. Please try again.