[parser] split up parser

parser.ml: types and functions that used to be at the top
grammar.mly: the actual grammar that has to be transformed by camlp4
parserEntry: parsing entry functions

Makefile

@@ -118,7 +118,7 @@ _build/%:%
 build_dirs:
 	@mkdir -p $(BUILD_DIRECTORIES)
 
-_build/src/syntax/parser.ml:src/syntax/parser.mly
+_build/src/syntax/grammar.ml:src/syntax/grammar.mly
 	camlp4o -impl $< -o $@
 
 _build/src/compiler/version.ml: FORCE
@@ -128,7 +128,7 @@ else
 	echo let version_extra = None > _build/src/compiler/version.ml
 endif
 
-build_src: | $(BUILD_SRC) _build/src/syntax/parser.ml _build/src/compiler/version.ml
+build_src: | $(BUILD_SRC) _build/src/syntax/grammar.ml _build/src/compiler/version.ml
 
 haxe: build_src
 	$(MAKE) -f $(MAKEFILENAME) build_pass_1

src/macro/eval/evalDebugMisc.ml

@@ -73,7 +73,7 @@ exception Parse_expr_error of string
 
 let parse_expr ctx s p =
 	let error s = raise (Parse_expr_error s) in
-	Parser.parse_expr_string (ctx.curapi.get_com()).Common.defines s p error false
+	ParserEntry.parse_expr_string (ctx.curapi.get_com()).Common.defines s p error false
 
 (* Vars *)
 

src/syntax/parser.mly → src/syntax/grammar.mly

@@ -1,176 +1,7 @@
-(*
-	The Haxe Compiler
-	Copyright (C) 2005-2017  Haxe Foundation
-
-	This program is free software; you can redistribute it and/or
-	modify it under the terms of the GNU General Public License
-	as published by the Free Software Foundation; either version 2
-	of the License, or (at your option) any later version.
-
-	This program 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 General Public License for more details.
-
-	You should have received a copy of the GNU General Public License
-	along with this program; if not, write to the Free Software
-	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
- *)
-
-open Ast
 open Globals
+open Ast
 open Reification
