Skip to content
This repository
tag: v45
Fetching contributors…

Cannot retrieve contributors at this time

file 276 lines (248 sloc) 9.875 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 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276
(*
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/>.
*)

(**
Common library for any Js compiler

@author Mathieu Barbin
@author Maxime Audouin
*)

(* depends *)
module List = Base.List

(* alias *)
module J = Qml2jsOptions

(** some type are shared with qml2ocaml, some not *)

type env_js_output =
    {
      generated_files : (string * string) list ; (** path/name without build directory * contents *)
    }

(**
PASSES :
-------
// Command line passes
returns a : env_bsl, env_blender

val js_generation : argv_options -> env_js_input -> env_js_output
val js_treat : argv_options -> env_js_output -> int

NEEDED from any instance of a js-compiler :
val qml_to_js : qml_to_js
*)

module JsTreat :
sig
  val js_bslfilesloading : Qml2jsOptions.t -> BslLib.env_bsl -> (string * string) list * JsAst.code
  val js_generation : Qml2jsOptions.t -> (string * string) list -> J.env_js_input -> env_js_output
  val js_treat : Qml2jsOptions.t -> env_js_output -> int
end =
struct
  open Qml2jsOptions

  let take_n n =
    let rec aux acc i rest =
      if i >= n then List.rev acc, rest else
        match rest with
        | [] -> List.rev acc, []
        | t::q -> aux (t::acc) (succ i) q
    in aux [] 0

  let js_bslfilesloading env_opt env_bsl =
    (* 1) extra libraries *)
    let generated_files = [] in
    let generated_files =
      let fold acc (extra_lib, conf) =
        let () =
          (*
TODO: refactor so that conf is not ignored,
and optimization pass applied
*)
          ignore conf
        in
        let get t =
          let contents = File.content t in
          (File.from_pattern "%b.js" t, contents)::acc
        in
        match File.get_locations env_opt.extra_path extra_lib with
        | [] ->
            OManager.error (
              "Cannot find extra-lib @{<bright>%s@} in search path@\n"^^
              "@[<2>@{<bright>Hint@}:@\nPerhaps a missing @{<bright>-I@} ?@]" ) extra_lib
        | [t] -> get t
        | (t::_) as all ->
            OManager.warning ~wclass:WarningClass.bsl_loading (
              "extra-lib @{<bright>%s@} is found in several places@\n%s\n"^^
              "I will use this one : @{<bright>%s@}" ) extra_lib (String.concat " " all) t ;
            get t
      in
      List.fold_left fold generated_files env_opt.extra_lib
    in

    (* 2) loaded bsl containing js files
