Skip to content
This repository
tag: v1214
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 136 lines (113 sloc) 4.754 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
(*
Copyright © 2011 MLstate

This file is part of OPA.

OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.

OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.

You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
(* CF mli *)
type filename = string
type contents = string

module ByPassMap = BslLib.BSL.ByPassMap
module D = BslDirectives

module List = Base.List
module String = Base.String

(* FIXME: think about where to put the function now *)
let now = DebugTracer.now

let (!?) pos fmt =
  if WarningClass.is_warn WarningClass.bsl_register
  then (
    OManager.printf "%a@\n" FilePos.pp_citation pos ;
    OManager.warning ~wclass:WarningClass.bsl_register fmt
  )
  else
    Format.ifprintf Format.std_formatter fmt

let (!!) pos fmt =
  OManager.printf "%a@\n" FilePos.pp_citation pos ;
  OManager.error fmt

let preprocess ~final_bymap decorated_file =
  let filename = decorated_file.D.filename in
  let browser = ByPassMap.Browser.init final_bymap in
  let fold_left buf parsed =
    let pos = D.pos parsed in
    let (!?) x = !? pos x in
    let (!!) x = !! pos x in
    match parsed with
      | D.Source (_, s) ->
          let s =
            if String.is_contained ";;" s then (
              !? "This line contains a toplevel separator @{<bright>';;'@}@\nIt will be removed to assure parser-compatibility@\n" ;
              String.replace s ";;" " "
            ) else s
          in
          FBuffer.addln buf s

      (*
When a format definition is found, BslRegisterParser stores it in a table,
and then, the BSL Browser access this table to solve the inclusion.
In opa syntax, bsl format definition can after preprocessing just be ignored
*)
      | D.Directive (_, _, D.FormatDefinition _) -> buf

      | D.Directive (_, _, D.IncludeType strreg) ->

          let regexp = Str.regexp strreg in
          let match_any_type = ref false in
          let buf =
            ByPassMap.fold_types final_bymap (
              fun buf t ->
                let name =
                  match t with
                  | BslTypes.External (_, name, _) -> name
                  | _ -> assert false
                in
                if Str.string_match regexp name 0 then (
                  match_any_type := true ;
                  FBuffer.printf buf "%a@\n" BslTypesGeneration.Opa.pp_definition t
                )
                else buf
            ) buf
          in
          if not (!match_any_type) then (
            !? (
              "##include-type, regexpr=%S@\nThis inclusion produces an empty code@\n"^^
              "@[<2>@{<bright>Hint@}:@\n"^^
              "This inclusion may be deprecated, or the types may@\n"^^
              "have been renamed, and do not match the regexp anymore.@]@\n"
            )
              strreg ;
            ()
          );
          buf


      | D.Directive (_, _, D.Include (fmt, link)) ->
          let link = String.lowercase link in (
            match ByPassMap.Browser.Path.of_string link with
            | None ->
                !! "##include, format=<abstr>, path=%S@\nThis is not a valid syntax for a path.@\n" link
            | Some path -> (
                match ByPassMap.Browser.Path.cd browser path with
                | Some elt ->
                    (* TODO: fix whenever BslLib.include_format will uses Format *)
                    let fixme_string_instead_of_format = ByPassMap.Browser.include_format elt fmt in
                    FBuffer.addln buf fixme_string_instead_of_format

                | None ->
                    !! "##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
              )
          )

  in
  let buf = FBuffer.create ( 8 * 1024 ) in
  let buf = FBuffer.printf buf "/* File: %S -- auto preprocessing bsl : %S */\n" filename (now()) in
  let buf = List.fold_left fold_left buf decorated_file.D.decorated_source in
  filename, buf


(* Checking *)

(*
TODO:
when we will finaly remove mlstatebsl files, we will remove opa files from opa-plugin-builder files
and remove the module BslOpa
*)

type true_means_error = bool

let checking_fail ~final_bymap:_ _opa_code =
  ( false : true_means_error) , []
Something went wrong with that request. Please try again.