-
-type error_msg =
-	| Unexpected of token
-	| Duplicate_default
-	| Missing_semicolon
-	| Unclosed_macro
-	| Unimplemented
-	| Missing_type
-	| Custom of string
-
-exception Error of error_msg * pos
-exception TypePath of string list * (string * bool) option * bool (* in import *)
-exception Display of expr
-
-let error_msg = function
-	| Unexpected t -> "Unexpected "^(s_token t)
-	| Duplicate_default -> "Duplicate default"
-	| Missing_semicolon -> "Missing ;"
-	| Unclosed_macro -> "Unclosed macro"
-	| Unimplemented -> "Not implemented for current platform"
-	| Missing_type -> "Missing type declaration"
-	| Custom s -> s
-
-let error m p = raise (Error (m,p))
-let display_error : (error_msg -> pos -> unit) ref = ref (fun _ _ -> assert false)
-
-type decl_flag =
-	| DPrivate
-	| DExtern
-
-let decl_flag_to_class_flag = function
-	| DPrivate -> HPrivate
-	| DExtern -> HExtern
-
-let decl_flag_to_enum_flag = function
-	| DPrivate -> EPrivate
-	| DExtern -> EExtern
-
-let decl_flag_to_abstract_flag = function
-	| DPrivate -> APrivAbstract
-	| DExtern -> AExtern
-
-let special_identifier_files = Hashtbl.create 0
-
-module TokenCache = struct
-	let cache = ref (DynArray.create ())
-	let add token = DynArray.add (!cache) token
-	let get index = DynArray.get (!cache) index
-	let clear () =
-		let old_cache = !cache in
-		cache := DynArray.create ();
-		(fun () -> cache := old_cache)
-end
-
-let last_doc = ref None
-let use_doc = ref false
-let resume_display = ref null_pos
-let in_macro = ref false
-
-let last_token s =
-	let n = Stream.count s in
-	TokenCache.get (if n = 0 then 0 else n - 1)
-
-let serror() = raise (Stream.Error "")
-
-let do_resume() = !resume_display <> null_pos
-
-let display e = raise (Display e)
-
-let type_path sl in_import = match sl with
-	| n :: l when n.[0] >= 'A' && n.[0] <= 'Z' -> raise (TypePath (List.rev l,Some (n,false),in_import));
-	| _ -> raise (TypePath (List.rev sl,None,in_import))
-
-let is_resuming_file file =
-	Path.unique_full_path file = !resume_display.pfile
-
-let is_resuming p =
-	let p2 = !resume_display in
-	p.pmax = p2.pmin && is_resuming_file p.pfile
-
-let set_resume p =
-	resume_display := { p with pfile = Path.unique_full_path p.pfile }
-
-let is_dollar_ident e = match fst e with
-	| EConst (Ident n) when n.[0] = '$' ->
-		true
-	| _ ->
-		false
-
-let precedence op =
-	let left = true and right = false in
-	match op with
-	| OpIn -> 0, right
-	| OpMod -> 1, left
-	| OpMult | OpDiv -> 2, left
-	| OpAdd | OpSub -> 3, left
-	| OpShl | OpShr | OpUShr -> 4, left
-	| OpOr | OpAnd | OpXor -> 5, left
-	| OpEq | OpNotEq | OpGt | OpLt | OpGte | OpLte -> 6, left
-	| OpInterval -> 7, left
-	| OpBoolAnd -> 8, left
-	| OpBoolOr -> 9, left
-	| OpArrow -> 10, right
-	| OpAssign | OpAssignOp _ -> 11, right
-
-let is_not_assign = function
-	| OpAssign | OpAssignOp _ -> false
-	| _ -> true
-
-let swap op1 op2 =
-	let p1, left1 = precedence op1 in
-	let p2, _ = precedence op2 in
-	left1 && p1 <= p2
-
-let rec make_binop op e ((v,p2) as e2) =
-	match v with
-	| EBinop (_op,_e,_e2) when swap op _op ->
-		let _e = make_binop op e _e in
-		EBinop (_op,_e,_e2) , punion (pos _e) (pos _e2)
-	| ETernary (e1,e2,e3) when is_not_assign op ->
-		let e = make_binop op e e1 in
-		ETernary (e,e2,e3) , punion (pos e) (pos e3)
-	| _ ->
-		EBinop (op,e,e2) , punion (pos e) (pos e2)
-
-let rec make_unop op ((v,p2) as e) p1 =
-	let neg s =
-		if s.[0] = '-' then String.sub s 1 (String.length s - 1) else "-" ^ s
-	in
-	match v with
-	| EBinop (bop,e,e2) -> EBinop (bop, make_unop op e p1 , e2) , (punion p1 p2)
-	| ETernary (e1,e2,e3) -> ETernary (make_unop op e1 p1 , e2, e3), punion p1 p2
-	| EConst (Int i) when op = Neg -> EConst (Int (neg i)),punion p1 p2
-	| EConst (Float j) when op = Neg -> EConst (Float (neg j)),punion p1 p2
-	| _ -> EUnop (op,Prefix,e), punion p1 p2
-
-let rec make_meta name params ((v,p2) as e) p1 =
-	match v with
-	| EBinop ((OpAssign | OpAssignOp _),_,_) -> EMeta((name,params,p1),e),punion p1 p2
-	| EBinop (bop,e,e2) -> EBinop (bop, make_meta name params e p1 , e2) , (punion p1 p2)
-	| ETernary (e1,e2,e3) -> ETernary (make_meta name params e1 p1 , e2, e3), punion p1 p2
-	| _ -> EMeta((name,params,p1),e),punion p1 p2
-
-let make_is e (t,p_t) p p_is =
-	let e_is = EField((EConst(Ident "Std"),null_pos),"is"),p_is in
-	let e2 = expr_of_type_path (t.tpackage,t.tname) p_t in
-	ECall(e_is,[e;e2]),p
-
-let next_token s = match Stream.peek s with
-	| Some tk -> tk
-	| _ -> last_token s
+open Parser
 
 let popt f = parser
 	| [< v = f >] -> Some v