order : since the generated code contains call to bypass of bsl, it is too dangerous to
put the extra-libs between bsl and the generated code *)
    let generated_files =
      let filter_bsl =
        if env_opt.command_line then
          fun (filename, content, conf) ->
            let filename = Filename.basename filename in
            let b:bool = List.for_all
              (fun s -> not (String.is_contained s filename))
              ["bslClient.js"; "bslClientOnly.js"; "bslJson.js"; "syslog.js";
               "jquery"; "jQuery"; "Anchors";
               "json2.js"; "ojs.js"]
              (* every file that need functionality that won't be available in
* js or rhino should end up in this match *)
            in if b then
              let ppjs =
                let ppenv = Pprocess.fill_with_sysenv Pprocess.empty_env in
                (* TODO modifier ppenv avec des choses *)
                let ppopt = Pprocess.default_options ppenv in
                Pprocess.process Pplang.js_description ppopt in
              let content = ppjs content in
              let () =
                (*
TODO: refactor so that conf is not ignored,
and optimization pass applied
*)
                ignore conf
              in
              Some (filename, content)
            else None
        else
          fun (filename, content, _conf) -> Some (filename, content)
      in
      let fold acc loader =
        List.rev_filter_map_append filter_bsl loader.BslPluginInterface.js_code acc
      in
      List.fold_left fold generated_files env_bsl.BslLib.plugins
    in
    let ast = List.flatten (List.rev_map (
                              fun (_,content) ->
                                (*
TODO: we must take care about conf,
and not parse file tagged as Verbatim
*)
                                JsParse.String.code content
                            ) generated_files) in
    List.rev generated_files, ast

  let js_generation env_opt generated_files env_js_input =
    let name_generation ?index () =
      match index with
      | None -> env_opt.target
      | Some (i, n) -> Printf.sprintf "js_%d_%s" (i * n) env_opt.target
    in

    let generated_files = List.rev generated_files in

    (* some more init given by the specific implementation of the backen (bypass projection : bsl_js_init.js) *)
    let generated_files =
      let map (name, elts) =
        name, (
          match elts with
          | `ast elts ->
              let code = List.map snd elts in
              JsPrint.code code
          | `string s -> s
        )
      in
      List.rev_map_append map env_js_input.js_init_contents generated_files
    in

    let generated_files =
      match env_opt.split_js_value with
      | None ->
          let file = name_generation (), JsPrint.code env_js_input.js_code in
          file::generated_files
      | Some n ->
          let rec aux acc i rest =
            let filename = name_generation ~index:(i, n) () in
            match take_n n rest with
            | code, rest ->
                let acc =
                  let file = filename, JsPrint.code code in
                  file::acc in
                begin
                  match rest with
                  | [] -> acc
                  | _ :: _ -> aux acc (succ i) rest
                end
          in
          aux generated_files 1 env_js_input.js_code
    in
    let last =
      match generated_files with
      | (last,_)::_ -> last
      | [] -> Filename.concat env_opt.compilation_directory "empty.js" in

    let generated_files = List.rev generated_files in

    (* keep split, or merge them all *)
    let generated_files =
      if env_opt.split then generated_files else
        begin
          OManager.verbose "append files into %s" last ;
          let fold buf (filename, contents) =
            OManager.verbose "append -- @{<bright>%s@}" filename;
            FBuffer.addln buf contents in
          let buf = FBuffer.create 1048 in
          let buf = List.fold_left fold buf generated_files in
          [ last, FBuffer.contents buf ]
        end
    in

    let _ =
      let write (filename, contents) =
        let filename = Filename.concat env_opt.compilation_directory filename in
        OManager.verbose "writing file @{<bright>%s@}" filename ;
        let success = File.output filename contents in
        if not success then OManager.error "cannot write file @{<bright>%S@}" filename
      in
      let caller_wd = Sys.getcwd () in
      let build_dir = Filename.concat caller_wd env_opt.compilation_directory in
      OManager.verbose "create/enter directory @{<bright>%s@}" build_dir ;
      let success = File.check_create_path build_dir in
      let _ = if not success then OManager.error "cannot create or enter in directory @{<bright>%s@}" build_dir in
      List.iter write generated_files
    in
    { generated_files = generated_files }

  let js_treat env_opt env_js_output =
    if not env_opt.exe_run
    then 0
    else
      let prog = env_opt.js_exe in
      let args = env_opt.exe_argv in
      let args = args @ ( List.map fst env_js_output.generated_files ) in
      OManager.verbose "building finished, will run @{<bright>%s@}" prog ;
      OManager.verbose "going to directory @{<bright>%s@}" env_opt.compilation_directory ;
      Sys.chdir env_opt.compilation_directory ;
      let command = String.concat " " (prog::args) in
      OManager.verbose "exec$ %s" command ;
      let args = Array.of_list (prog::args) in
      let run () = Unix.execvp prog args in
      Unix.handle_unix_error run ()
end

module Sugar :
sig
  val for_opa : val_:(string -> QmlAst.ident) ->
                ?bsl:JsAst.code ->
                closure_map:Ident.t IdentMap.t ->
                renaming_server:QmlRenamingMap.t ->
                renaming_client:QmlRenamingMap.t ->
                (module Qml2jsOptions.JsBackend) ->
                Qml2jsOptions.t ->
                BslLib.env_bsl ->
                QmlTyper.env ->
                QmlAst.code ->
                J.env_js_input
  val dummy_for_opa : (module Qml2jsOptions.JsBackend) -> unit
end
=
struct
  let for_opa ~val_ ?bsl:bsl_code ~closure_map ~renaming_server ~renaming_client back_end argv env_bsl env_typer code =
    let module M = (val back_end : Qml2jsOptions.JsBackend) in
    let env_js_input = M.compile ~val_ ?bsl:bsl_code ~closure_map ~renaming_server ~renaming_client argv env_bsl env_typer code in
    env_js_input
  let dummy_for_opa backend =
    let module M = (val backend : Qml2jsOptions.JsBackend) in
    M.dummy_compile ()
end


let wclass =
  let doc = "Javascript compiler warnings" in
  WarningClass.create ~name:"jscompiler" ~doc ~err:false ~enable:true ()
Something went wrong with that request. Please try again.