Skip to content
Browse files

[fix] OpaParser: add sugar directive only for translate tool

  • Loading branch information...
1 parent ca2dcec commit b55f000193d7c8776f3767d18876fee6217c7c61 @cedricss cedricss committed Mar 8, 2012
View
6 opa/s3Passes.ml
@@ -417,7 +417,7 @@ let pass_PreProcess =
in
{ e with PH.env = (process files, process ufiles) })
-let pass_Parse =
+let make_pass_Parse sugar =
PassHandler.make_pass
(fun e ->
let options = e.PH.options in
@@ -428,6 +428,7 @@ let pass_Parse =
OpaParser.code
~cache:(not options.O.no_cache_parse)
~filename:input_file.P.inputFile_basename
+ ~sugar
input_file.P.inputFile_content
in
{ SurfaceAstPassesTypes.
@@ -441,6 +442,9 @@ let pass_Parse =
PassHandler.make_env options ((special_parsed_files, user_parsed_files), env)
)
+let pass_Parse = make_pass_Parse false
+let pass_ParseSugar = make_pass_Parse true
+
let parsed_files_printers extract =
function opt ->
List.map
View
9 opa/s3Passes.mli
@@ -97,6 +97,15 @@ val pass_Parse :
)
opa_pass
+val pass_ParseSugar :
+ (
+ env_OpenFiles,
+ ( SurfaceAst.parsing_directive SurfaceAstPassesTypes.parsed_file list
+ * SurfaceAst.parsing_directive SurfaceAstPassesTypes.parsed_file list
+ ) * env_OpenFiles
+ )
+ opa_pass
+
val pass_Print :
(
((
View
2 opa/syntaxHelper.ml
@@ -61,7 +61,7 @@ let _ =
|+> ("PreProcess", S3.pass_PreProcess)
- |+> ("Parse", S3.pass_Parse)
+ |+> ("Parse", S3.pass_ParseSugar)
|+> ("Print", S3.pass_Print)
View
20 opalang/classic_syntax/parser_utils.ml
@@ -30,6 +30,9 @@ module Q = QmlAst
let (|>) = InfixOperator.(|>)
+let sugar_mode = ref false
+let set_sugar_mode() = sugar_mode := true
+
(* cf mli *)
(*
@@ -658,9 +661,13 @@ let make_function2 letins double_dot e el =
in
let el_sugar = map_el (function _ -> ident_hole) el in
let sugar_directive e_sugar e =
- let expr_sugar = make_function_body double_dot e_sugar el_sugar in
- let dir_node = Directive (`sugar expr_sugar, [e,builtin()], []) in
- dir_node
+ let l = [e,builtin()] in
+ if !sugar_mode then
+ let expr_sugar = make_function_body double_dot e_sugar el_sugar in
+ let dir_node = Directive (`sugar expr_sugar, l, []) in
+ dir_node
+ else
+ e
in
match e with
| `hole p_sugar ->
@@ -853,7 +860,12 @@ let create_letins ~label dirs l e2 =
*)
let rec bind_in_to_expr_in dirs binding e2 =
let (p,e1) = binding in
- let pat_in_sugar_directive e label = Directive (`sugar_pat_in (p,e1,e2), [e], []), label in
+ let pat_in_sugar_directive e label =
+ if !sugar_mode then
+ Directive (`sugar_pat_in (p,e1,e2), [e], []), label
+ else
+ e
+ in
undecorate (
match p with
| (PatVar v, label) ->
View
3 opalang/classic_syntax/parser_utils.mli
@@ -62,6 +62,9 @@ type parsing_expr = (nonuid, parsing_directive) expr
(** An node resulting of parsing *)
type parsing_node = (nonuid, parsing_directive) expr_node
+(** Activate sugar mode to preserve syntactic sugar inside a parsing directive *)
+val set_sugar_mode : unit -> unit
+
(** General functions *)
val cur2 : ('a * 'b -> 'c) -> 'a -> 'b -> 'c
val unc2 : ('a -> 'b -> 'c) -> 'a * 'b -> 'c
View
3 opalang/opaParser.ml
@@ -229,8 +229,9 @@ 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="") content =
+let code ?(parser_=(!OA.r).OA.parser) ?(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 ->
View
2 opalang/opaParser.mli
@@ -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 -> contents -> (nonuid, SurfaceAst.parsing_directive) SurfaceAst.code
+val code : ?parser_:OpaSyntax.t -> ?cache:bool -> ?filename:filename -> ?sugar:bool -> contents -> (nonuid, SurfaceAst.parsing_directive) SurfaceAst.code
(** {6 Deprecated API} *)

0 comments on commit b55f000

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