Browse Source

don't hard-fail on parsing invalid module-level declaration modifiers

Dan Korostelev 5 years ago
parent
commit
6e7fda50e3
2 changed files with 44 additions and 41 deletions
  1. 7 7
      src/syntax/grammar.mly
  2. 37 34
      src/syntax/parser.ml

+ 7 - 7
src/syntax/grammar.mly

@@ -161,7 +161,7 @@ and parse_abstract doc meta flags = parser
 			| [< '(BrOpen,_); fl, p2 = parse_class_fields false p1 >] -> fl,p2
 			| [< >] -> syntax_error (Expected ["{";"to";"from"]) s ([],last_pos s)
 		in
-		let flags = List.map decl_flag_to_abstract_flag flags in
+		let flags = ExtList.List.filter_map decl_flag_to_abstract_flag flags in
 		let flags = (match st with None -> flags | Some t -> AbOver t :: flags) in
 		({
 			d_name = name;
@@ -197,7 +197,7 @@ and parse_type_decl mode s =
 				d_doc = doc_from_string_opt doc;
 				d_meta = meta;
 				d_params = pl;
-				d_flags = List.map decl_flag_to_global_flag c;
+				d_flags = ExtList.List.filter_map decl_flag_to_global_flag c;
 				d_data = FFun f;
 			}, punion p1 p2)
 		| [< '(Kwd Var,p1); name = dollar_ident; s >] ->
@@ -216,7 +216,7 @@ and parse_type_decl mode s =
 				d_doc = doc_from_string_opt doc;
 				d_meta = meta;
 				d_params = [];
-				d_flags = List.map decl_flag_to_global_flag c;
+				d_flags = ExtList.List.filter_map decl_flag_to_global_flag c;
 				d_data = t;
 			}, punion p1 p2)
 		| [< '(Kwd Enum,p1) >] ->
@@ -229,7 +229,7 @@ and parse_type_decl mode s =
 					d_doc = doc_from_string_opt doc;
 					d_meta = meta;
 					d_params = tl;
-					d_flags = List.map decl_flag_to_enum_flag c;
+					d_flags = ExtList.List.filter_map decl_flag_to_enum_flag c;
 					d_data = l
 				}, punion p1 p2)
 			end
@@ -271,7 +271,7 @@ and parse_type_decl mode s =
 				d_doc = doc_from_string_opt doc;
 				d_meta = meta;
 				d_params = tl;
-				d_flags = List.map decl_flag_to_class_flag c @ n @ hl;
+				d_flags = ExtList.List.filter_map decl_flag_to_class_flag c @ n @ hl;
 				d_data = fl;
 			}, punion p1 p2)
 		| [< '(Kwd Typedef,p1); name = type_name; tl = parse_constraint_params; '(Binop OpAssign,p2); t = parse_complex_type_at p2; s >] ->
@@ -283,7 +283,7 @@ and parse_type_decl mode s =
 				d_doc = doc_from_string_opt doc;
 				d_meta = meta;
 				d_params = tl;
-				d_flags = List.map decl_flag_to_enum_flag c;
+				d_flags = ExtList.List.filter_map decl_flag_to_enum_flag c;
 				d_data = t;
 			}, punion p1 (pos t))
 		| [< a,p = parse_abstract doc meta c >] ->
@@ -298,7 +298,7 @@ and parse_type_decl mode s =
 						d_doc = doc_from_string_opt doc;
 						d_meta = meta;
 						d_params = [];
-						d_flags = (List.map decl_flag_to_global_flag (List.rev crest)) @ [AFinal,p1];
+						d_flags = (ExtList.List.filter_map decl_flag_to_global_flag (List.rev crest)) @ [AFinal,p1];
 						d_data = FVar(t,e);
 					}, punion p1 p2)
 				| [< >] -> check_type_decl_flag_completion mode c s)

+ 37 - 34
src/syntax/parser.ml

@@ -97,38 +97,6 @@ let error m p = raise (Error (m,p))
 
 let special_identifier_files : (Path.UniqueKey.t,string) Hashtbl.t = Hashtbl.create 0
 
