Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 62 lines (54 sloc) 2.015 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
19 module SAP = SurfaceAstPasses
20 module SAH = SurfaceAstHelper
21 module P = Passes
22
23 let noloc v = v, SurfaceAstCons.Label.builtin ()
24
25 let register_code ~special files srcs =
26 let add_file map f =
27 StringMap.add f.P.inputFile_filename f.P.inputFile_org_content map
28 in
29 let sources = List.fold_left add_file StringMap.empty srcs in
30 (* Puts:
31 _ = (%%BslAppSrcCode.register_src_code%%)(fn, code)
32 at the beginning of [code].
33 *)
34 let register_src_code f_name =
35 let f_content =
36 match StringMap.find_opt f_name sources with
37 | Some content -> content
38 | None -> OManager.error "Internal error: cannot find source code for @{<bright>%S@}" f_name
39 in
40 let bypass = SAH.bypass (
41 if special then
42 Opacapi.Opabsl.BslAppSrcCode.register_special_src_code
43 else
44 Opacapi.Opabsl.BslAppSrcCode.register_src_code
45 )
46 in
47 let args_tuple = [ ("f2", noloc (SAH.string f_name))
48 ; ("f3", noloc (SAH.string f_content))
49 ]
50 in
51 let register = SAH.apply (noloc bypass, noloc args_tuple) in
52 let nv = SAH.newval ([noloc SAH.patany, noloc register], false) in
53 noloc nv
54 in
55 let register_file f =
56 { f with
57 SAP.parsedFile_lcode =
58 register_src_code f.SAP.parsedFile_filename :: f.SAP.parsedFile_lcode
59 }
60 in
61 List.map register_file files
Something went wrong with that request. Please try again.