Support not-XML literals (#7438)

* [parser] try to parse inline XML

* support self-closers and refactor a bit

* add some tests

* type xml literals like format strings

* support (some?) completion in xml literals

* error on unprocessed markup literals

* add some comments to the not-XML lexing because it's mildly tricky

src/context/display/display.ml

@@ -126,6 +126,8 @@ module ExprPreprocessing = struct
 				annotate e DKStructure
 			| EDisplay _ ->
 				raise Exit
+			| EMeta((Meta.Markup,_,_),(EConst(String _),p)) when is_annotated p ->
+				annotate_marked e
 			| EConst (String _) when (not (Lexer.is_fmt_string (pos e)) || !Parser.was_auto_triggered) && is_annotated (pos e) && is_completion ->
 				(* TODO: check if this makes any sense *)
 				raise Exit

src/core/meta.ml

@@ -91,6 +91,7 @@ type strict_meta =
 	| LoopLabel
 	| LuaRequire
 	| LuaDotMethod
+	| Markup
 	| Meta
 	| Macro
 	| MaybeUsed
@@ -291,6 +292,7 @@ let get_info = function
 	| KeepSub -> ":keepSub",("Extends @:keep metadata to all implementing and extending classes",[UsedOn TClass])
 	| LibType -> ":libType",("Used by -net-lib and -java-lib to mark a class that shouldn't be checked (overrides, interfaces, etc) by the type loader",[UsedInternally; UsedOn TClass; Platforms [Java;Cs]])
 	| LoopLabel -> ":loopLabel",("Mark loop and break expressions with a label to support breaking from within switch",[UsedInternally])
+	| Markup -> ":markup",("Used as a result of inline XML parsing",[])
 	| Meta -> ":meta",("Internally used to mark a class field as being the metadata field",[])
 	| Macro -> ":macro",("(deprecated)",[])
 	| MaybeUsed -> ":maybeUsed",("Internally used by DCE to mark fields that might be kept",[UsedInternally])

src/syntax/grammar.mly

@@ -1102,6 +1102,17 @@ and expr = parser
 			let e = EConst (Ident "null"),null_pos in
 			make_meta name params e p
 		end
+	| [< '(Binop OpLt,p1); name,pi = dollar_ident; s >] ->
+		if p1.pmax <> pi.pmin then error (Custom("Unexpected <")) p1;
+		let open_tag = "<" ^ name in
+		let close_tag = "</" ^ name ^ ">" in
+		Lexer.reset();
+		Buffer.add_string Lexer.buf ("<" ^ name);
+		let i = Lexer.lex_xml p1.pmin open_tag close_tag !code_ref in
+		let xml = Lexer.contents() in
+		let e = EConst (String xml),{p1 with pmax = i} in
+		let e = make_meta Meta.Markup [] e p1 in
+		expr_next e s
 	| [< '(BrOpen,p1); s >] ->
 		(match s with parser
 		| [< b = block1; s >] ->

src/syntax/lexer.ml

@@ -30,9 +30,16 @@ type error_msg =
 	| Unclosed_code
 	| Invalid_escape of char
 	| Invalid_option
+	| Unterminated_xml
 
 exception Error of error_msg * pos
 
+type xml_lexing_context = {
+	open_tag : string;
+	close_tag : string;
+	lexbuf : Sedlexing.lexbuf;
+}
+
 let error_msg = function
 	| Invalid_character c when c > 32 && c < 128 -> Printf.sprintf "Invalid character '%c'" (char_of_int c)
 	| Invalid_character c -> Printf.sprintf "Invalid character 0x%.2X" c
@@ -42,6 +49,7 @@ let error_msg = function
 	| Unclosed_code -> "Unclosed code string"
 	| Invalid_escape c -> Printf.sprintf "Invalid escape sequence \\%s" (Char.escaped c)
 	| Invalid_option -> "Invalid regular expression option"
+	| Unterminated_xml -> "Unterminated XML literal"
 
 type lexer_file = {
 	lfile : string;
@@ -252,7 +260,6 @@ let mk_keyword lexbuf kwd =
 let invalid_char lexbuf =
 	error (Invalid_character (lexeme_char lexbuf 0)) (lexeme_start lexbuf)
 
-
 let ident = [%sedlex.regexp?
 	(
 		Star '_',
@@ -531,3 +538,58 @@ and regexp_options lexbuf =
 	| 'a'..'z' -> error Invalid_option (lexeme_start lexbuf)
 	| "" -> ""
 	| _ -> assert false
+
+and not_xml ctx depth in_open =
+	let lexbuf = ctx.lexbuf in
+	match%sedlex lexbuf with
+	| eof ->
+		raise Exit
+	| '\n' | '\r' | "\r\n" ->
+		newline lexbuf;
+		store lexbuf;
+		not_xml ctx depth in_open
+	(* closing tag *)
+	| '<','/',ident,'>' ->
+		let s = lexeme lexbuf in
+		Buffer.add_string buf s;
+		(* If it matches our document close tag, finish or decrease depth. *)
+		if s = ctx.close_tag then begin
+			if depth = 0 then lexeme_end lexbuf
+			else not_xml ctx (depth - 1) false
+		end else
+			not_xml ctx depth false
+	(* opening tag *)
+	| '<',ident ->
+		let s = lexeme lexbuf in
+		Buffer.add_string buf s;
+		(* If it matches our document open tag, increase depth and set in_open to true. *)
+		let depth,in_open = if s = ctx.open_tag then depth + 1,true else depth,false in
+		not_xml ctx depth in_open
+	(* /> *)
+	| '/','>' ->
+		let s = lexeme lexbuf in
+		Buffer.add_string buf s;
+		(* We only care about this if we are still in the opening tag, i.e. if it wasn't closed yet.
+		   In that case, decrease depth and finish if it's 0. *)
+		let depth = if in_open then depth - 1 else depth in
+		if depth < 0 then lexeme_end lexbuf
+		else not_xml ctx depth false
+	| '<' | '/' | '>' ->
+		store lexbuf;
+		not_xml ctx depth in_open
+	| Plus (Compl ('<' | '/' | '>' | '\n' | '\r')) ->
+		store lexbuf;
+		not_xml ctx depth in_open
+	| _ ->
+		assert false
+
+let lex_xml p open_tag close_tag lexbuf =
+	let ctx = {
+		open_tag = open_tag;
+		close_tag = close_tag;
+		lexbuf = lexbuf;
+	} in
+	try
+		not_xml ctx 0 true
+	with Exit ->
+		error Unterminated_xml p

src/syntax/parser.ml

@@ -102,6 +102,7 @@ let was_auto_triggered = ref false
 let display_mode = ref DMNone
 let in_macro = ref false
 let had_resume = ref false
+let code_ref = ref (Sedlexing.Utf8.from_string "")
 let delayed_syntax_completion : (syntax_completion * pos) option ref = ref None
 
 let reset_state () =
@@ -111,6 +112,7 @@ let reset_state () =
 	display_position := null_pos;
 	in_macro := false;
 	had_resume := false;
+	code_ref := Sedlexing.Utf8.from_string "";
 	delayed_syntax_completion := None
 
 (* Per-file state *)

src/syntax/parserEntry.ml

@@ -77,6 +77,8 @@ let parse ctx code file =
 	let restore_cache = TokenCache.clear () in
 	let was_display = !in_display in
 	let was_display_file = !in_display_file in
+	let old_code = !code_ref in
+	code_ref := code;
 	in_display := !display_position <> null_pos;
 	in_display_file := !in_display && Path.unique_full_path file = !display_position.pfile;
 	let restore =
@@ -84,6 +86,7 @@ let parse ctx code file =
 			restore_cache ();
 			in_display := was_display;
 			in_display_file := was_display_file;
+			code_ref := old_code;
 		)
 	in
 	let mstack = ref [] in

src/typing/typer.ml

@@ -2186,6 +2186,8 @@ and type_meta ctx m e1 with_type p =
 			(match follow e.etype with
 				| TAbstract({a_impl = Some c},_) when PMap.mem "toString" c.cl_statics -> call_to_string ctx e
 				| _ -> e)
+		| (Meta.Markup,_,_) ->
+			error "Markup literals must be processed by a macro" p
 		| (Meta.This,_,_) ->
 			let e = match ctx.this_stack with
 				| [] -> error "Cannot type @:this this here" p

tests/unit/src/unit/HelperMacros.hx

@@ -3,6 +3,7 @@ package unit;
 import haxe.macro.Expr;
 import haxe.macro.Context.*;
 import haxe.macro.TypeTools.*;
+import haxe.macro.MacroStringTools.*;
 
 class HelperMacros {
 	static public macro function getCompilationDate() {
@@ -83,4 +84,13 @@ class HelperMacros {
 		var s2 = new haxe.macro.Printer().printExpr(e);
 		return macro eq($v{s}, $v{s2});
 	}
+
+	static public macro function pipeMarkupLiteral(e:Expr) {
+		return switch (e) {
+			case macro @:markup $v{(s:String)}:
+				formatString(s, e.pos);
+			case _:
+				error("Markup literal expected", e.pos);
+		}
+	}
 }

tests/unit/src/unitstd/InlineXml.unit.hx

@@ -0,0 +1,30 @@
+unit.HelperMacros.pipeMarkupLiteral(<xml></xml>) == "<xml></xml>";
+unit.HelperMacros.pipeMarkupLiteral(<xml ></xml>) == "<xml ></xml>";
+unit.HelperMacros.pipeMarkupLiteral(<xml > </xml>) == "<xml > </xml>";
+
+// nested
+unit.HelperMacros.pipeMarkupLiteral(<xml><xml></xml></xml>) == "<xml><xml></xml></xml>";
+unit.HelperMacros.pipeMarkupLiteral(<xml><yml></xml>) == "<xml><yml></xml>";
+
+// self-closing
+unit.HelperMacros.pipeMarkupLiteral(<xml/>) == "<xml/>";
+unit.HelperMacros.pipeMarkupLiteral(<xml abc />) == "<xml abc />";
+
+// self-closing nested
+unit.HelperMacros.pipeMarkupLiteral(<xml><xml /></xml>) == "<xml><xml /></xml>";
+
+// No check for string literal balancing
+unit.HelperMacros.pipeMarkupLiteral(<xml a=" </xml>) == "<xml a=\" </xml>";
+unit.HelperMacros.pipeMarkupLiteral(<xml a=' </xml>) == "<xml a=' </xml>";
+
+// comments are fine
+unit.HelperMacros.pipeMarkupLiteral(<xml a=// </xml>) == "<xml a=// </xml>";
+unit.HelperMacros.pipeMarkupLiteral(<xml a=/* </xml>) == "<xml a=/* </xml>";
+
+// regex too
+unit.HelperMacros.pipeMarkupLiteral(<xml a=~/ </xml>) == "<xml a=~/ </xml>";
+
+// format
+var count = 33;
+unit.HelperMacros.pipeMarkupLiteral(<xml>$count + $count = ${count*2}</xml>) == unit.HelperMacros.pipeMarkupLiteral(<xml>33 + 33 = 66</xml>);
+unit.HelperMacros.pipeMarkupLiteral(<xml>$count + <xml>$count</xml> = ${count*2}</xml>) == unit.HelperMacros.pipeMarkupLiteral(<xml>33 + <xml>33</xml> = 66</xml>);