Skip to content
Browse files

[enhance] syntax: Added options to have several syntax at the same time

  • Loading branch information...
1 parent 750dcc5 commit a16ece844316d076404bc4b53f9ec12a621278e1 @BourgerieQuentin BourgerieQuentin committed Oct 30, 2012
View
4 compiler/opa/checkopacapi.ml
@@ -82,8 +82,6 @@ module SA = SurfaceAst
(* -- *)
-let _ = OpaSyntax.Args.r := {!OpaSyntax.Args.r with OpaSyntax.Args.parser = OpaSyntax.Classic}
-
let validation_ok = ref true
(* f *)
@@ -113,7 +111,7 @@ let spec = [
!>
" also check optional opacapi"
-]
+] @ OpaSyntax.Args.options
let anon_fun file =
let ext = File.extension file in
View
3 compiler/opa/s3Passes.ml
@@ -470,7 +470,6 @@ let pass_Print =
ignore (close_out oc);
ignore (try (* verification that we can reparse *)
OpaParser.code
- ~parser_:(!OpaSyntax.Args.r.OpaSyntax.Args.printer)
~cache:false
~filename:fn
(File.content fn)
@@ -1009,7 +1008,7 @@ let pass_CompileRecursiveValues =
let annotmap = typerEnv.QmlTypes.annotmap in
let code = env.Passes.qmlAst in
let val_ = OpaMapToIdent.val_ in
- if !(OpaSyntax.Args.r).OpaSyntax.Args.parser == OpaSyntax.Js then
+ if OpaSyntax.Args.get_parser None == OpaSyntax.Js then
WarningClass.set_warn Pass_CompileRecursiveValues.Warning.recval_lambda false;
let gamma, annotmap, code = Pass_CompileRecursiveValues.process_code ~val_ gamma annotmap code in
let typerEnv = {typerEnv with QmlTypes.gamma; annotmap} in
View
22 compiler/opalang/opaParser.ml
@@ -29,7 +29,7 @@ let hash = OpaParserVersion.hash
module Opa_parser = struct
module A = OpaSyntax.Args
let select ~js ~classic ?_filename ?_start v =
- match (!A.r).A.parser with
+ match A.get_parser _filename with
| OpaSyntax.Classic -> classic ?_filename ?_start v
| OpaSyntax.Js -> js ?_filename ?_start v
let parse_opa_parser_expr_eoi = select ~js:Opa_js_parser.parse_opa_parser_expr_eoi ~classic:Opa_classic_parser.parse_opa_parser_expr_eoi
@@ -172,8 +172,6 @@ let parse_error_flag =
let _ = Str.search_forward search_for lang 0 in ""
with Not_found -> "-->"
-module OA = OpaSyntax.Args
-
let check_unmatched_tag ppf content =
@@ -182,33 +180,33 @@ let check_unmatched_tag ppf content =
let num = Parser_utils.count_open_tags tag in
let num2 = Parser_utils.count_close_tags_in_string content tag in
if num>num2
- then Format.fprintf ppf
+ then Format.fprintf ppf
"@[<2>@{<bright>Hint:@}@\nThe @{<magenta>%s@}, found at %a, might be open\n"
(fst tag) QmlLoc.pp_pos_short ((QmlLoc.pos (snd tag)), false)
else ()
)
with Parser_utils.No_tag -> ()
-let show_content ppf (content, pos) =
+let show_content ppf (content, pos) =
let n = max 0 (min pos (String.length content-1)) in
let begin_citation = get_index_N_lines_before content n 5 in
let length_citation = n-begin_citation in
let begin_error_zone = get_index_N_lines_before content n 0 in
- let length_error_zone =
- min((get_index_N_lines_after content n 5)-begin_error_zone+1)
+ let length_error_zone =
+ min((get_index_N_lines_after content n 5)-begin_error_zone+1)
(String.length content -begin_error_zone) in
Format.fprintf ppf
("@[The@ error@ may@ be@ in@ the@ following@ citation,@ " ^^
"usually@ in@ the@ @{<red>red@}@ part@ (starting@ at@ %s)@ " ^^
"or@ just@ before:@.@\n@[@{<green>%s@}%s@{<red>%s@}@]")
parse_error_flag
(String.sub content begin_citation length_citation )
- parse_error_flag
+ parse_error_flag
(String.sub content begin_error_zone length_error_zone)
let show_parse_error file_name content error_summary error_details pos =
let _pos = FilePos. make_pos file_name pos pos in
- OManager.error
+ OManager.error
("%a@\n@[<2>%s@\n@[%a@]@\n" ^^
"@[<2>@{<bright>Hint@}:@\n%s@]%a@]@.")
FilePos.pp_pos _pos error_summary
@@ -230,15 +228,12 @@ let hl_factory parser_rule name ?filename contents =
let expr = hl_factory Opa_parser.parse_opa_parser_expr_eoi "Expression"
let ty = hl_factory Opa_parser.parse_opa_parser_ty_eoi "Type"
-let code ?(parser_=(!OA.r).OA.parser) ?(cache=false) ?(filename="") ?(sugar=false) content =
+let code ?(cache=false) ?(filename="") ?(sugar=false) content =
(*print_string content;*)
if sugar then Parser_utils.set_sugar_mode();
FilePos.add_file filename content;
match if cache then CacheParse.get filename content else None with
| None ->
- let r = OA.r in
- let old = (!r).OA.parser in
- r := {!r with OA.parser=parser_} ;
#<If:PARSER_CACHE_DEBUG>OManager.printf "Cache @{<red>miss@} for %s@." filename#<End>;
let res =
try
@@ -264,7 +259,6 @@ let code ?(parser_=(!OA.r).OA.parser) ?(cache=false) ?(filename="") ?(sugar=fals
in
OManager.flush_errors (); (* make sure that if someone threw errors, then we stop before saving the cache *)
if cache then CacheParse.set filename content res;
- r := {!r with OA.parser=old} ;
res
| Some l ->
#<If:PARSER_CACHE_DEBUG>OManager.printf "Cache @{<green>hit@} for %s@." filename#<End>;
View
4 compiler/opalang/opaParser.mli
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of Opa.
@@ -73,7 +73,7 @@ val ty : ?filename:filename -> contents -> nonuid SurfaceAst.ty
[{mlstate_dir}/opa/cache/parser].
(Default is [cache:false])
*)
-val code : ?parser_:OpaSyntax.t -> ?cache:bool -> ?filename:filename -> ?sugar:bool -> contents -> (nonuid, SurfaceAst.parsing_directive) SurfaceAst.code
+val code : ?cache:bool -> ?filename:filename -> ?sugar:bool -> contents -> (nonuid, SurfaceAst.parsing_directive) SurfaceAst.code
(** {6 Deprecated API} *)
View
2 compiler/opalang/opaPrint.ml
@@ -1900,6 +1900,6 @@ let makeFamilly syntax =
end : Familly)
let getDefaultFamilly () =
- (module (val (makeFamilly !(OpaSyntax.Args.r).OpaSyntax.Args.printer) : Familly) : Familly)
+ (module (val (makeFamilly (OpaSyntax.Args.get_printer ())) : Familly) : Familly)
include (val (makeFamilly OpaSyntax.Js) : Familly)
View
28 compiler/opalang/opaSyntax.ml
@@ -1,15 +1,18 @@
+module String = BaseString
module Arg = Base.Arg
type t = Classic | Js
module Args = struct
type options = {
+ files : t StringMap.t;
parser : t;
printer : t;
}
let default_options = {
+ files = StringMap.empty;
parser = Js;
printer = Js;
}
@@ -24,8 +27,31 @@ module Args = struct
let r = ref default_options
+ let parser_options = function
+ | "js-like" -> r:= {!r with parser=Js}
+ | "classic" -> r:= {!r with parser=Classic}
+ | str ->
+ let add_files files t =
+ let files =
+ List.fold_left
+ (fun m f -> StringMap.add f t m)
+ !r.files (String.slice ',' files)
+ in r := {!r with files}
+ in
+ match String.split_char ':' str with
+ | ("classic", files) -> add_files files Classic
+ | ("js-like", files) -> add_files files Js
+ | (_, _) -> failwith (Printf.sprintf "'%s' unexpected syntax" str)
+
+ let get_printer () = !r.printer
+
+ let get_parser filename =
+ match filename with
+ | None -> !r.parser
+ | Some filename -> try StringMap.find filename !r.files with Not_found -> !r.parser
+
let options = [
- ("--parser", Arg.spec_fun_of_assoc (fun s -> r := {!r with parser=s}) assoc,
+ ("--parser", Arg.String parser_options,
"Select kind of the input syntax (classic or js-like)");
("--printer", Arg.spec_fun_of_assoc (fun s -> r := {!r with printer=s}) assoc,
"Select kind of the ouput syntax (classic or js-like)")
View
9 compiler/opalang/opaSyntax.mli
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of Opa.
@@ -22,12 +22,9 @@ type t = Classic | Js
module Args : sig
- type options = {
- parser : t;
- printer : t;
- }
+ val get_printer : unit -> t
- val r : options ref
+ val get_parser : string option -> t
val options : (string * Base.Arg.spec * string) list
View
5 compiler/opalib/opaEnv.ml
@@ -189,8 +189,6 @@ type opa_options = {
i18n : I18n.options ;
- parser_ : OpaSyntax.Args.options;
-
parallelism : int; (* maximum number of // compilations *)
package_version: string; (* The version to be used when outputting
the package.json file *)
@@ -867,7 +865,7 @@ struct
no_assert = !ArgParser.no_assert ;
no_server =
(match !ArgParser.no_server with
- | None when (!OpaSyntax.Args.r).OpaSyntax.Args.parser = OpaSyntax.Js -> Some false
+ | None when OpaSyntax.Args.get_parser None = OpaSyntax.Js -> Some false
| x -> x)
;
@@ -914,7 +912,6 @@ struct
publish_src_code = !ArgParser.publish_src_code;
i18n = !I18n.r;
- parser_ = !OpaSyntax.Args.r;
parallelism = !ArgParser.parallelism;
package_version = !ArgParser.package_version;

0 comments on commit a16ece8

Please sign in to comment.
Something went wrong with that request. Please try again.