@@ -213,17 +44,6 @@ let property_ident = parser
 	| [< '(Kwd Default,p) >] -> "default",p
 	| [< '(Kwd Null,p) >] -> "null",p
 
-let get_doc s =
-	(* do the peek first to make sure we fetch the doc *)
-	match Stream.peek s with
-	| None -> None
-	| Some (tk,p) ->
-		match !last_doc with
-		| None -> None
-		| Some (d,pos) ->
-			last_doc := None;
-			if pos = p.pmin then Some d else None
-
 let comma = parser
 	| [< '(Comma,_) >] -> ()
 
@@ -239,16 +59,6 @@ let semicolon s =
 			let pos = snd (last_token s) in
 			if do_resume() then pos else error Missing_semicolon pos
 
-let encloses_resume p =
-	p.pmin <= !resume_display.pmin && p.pmax >= !resume_display.pmax
-
-let would_skip_resume p1 s =
-	match Stream.npeek 1 s with
-	| [ (_,p2) ] ->
-		is_resuming_file p2.pfile && encloses_resume (punion p1 p2)
-	| _ ->
-		false
-
 let rec	parse_file s =
 	last_doc := None;
 	match s with parser
@@ -1293,193 +1103,4 @@ and toplevel_expr s =
 and secure_expr s =
 	match s with parser
 	| [< e = expr >] -> e
-	| [< >] -> serror()
-
-(* eval *)
-type small_type =
-	| TNull
-	| TBool of bool
-	| TFloat of float
-	| TString of string
-
-let is_true = function
-	| TBool false | TNull | TFloat 0. | TString "" -> false
-	| _ -> true
-
-let cmp v1 v2 =
-	match v1, v2 with
-	| TNull, TNull -> 0
-	| TFloat a, TFloat b -> compare a b
-	| TString a, TString b -> compare a b
-	| TBool a, TBool b -> compare a b
-	| TString a, TFloat b -> compare (float_of_string a) b
-	| TFloat a, TString b -> compare a (float_of_string b)
-	| _ -> raise Exit (* always false *)
-
-let rec eval ctx (e,p) =
-	match e with
-	| EConst (Ident i) ->
-		(try TString (Define.raw_defined_value ctx i) with Not_found -> TNull)
-	| EConst (String s) -> TString s
-	| EConst (Int i) -> TFloat (float_of_string i)
-	| EConst (Float f) -> TFloat (float_of_string f)
-	| EBinop (OpBoolAnd, e1, e2) -> TBool (is_true (eval ctx e1) && is_true (eval ctx e2))
-	| EBinop (OpBoolOr, e1, e2) -> TBool (is_true (eval ctx e1) || is_true(eval ctx e2))
-	| EUnop (Not, _, e) -> TBool (not (is_true (eval ctx e)))
-	| EParenthesis e -> eval ctx e
-	| EBinop (op, e1, e2) ->
-		let v1 = eval ctx e1 in
-		let v2 = eval ctx e2 in
-		let compare op =
-			TBool (try op (cmp v1 v2) 0 with _ -> false)
-		in
-		(match op with
-		| OpEq -> compare (=)
-		| OpNotEq -> compare (<>)
-		| OpGt -> compare (>)
-		| OpGte -> compare (>=)
-		| OpLt -> compare (<)
-		| OpLte -> compare (<=)
-		| _ -> error (Custom "Unsupported operation") p)
-	| _ ->
-		error (Custom "Invalid condition expression") p
-
-(* parse main *)
-let parse ctx code =
-	let old = Lexer.save() in
-	let restore_cache = TokenCache.clear () in
-	let mstack = ref [] in
-	last_doc := None;
-	in_macro := Define.defined ctx Define.Macro;
-	Lexer.skip_header code;
-
-	let sraw = Stream.from (fun _ -> Some (Lexer.token code)) in
-	let rec next_token() = process_token (Lexer.token code)
-
-	and process_token tk =
-		match fst tk with
-		| Comment s ->
-			let tk = next_token() in
-			if !use_doc then begin
-				let l = String.length s in
-				if l > 0 && s.[0] = '*' then last_doc := Some (String.sub s 1 (l - (if l > 1 && s.[l-1] = '*' then 2 else 1)), (snd tk).pmin);
-			end;
-			tk
-		| CommentLine s ->
-			next_token()
-		| Sharp "end" ->
-			(match !mstack with
-			| [] -> tk
-			| _ :: l ->
-				mstack := l;
-				next_token())
-		| Sharp "else" | Sharp "elseif" ->
-			(match !mstack with
-			| [] -> tk
-			| _ :: l ->
-				mstack := l;
-				process_token (skip_tokens (snd tk) false))
-		| Sharp "if" ->
-			process_token (enter_macro (snd tk))
-		| Sharp "error" ->
-			(match Lexer.token code with
-			| (Const (String s),p) -> error (Custom s) p
-			| _ -> error Unimplemented (snd tk))
-		| Sharp "line" ->
-			let line = (match next_token() with
-				| (Const (Int s),p) -> (try int_of_string s with _ -> error (Custom ("Could not parse ridiculous line number " ^ s)) p)
-				| (t,p) -> error (Unexpected t) p
-			) in
-			!(Lexer.cur).Lexer.lline <- line - 1;
-			next_token();
-		| _ ->
-			tk
-
-	and enter_macro p =
-		let tk, e = parse_macro_cond false sraw in
-		let tk = (match tk with None -> Lexer.token code | Some tk -> tk) in
-		if is_true (eval ctx e) || (match fst e with EConst (Ident "macro") when Path.unique_full_path p.pfile = (!resume_display).pfile -> true | _ -> false) then begin
-			mstack := p :: !mstack;
-			tk
-		end else
-			skip_tokens_loop p true tk
-
-	and skip_tokens_loop p test tk =
-		match fst tk with
-		| Sharp "end" ->
-			Lexer.token code
-		| Sharp "elseif" | Sharp "else" when not test ->
-			skip_tokens p test
-		| Sharp "else" ->
-			mstack := snd tk :: !mstack;
-			Lexer.token code
-		| Sharp "elseif" ->
-			enter_macro (snd tk)
-		| Sharp "if" ->
-			skip_tokens_loop p test (skip_tokens p false)
-		| Eof ->
-			if do_resume() then tk else error Unclosed_macro p
-		| _ ->
-			skip_tokens p test
-
-	and skip_tokens p test = skip_tokens_loop p test (Lexer.token code)
-
-	in
-	let s = Stream.from (fun _ ->
-		let t = next_token() in
-		TokenCache.add t;
-		Some t
-	) in
-	try
-		let l = parse_file s in
-		(match !mstack with p :: _ when not (do_resume()) -> error Unclosed_macro p | _ -> ());
-		restore_cache ();
-		Lexer.restore old;
-		l
-	with
-		| Stream.Error _
-		| Stream.Failure ->
-			let last = (match Stream.peek s with None -> last_token s | Some t -> t) in
-			Lexer.restore old;
-			restore_cache ();
-			error (Unexpected (fst last)) (pos last)
-		| e ->
-			Lexer.restore old;
-			restore_cache ();
-			raise e
-
-let parse_string com s p error inlined =
-	let old = Lexer.save() in
-	let old_file = (try Some (Hashtbl.find Lexer.all_files p.pfile) with Not_found -> None) in
-	let old_display = !resume_display in
-	let old_de = !display_error in
-	let restore() =
-		(match old_file with
-		| None -> ()
-		| Some f -> Hashtbl.replace Lexer.all_files p.pfile f);
-		if not inlined then resume_display := old_display;
-		Lexer.restore old;
-		display_error := old_de
-	in
-	Lexer.init p.pfile true;
-	display_error := (fun e p -> raise (Error (e,p)));
-	if not inlined then resume_display := null_pos;
-	let pack, decls = try
-		parse com (Sedlexing.Utf8.from_string s)
-	with Error (e,pe) ->
-		restore();
-		error (error_msg e) (if inlined then pe else p)
-	| Lexer.Error (e,pe) ->
-		restore();
-		error (Lexer.error_msg e) (if inlined then pe else p)
-	in
-	restore();
-	pack,decls
-
-let parse_expr_string com s p error inl =
-	let head = "class X{static function main() " in
-	let head = (if p.pmin > String.length head then head ^ String.make (p.pmin - String.length head) ' ' else head) in
-	let rec loop e = let e = Ast.map_expr loop e in (fst e,p) in
-	match parse_string com (head ^ s ^ ";}") p error inl with
-	| _,[EClass { d_data = [{ cff_name = "main",null_pos; cff_kind = FFun { f_expr = Some e } }]},_] -> if inl then e else loop e
-	| _ -> raise Exit
+	| [< >] -> serror()

src/syntax/parser.ml

@@ -0,0 +1,194 @@
+(*
+	The Haxe Compiler
+	Copyright (C) 2005-2017  Haxe Foundation
+
+	This program is free software; you can redistribute it and/or
+	modify it under the terms of the GNU General Public License
+	as published by the Free Software Foundation; either version 2
+	of the License, or (at your option) any later version.
+
+	This program 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 General Public License for more details.
+
+	You should have received a copy of the GNU General Public License
+	along with this program; if not, write to the Free Software
+	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+
+open Ast
+open Globals
+open Reification
+
+type error_msg =
+	| Unexpected of token
+	| Duplicate_default
+	| Missing_semicolon
+	| Unclosed_macro
+	| Unimplemented
+	| Missing_type
+	| Custom of string
+
+exception Error of error_msg * pos
+exception TypePath of string list * (string * bool) option * bool (* in import *)
+exception Display of expr
+
+let error_msg = function
+	| Unexpected t -> "Unexpected "^(s_token t)
+	| Duplicate_default -> "Duplicate default"
+	| Missing_semicolon -> "Missing ;"
+	| Unclosed_macro -> "Unclosed macro"
+	| Unimplemented -> "Not implemented for current platform"
+	| Missing_type -> "Missing type declaration"
+	| Custom s -> s
+
+let error m p = raise (Error (m,p))
+let display_error : (error_msg -> pos -> unit) ref = ref (fun _ _ -> assert false)
+
+let special_identifier_files : (string,string) Hashtbl.t = Hashtbl.create 0
+
+type decl_flag =
+	| DPrivate
+	| DExtern
+
+let decl_flag_to_class_flag = function
+	| DPrivate -> HPrivate
+	| DExtern -> HExtern
+
+let decl_flag_to_enum_flag = function
+	| DPrivate -> EPrivate
+	| DExtern -> EExtern
+
+let decl_flag_to_abstract_flag = function
+	| DPrivate -> APrivAbstract
+	| DExtern -> AExtern
+
+module TokenCache = struct
+	let cache = ref (DynArray.create ())
+	let add (token : (token * pos)) = DynArray.add (!cache) token
+	let get index = DynArray.get (!cache) index
+	let clear () =
+		let old_cache = !cache in
+		cache := DynArray.create ();
+		(fun () -> cache := old_cache)
+end
+
+let last_doc : (string * int) option ref = ref None
+let use_doc = ref false
+let resume_display = ref null_pos
+let in_macro = ref false
+
+let last_token s =
+	let n = Stream.count s in
+	TokenCache.get (if n = 0 then 0 else n - 1)
+
+let get_doc s =
+	(* do the peek first to make sure we fetch the doc *)
+	match Stream.peek s with
+	| None -> None
+	| Some (tk,p) ->
+		match !last_doc with
+		| None -> None
+		| Some (d,pos) ->
+			last_doc := None;
+			if pos = p.pmin then Some d else None
+
+let serror() = raise (Stream.Error "")
+
+let do_resume() = !resume_display <> null_pos
+
+let display e = raise (Display e)
+
+let type_path sl in_import = match sl with
+	| n :: l when n.[0] >= 'A' && n.[0] <= 'Z' -> raise (TypePath (List.rev l,Some (n,false),in_import));
+	| _ -> raise (TypePath (List.rev sl,None,in_import))
+
+let is_resuming_file file =
+	Path.unique_full_path file = !resume_display.pfile
+
+let is_resuming p =
+	let p2 = !resume_display in
+	p.pmax = p2.pmin && is_resuming_file p.pfile
+
+let set_resume p =
+	resume_display := { p with pfile = Path.unique_full_path p.pfile }
+
+let encloses_resume p =
+	p.pmin <= !resume_display.pmin && p.pmax >= !resume_display.pmax
+
+let would_skip_resume p1 s =
+	match Stream.npeek 1 s with
+	| [ (_,p2) ] ->
+		is_resuming_file p2.pfile && encloses_resume (punion p1 p2)
+	| _ ->
+		false
+
+let is_dollar_ident e = match fst e with
+	| EConst (Ident n) when n.[0] = '$' ->
+		true
+	| _ ->
+		false
+
+let precedence op =
+	let left = true and right = false in
+	match op with
+	| OpIn -> 0, right
+	| OpMod -> 1, left
+	| OpMult | OpDiv -> 2, left
+	| OpAdd | OpSub -> 3, left
+	| OpShl | OpShr | OpUShr -> 4, left
+	| OpOr | OpAnd | OpXor -> 5, left
+	| OpEq | OpNotEq | OpGt | OpLt | OpGte | OpLte -> 6, left
+	| OpInterval -> 7, left
+	| OpBoolAnd -> 8, left
+	| OpBoolOr -> 9, left
+	| OpArrow -> 10, right
+	| OpAssign | OpAssignOp _ -> 11, right
+
+let is_not_assign = function
+	| OpAssign | OpAssignOp _ -> false
+	| _ -> true
+
+let swap op1 op2 =
+	let p1, left1 = precedence op1 in
+	let p2, _ = precedence op2 in
+	left1 && p1 <= p2
+
+let rec make_binop op e ((v,p2) as e2) =
+	match v with
+	| EBinop (_op,_e,_e2) when swap op _op ->
+		let _e = make_binop op e _e in
+		EBinop (_op,_e,_e2) , punion (pos _e) (pos _e2)
+	| ETernary (e1,e2,e3) when is_not_assign op ->
+		let e = make_binop op e e1 in
+		ETernary (e,e2,e3) , punion (pos e) (pos e3)
+	| _ ->
+		EBinop (op,e,e2) , punion (pos e) (pos e2)
+
+let rec make_unop op ((v,p2) as e) p1 =
+	let neg s =
+		if s.[0] = '-' then String.sub s 1 (String.length s - 1) else "-" ^ s
+	in
+	match v with
+	| EBinop (bop,e,e2) -> EBinop (bop, make_unop op e p1 , e2) , (punion p1 p2)
+	| ETernary (e1,e2,e3) -> ETernary (make_unop op e1 p1 , e2, e3), punion p1 p2
+	| EConst (Int i) when op = Neg -> EConst (Int (neg i)),punion p1 p2
+	| EConst (Float j) when op = Neg -> EConst (Float (neg j)),punion p1 p2
+	| _ -> EUnop (op,Prefix,e), punion p1 p2
+
+let rec make_meta name params ((v,p2) as e) p1 =
+	match v with
+	| EBinop ((OpAssign | OpAssignOp _),_,_) -> EMeta((name,params,p1),e),punion p1 p2
+	| EBinop (bop,e,e2) -> EBinop (bop, make_meta name params e p1 , e2) , (punion p1 p2)
+	| ETernary (e1,e2,e3) -> ETernary (make_meta name params e1 p1 , e2, e3), punion p1 p2
+	| _ -> EMeta((name,params,p1),e),punion p1 p2
+
+let make_is e (t,p_t) p p_is =
+	let e_is = EField((EConst(Ident "Std"),null_pos),"is"),p_is in
+	let e2 = expr_of_type_path (t.tpackage,t.tname) p_t in
+	ECall(e_is,[e;e2]),p
+
+let next_token s = match Stream.peek s with
+	| Some tk -> tk
+	| _ -> last_token s

src/syntax/parserEntry.ml

@@ -0,0 +1,193 @@
+open Globals
+open Ast
+open Parser
+open Grammar
+
+(* eval *)
+type small_type =
+	| TNull
+	| TBool of bool
+	| TFloat of float
+	| TString of string
+
+let is_true = function
+	| TBool false | TNull | TFloat 0. | TString "" -> false
+	| _ -> true
+
+let cmp v1 v2 =
+	match v1, v2 with
+	| TNull, TNull -> 0
+	| TFloat a, TFloat b -> compare a b
+	| TString a, TString b -> compare a b
+	| TBool a, TBool b -> compare a b
+	| TString a, TFloat b -> compare (float_of_string a) b
+	| TFloat a, TString b -> compare a (float_of_string b)
+	| _ -> raise Exit (* always false *)
+
+let rec eval ctx (e,p) =
+	match e with
+	| EConst (Ident i) ->
+		(try TString (Define.raw_defined_value ctx i) with Not_found -> TNull)
+	| EConst (String s) -> TString s
+	| EConst (Int i) -> TFloat (float_of_string i)
+	| EConst (Float f) -> TFloat (float_of_string f)
+	| EBinop (OpBoolAnd, e1, e2) -> TBool (is_true (eval ctx e1) && is_true (eval ctx e2))
+	| EBinop (OpBoolOr, e1, e2) -> TBool (is_true (eval ctx e1) || is_true(eval ctx e2))
+	| EUnop (Not, _, e) -> TBool (not (is_true (eval ctx e)))
+	| EParenthesis e -> eval ctx e
+	| EBinop (op, e1, e2) ->
+		let v1 = eval ctx e1 in
+		let v2 = eval ctx e2 in
+		let compare op =
+			TBool (try op (cmp v1 v2) 0 with _ -> false)
+		in
+		(match op with
+		| OpEq -> compare (=)
+		| OpNotEq -> compare (<>)
+		| OpGt -> compare (>)
+		| OpGte -> compare (>=)
+		| OpLt -> compare (<)
+		| OpLte -> compare (<=)
+		| _ -> error (Custom "Unsupported operation") p)
+	| _ ->
+		error (Custom "Invalid condition expression") p
+
+(* parse main *)
+let parse ctx code =
+	let old = Lexer.save() in
+	let restore_cache = TokenCache.clear () in
+	let mstack = ref [] in
+	last_doc := None;
+	in_macro := Define.defined ctx Define.Macro;
+	Lexer.skip_header code;
+
+	let sraw = Stream.from (fun _ -> Some (Lexer.token code)) in
+	let rec next_token() = process_token (Lexer.token code)
+
+	and process_token tk =
+		match fst tk with
+		| Comment s ->
+			let tk = next_token() in
+			if !use_doc then begin
+				let l = String.length s in
+				if l > 0 && s.[0] = '*' then last_doc := Some (String.sub s 1 (l - (if l > 1 && s.[l-1] = '*' then 2 else 1)), (snd tk).pmin);
+			end;
+			tk
+		| CommentLine s ->
+			next_token()
+		| Sharp "end" ->
+			(match !mstack with
+			| [] -> tk
+			| _ :: l ->
+				mstack := l;
+				next_token())
+		| Sharp "else" | Sharp "elseif" ->
+			(match !mstack with
+			| [] -> tk
+			| _ :: l ->
+				mstack := l;
+				process_token (skip_tokens (snd tk) false))
+		| Sharp "if" ->
+			process_token (enter_macro (snd tk))
+		| Sharp "error" ->
+			(match Lexer.token code with
+			| (Const (String s),p) -> error (Custom s) p
+			| _ -> error Unimplemented (snd tk))
+		| Sharp "line" ->
+			let line = (match next_token() with
+				| (Const (Int s),p) -> (try int_of_string s with _ -> error (Custom ("Could not parse ridiculous line number " ^ s)) p)
+				| (t,p) -> error (Unexpected t) p
+			) in
+			!(Lexer.cur).Lexer.lline <- line - 1;
+			next_token();
+		| _ ->
+			tk
+
+	and enter_macro p =
+		let tk, e = parse_macro_cond false sraw in
+		let tk = (match tk with None -> Lexer.token code | Some tk -> tk) in
+		if is_true (eval ctx e) || (match fst e with EConst (Ident "macro") when Path.unique_full_path p.pfile = (!resume_display).pfile -> true | _ -> false) then begin
+			mstack := p :: !mstack;
+			tk
+		end else
+			skip_tokens_loop p true tk
+
+	and skip_tokens_loop p test tk =
+		match fst tk with
+		| Sharp "end" ->
+			Lexer.token code
+		| Sharp "elseif" | Sharp "else" when not test ->
+			skip_tokens p test
+		| Sharp "else" ->
+			mstack := snd tk :: !mstack;
+			Lexer.token code
+		| Sharp "elseif" ->
+			enter_macro (snd tk)
+		| Sharp "if" ->
+			skip_tokens_loop p test (skip_tokens p false)
+		| Eof ->
+			if do_resume() then tk else error Unclosed_macro p
+		| _ ->
+			skip_tokens p test
+
+	and skip_tokens p test = skip_tokens_loop p test (Lexer.token code)
+
+	in
+	let s = Stream.from (fun _ ->
+		let t = next_token() in
+		TokenCache.add t;
+		Some t
+	) in
+	try
+		let l = parse_file s in
+		(match !mstack with p :: _ when not (do_resume()) -> error Unclosed_macro p | _ -> ());
+		restore_cache ();
+		Lexer.restore old;
+		l
+	with
+		| Stream.Error _
+		| Stream.Failure ->
+			let last = (match Stream.peek s with None -> last_token s | Some t -> t) in
+			Lexer.restore old;
+			restore_cache ();
+			error (Unexpected (fst last)) (pos last)
+		| e ->
+			Lexer.restore old;
+			restore_cache ();
+			raise e
+
+let parse_string com s p error inlined =
+	let old = Lexer.save() in
+	let old_file = (try Some (Hashtbl.find Lexer.all_files p.pfile) with Not_found -> None) in
+	let old_display = !resume_display in
+	let old_de = !display_error in
+	let restore() =
+		(match old_file with
+		| None -> ()
+		| Some f -> Hashtbl.replace Lexer.all_files p.pfile f);
+		if not inlined then resume_display := old_display;
+		Lexer.restore old;
+		display_error := old_de
+	in
+	Lexer.init p.pfile true;
+	display_error := (fun e p -> raise (Error (e,p)));
+	if not inlined then resume_display := null_pos;
+	let pack, decls = try
+		parse com (Sedlexing.Utf8.from_string s)
+	with Error (e,pe) ->
+		restore();
+		error (error_msg e) (if inlined then pe else p)
+	| Lexer.Error (e,pe) ->
+		restore();
+		error (Lexer.error_msg e) (if inlined then pe else p)
+	in
+	restore();
+	pack,decls
+
+let parse_expr_string com s p error inl =
+	let head = "class X{static function main() " in
+	let head = (if p.pmin > String.length head then head ^ String.make (p.pmin - String.length head) ' ' else head) in
+	let rec loop e = let e = Ast.map_expr loop e in (fst e,p) in
+	match parse_string com (head ^ s ^ ";}") p error inl with
+	| _,[EClass { d_data = [{ cff_name = "main",null_pos; cff_kind = FFun { f_expr = Some e } }]},_] -> if inl then e else loop e
+	| _ -> raise Exit

src/typing/macroContext.ml

@@ -120,7 +120,7 @@ let load_macro_ref : (typer -> bool -> path -> string -> pos -> (typer * ((strin
 
 let make_macro_api ctx p =
 	let parse_expr_string s p inl =
-		typing_timer ctx false (fun() -> try Parser.parse_expr_string ctx.com.defines s p error inl with Exit -> raise MacroApi.Invalid_expr)
+		typing_timer ctx false (fun() -> try ParserEntry.parse_expr_string ctx.com.defines s p error inl with Exit -> raise MacroApi.Invalid_expr)
 	in
 	{
 		MacroApi.pos = p;
@@ -209,7 +209,7 @@ let make_macro_api ctx p =
 		MacroApi.type_patch = (fun t f s v ->
 			typing_timer ctx false (fun() ->
 				let v = (match v with None -> None | Some s ->
-					match Parser.parse_string ctx.com.defines ("typedef T = " ^ s) null_pos error false with
+					match ParserEntry.parse_string ctx.com.defines ("typedef T = " ^ s) null_pos error false with
 					| _,[ETypedef { d_data = ct },_] -> Some ct
 					| _ -> assert false
 				) in
@@ -220,7 +220,7 @@ let make_macro_api ctx p =
 			);
 		);
 		MacroApi.meta_patch = (fun m t f s ->
-			let m = (match Parser.parse_string ctx.com.defines (m ^ " typedef T = T") null_pos error false with
+			let m = (match ParserEntry.parse_string ctx.com.defines (m ^ " typedef T = T") null_pos error false with
 				| _,[ETypedef t,_] -> t.d_meta
 				| _ -> assert false
 			) in
@@ -353,7 +353,7 @@ let make_macro_api ctx p =
 			)
 		);
 		MacroApi.add_global_metadata = (fun s1 s2 config ->
-			let meta = (match Parser.parse_string ctx.com.defines (s2 ^ " typedef T = T") null_pos error false with
+			let meta = (match ParserEntry.parse_string ctx.com.defines (s2 ^ " typedef T = T") null_pos error false with
 				| _,[ETypedef t,_] -> t.d_meta
 				| _ -> assert false
 			) in
@@ -757,7 +757,7 @@ let call_macro ctx path meth args p =
 let call_init_macro ctx e =
 	let p = { pfile = "--macro"; pmin = 0; pmax = 0 } in
 	let e = try
-		Parser.parse_expr_string ctx.com.defines e p error false
+		ParserEntry.parse_expr_string ctx.com.defines e p error false
 	with err ->
 		display_error ctx ("Could not parse `" ^ e ^ "`") p;
 		raise err

src/typing/typeload.ml

@@ -244,7 +244,7 @@ let parse_file_from_lexbuf com file p lexbuf =
 	Lexer.init file true;
 	incr stats.s_files_parsed;
 	let data = try
-		Parser.parse com.defines lexbuf
+		ParserEntry.parse com.defines lexbuf
 	with
 		| Sedlexing.MalFormed ->
 			t();
@@ -2819,7 +2819,7 @@ module ClassInitializer = struct
 							| EBinop ((OpEq|OpNotEq|OpGt|OpGte|OpLt|OpLte) as op,(EConst (Ident s),_),(EConst ((Int _ | Float _ | String _) as c),_)) -> s ^ s_binop op ^ s_constant c
 							| _ -> ""
 						in
-						if not (Parser.is_true (Parser.eval ctx.com.defines e)) then
+						if not (ParserEntry.is_true (ParserEntry.eval ctx.com.defines e)) then
 							Some (sc,(match List.rev l with (EConst (String msg),_) :: _ -> Some msg | _ -> None))
 						else
 							loop l

src/typing/typer.ml

@@ -2861,7 +2861,7 @@ and format_string ctx s p =
 		if warn_escape then warn (pos + 1) slen;
 		min := !min + 2;
 		if slen > 0 then
-			add_expr (Parser.parse_expr_string ctx.com.defines scode { p with pmin = !pmin + pos + 2; pmax = !pmin + send + 1 } error true) slen;
+			add_expr (ParserEntry.parse_expr_string ctx.com.defines scode { p with pmin = !pmin + pos + 2; pmax = !pmin + send + 1 } error true) slen;
 		min := !min + 1;
 		parse (send + 1) (send + 1)
 	in