-let decl_flag_to_class_flag (flag,p) = match flag with
-	| DPrivate -> HPrivate
-	| DExtern -> HExtern
-	| DFinal -> HFinal
-	| DMacro -> error (Custom "macro on classes is not allowed") p
-	| DDynamic -> error (Custom "dynamic on classes is not allowed") p
-	| DInline -> error (Custom "inline on classes is not allowed") p
-
-let decl_flag_to_enum_flag (flag,p) = match flag with
-	| DPrivate -> EPrivate
-	| DExtern -> EExtern
-	| DFinal -> error (Custom "final on enums is not allowed") p
-	| DMacro -> error (Custom "macro on enums is not allowed") p
-	| DDynamic -> error (Custom "dynamic on enums is not allowed") p
-	| DInline -> error (Custom "inline on enums is not allowed") p
-
-let decl_flag_to_abstract_flag (flag,p) = match flag with
-	| DPrivate -> AbPrivate
-	| DExtern -> AbExtern
-	| DFinal -> error (Custom "final on abstracts is not allowed") p
-	| DMacro -> error (Custom "macro on abstracts is not allowed") p
-	| DDynamic -> error (Custom "dynamic on abstracts is not allowed") p
-	| DInline -> error (Custom "inline on abstracts is not allowed") p
-
-let decl_flag_to_global_flag (flag,p) = match flag with
-	| DPrivate -> (APrivate,p)
-	| DMacro -> (AMacro,p)
-	| DDynamic -> (ADynamic,p)
-	| DInline -> (AInline,p)
-	| DExtern -> error (Custom "extern on module-statics is not allowed") p (* TODO: would be nice to have this actually, but we need some design for it *)
-	| DFinal -> error (Custom "final on module-statics is not allowed") p
-
 module TokenCache = struct
 	let cache = ref (DynArray.create ())
 	let add (token : (token * pos)) = DynArray.add (!cache) token
@@ -181,13 +149,16 @@ let in_display_file = ref false
 let last_doc : (string * int) option ref = ref None
 let syntax_errors = ref []
 
-let syntax_error error_msg ?(pos=None) s v =
-	let p = (match pos with Some p -> p | None -> next_pos s) in
+let syntax_error_with_pos error_msg p v =
 	let p = if p.pmax = max_int then {p with pmax = p.pmin + 1} else p in
 	if not !in_display then error error_msg p;
 	syntax_errors := (error_msg,p) :: !syntax_errors;
 	v
 
+let syntax_error error_msg ?(pos=None) s v =
+	let p = (match pos with Some p -> p | None -> next_pos s) in
+	syntax_error_with_pos error_msg p v
+
 let handle_stream_error msg s =
 	let err,pos = if msg = "" then begin
 		let tk,pos = next_token s in
@@ -208,6 +179,38 @@ let get_doc s =
 			last_doc := None;
 			if pos = p.pmin then Some d else None
 
+let decl_flag_to_class_flag (flag,p) = match flag with
+	| DPrivate -> Some HPrivate
+	| DExtern -> Some HExtern
+	| DFinal -> Some HFinal
+	| DMacro -> syntax_error_with_pos (Custom "macro on classes is not allowed") p None
+	| DDynamic -> syntax_error_with_pos (Custom "dynamic on classes is not allowed") p None
+	| DInline -> syntax_error_with_pos (Custom "inline on classes is not allowed") p None
+
+let decl_flag_to_enum_flag (flag,p) = match flag with
+	| DPrivate -> Some EPrivate
+	| DExtern -> Some EExtern
+	| DFinal -> syntax_error_with_pos (Custom "final on enums is not allowed") p None
+	| DMacro -> syntax_error_with_pos (Custom "macro on enums is not allowed") p None
+	| DDynamic -> syntax_error_with_pos (Custom "dynamic on enums is not allowed") p None
+	| DInline -> syntax_error_with_pos (Custom "inline on enums is not allowed") p None
+
+let decl_flag_to_abstract_flag (flag,p) = match flag with
+	| DPrivate -> Some AbPrivate
+	| DExtern -> Some AbExtern
+	| DFinal -> syntax_error_with_pos (Custom "final on abstracts is not allowed") p None
+	| DMacro -> syntax_error_with_pos (Custom "macro on abstracts is not allowed") p None
+	| DDynamic -> syntax_error_with_pos (Custom "dynamic on abstracts is not allowed") p None
+	| DInline -> syntax_error_with_pos (Custom "inline on abstracts is not allowed") p None
+
+let decl_flag_to_global_flag (flag,p) = match flag with
+	| DPrivate -> Some (APrivate,p)
+	| DMacro -> Some (AMacro,p)
+	| DDynamic -> Some (ADynamic,p)
+	| DInline -> Some (AInline,p)
+	| DExtern -> syntax_error_with_pos (Custom "extern on module-statics is not allowed") p None
+	| DFinal -> syntax_error_with_pos (Custom "final on module-statics is not allowed") p None
+
 let serror() = raise (Stream.Error "")
 
 let magic_display_field_name = " - display - "