Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 136 lines (113 sloc) 4.754 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 (* CF mli *)
19 type filename = string
20 type contents = string
21
22 module ByPassMap = BslLib.BSL.ByPassMap
23 module D = BslDirectives
24
25 module List = Base.List
26 module String = Base.String
27
28 (* FIXME: think about where to put the function now *)
29 let now = DebugTracer.now
30
31 let (!?) pos fmt =
32 if WarningClass.is_warn WarningClass.bsl_register
33 then (
34 OManager.printf "%a@\n" FilePos.pp_citation pos ;
35 OManager.warning ~wclass:WarningClass.bsl_register fmt
36 )
37 else
38 Format.ifprintf Format.std_formatter fmt
39
40 let (!!) pos fmt =
41 OManager.printf "%a@\n" FilePos.pp_citation pos ;
42 OManager.error fmt
43
44 let preprocess ~final_bymap decorated_file =
45 let filename = decorated_file.D.filename in
46 let browser = ByPassMap.Browser.init final_bymap in
47 let fold_left buf parsed =
48 let pos = D.pos parsed in
49 let (!?) x = !? pos x in
50 let (!!) x = !! pos x in
51 match parsed with
52 | D.Source (_, s) ->
53 let s =
54 if String.is_contained ";;" s then (
55 !? "This line contains a toplevel separator @{<bright>';;'@}@\nIt will be removed to assure parser-compatibility@\n" ;
56 String.replace s ";;" " "
57 ) else s
58 in
59 FBuffer.addln buf s
60
61 (*
62 When a format definition is found, BslRegisterParser stores it in a table,
63 and then, the BSL Browser access this table to solve the inclusion.
64 In opa syntax, bsl format definition can after preprocessing just be ignored
65 *)
66 | D.Directive (_, _, D.FormatDefinition _) -> buf
67
68 | D.Directive (_, _, D.IncludeType strreg) ->
69
70 let regexp = Str.regexp strreg in
71 let match_any_type = ref false in
72 let buf =
73 ByPassMap.fold_types final_bymap (
74 fun buf t ->
75 let name =
76 match t with
77 | BslTypes.External (_, name, _) -> name
78 | _ -> assert false
79 in
80 if Str.string_match regexp name 0 then (
81 match_any_type := true ;
82 FBuffer.printf buf "%a@\n" BslTypesGeneration.Opa.pp_definition t
83 )
84 else buf
85 ) buf
86 in
87 if not (!match_any_type) then (
88 !? (
89 "##include-type, regexpr=%S@\nThis inclusion produces an empty code@\n"^^
90 "@[<2>@{<bright>Hint@}:@\n"^^
91 "This inclusion may be deprecated, or the types may@\n"^^
92 "have been renamed, and do not match the regexp anymore.@]@\n"
93 )
94 strreg ;
95 ()
96 );
97 buf
98
99
100 | D.Directive (_, _, D.Include (fmt, link)) ->
101 let link = String.lowercase link in (
102 match ByPassMap.Browser.Path.of_string link with
103 | None ->
104 !! "##include, format=<abstr>, path=%S@\nThis is not a valid syntax for a path.@\n" link
105 | Some path -> (
106 match ByPassMap.Browser.Path.cd browser path with
107 | Some elt ->
108 (* TODO: fix whenever BslLib.include_format will uses Format *)
109 let fixme_string_instead_of_format = ByPassMap.Browser.include_format elt fmt in
110 FBuffer.addln buf fixme_string_instead_of_format
111
112 | None ->
113 !! "##include, format=<abstr>, path=%S@\nCannot resolve this path.@\n@[<2>@{<brigh>Hint@}:@\n+ Check if your lib defines such path (ml or js)@\n+ use @{<bright>bslbrowser@} for previous plugins (depends)@]@\n" link
114 )
115 )
116
117 in
118 let buf = FBuffer.create ( 8 * 1024 ) in
119 let buf = FBuffer.printf buf "/* File: %S -- auto preprocessing bsl : %S */\n" filename (now()) in
120 let buf = List.fold_left fold_left buf decorated_file.D.decorated_source in
121 filename, buf
122
123
124 (* Checking *)
125
126 (*
127 TODO:
fd49b14 [cleanup] blender: removing dead code
Mathieu Barbin authored
128 when we will finaly remove mlstatebsl files, we will remove opa files from opa-plugin-builder files
129 and remove the module BslOpa
fccc685 Initial open-source release
MLstate authored
130 *)
131
132 type true_means_error = bool
133
134 let checking_fail ~final_bymap:_ _opa_code =
135 ( false : true_means_error) , []
Something went wrong with that request. Please try again.