Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 93 lines (76 sloc) 2.576 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 module Top = QmlGenTop.Top
19
20 let _start = ref None
21 let _table = Hashtbl.create 10
22 let _last_id = ref 1
23
24 let load_libs = ref true
25
26 type env_id = int
27
28 let initial () =
29 QmlTopLevel.Properties.fatal_mode := false;
30 match !_start with
31 | None ->
32 let loaders = BslLib.LoaderTable.finalize ~fatal:true () in
33 let libs = List.map (
34 fun loader ->
35 load_libs, Printf.sprintf "customlib-%s" loader.BslLib.module_name, Some loader.BslLib.dynloader, List.map snd loader.BslLib.splitqmlinit
36 ) loaders
37 in
38 let env = Top.dynload_and_init_env libs in
39 _start := Some env;
40 env
41 | Some env -> env
42
43 let get_env id =
44 try
45 Hashtbl.find _table id
46 with
47 | Not_found ->
48 let env = initial () in
49 let res = env, "" in
50 Hashtbl.add _table id res;
51 res
52
53 let set_env (id:env_id) = Hashtbl.add _table id
54
55 let webtop = "webtop:input"
56 let fold_map_topexpr = Top.fold_map_topexpr ~dbgen:true ~dump:true ~loc:webtop
57
58 let fold_map env src =
59 try
60 let src =
61 match QmlAstParser.TopLevel.of_string src with
62 | QmlAstParser.ParsedExpr expr -> [QmlTopLevel.Top_eval_expr expr]
63 | QmlAstParser.ParsedCode code -> List.map (fun elt -> QmlTopLevel.Top_code_elt elt) code
64 in
65 let env, out = Base.List.fold_left_map fold_map_topexpr env src in
66 let out = Top.to_string out in
67 env, out
68 with
69 | QmlAstParser.Exception e ->
70 env, QmlAstParser.short_parse_error_message ~extra:webtop e
71 | e ->
72 env, Top.string_of_exception e
73
74 ##register init : void -> void
75 let init () = ignore (initial ())
76
77 ##register eval : int -> string -> int
78 let eval id src =
79 let env, _ = get_env id in
80 let res = fold_map env src in
81 let id = !_last_id in
82 incr _last_id;
83 set_env id res;
84 id
85
86 ##register get_result : int -> string
87 let get_result id =
88 let _, out = get_env id in
89 out
90
91 ##register delete_env : int -> unit
92 let delete_env id = Hashtbl.remove _table id
Something went wrong with that request. Please try again.