Browse Source

make AST printing functions accessible

Simon Krajewski 6 years ago
parent
commit
5bd4b81703

+ 1 - 1
src/codegen/codegen.ml

@@ -289,7 +289,7 @@ module Dump = struct
 				let args el =
 					match el with
 					| [] -> ""
-					| el -> Printf.sprintf "(%s)" (String.concat ", " (List.map (fun e -> Ast.s_expr e) el)) in
+					| el -> Printf.sprintf "(%s)" (String.concat ", " (List.map (fun e -> Ast.Printer.s_expr e) el)) in
 				match ml with
 				| [] -> ""
 				| ml -> String.concat " " (List.map (fun me -> match me with (m,el,_) -> "@" ^ Meta.to_string m ^ args el) ml) ^ "\n" ^ tabs in

+ 3 - 3
src/codegen/genxml.ml

@@ -86,7 +86,7 @@ let gen_meta meta =
 	| [] -> []
 	| _ ->
 		let nodes = List.map (fun (m,el,_) ->
-			node "m" ["n",Meta.to_string m] (List.map (fun e -> node "e" [] [gen_string (Ast.s_expr e)]) el)
+			node "m" ["n",Meta.to_string m] (List.map (fun e -> node "e" [] [gen_string (Ast.Printer.s_expr e)]) el)
 		) meta in
 		[node "meta" [] nodes]
 
@@ -107,7 +107,7 @@ let rec gen_type ?(values=None) t =
 					try
 						let e = PMap.find n values in
 						has_value := true;
-						let s = Ast.s_expr e in
+						let s = Ast.Printer.s_expr e in
 						s
 					with Not_found ->
 						""
@@ -142,7 +142,7 @@ and gen_field att f =
 		| Var v ->
 			let att = try
 				begin match Meta.get Meta.Value f.cf_meta with
-					| (_,[e],_) -> ("expr",Ast.s_expr e) :: att
+					| (_,[e],_) -> ("expr",Ast.Printer.s_expr e) :: att
 					| _ -> att
 				end
 			with Not_found ->

+ 4 - 2
src/core/ast.ml

@@ -718,7 +718,7 @@ let s_display_kind = function
 	| DKMarked -> "DKMarked"
 	| DKPattern _ -> "DKPattern"
 
-let s_expr e =
+module Printer = struct
 	let rec s_expr_inner tabs (e,_) =
 		match e with
 		| EConst c -> s_constant c
@@ -833,7 +833,9 @@ let s_expr e =
 		| (EBlock [],_) -> ""
 		| (EBlock el,_) -> s_block (tabs ^ "\t") el "" "" ""
 		| _ -> s_expr_inner (tabs ^ "\t") e ^ ";"
-	in s_expr_inner "" e
+
+	let s_expr e = s_expr_inner "" e
+end
 
 let get_value_meta meta =
 	try

+ 1 - 1
src/core/display/completionItem.ml

@@ -371,7 +371,7 @@ module CompletionType = struct
 		"opt",jbool cfa.ct_optional;
 		"t",generate_type ctx cfa.ct_type;
 		"value",jopt (fun e -> jobject [
-			"string",jstring (Ast.s_expr e);
+			"string",jstring (Ast.Printer.s_expr e);
 		]) cfa.ct_value;
 	]
 

+ 1 - 1
src/core/error.ml

@@ -145,7 +145,7 @@ module BetterErrors = struct
 			s_type_path e.e_path ^ s_type_params ctx tl
 		| TInst (c,tl) ->
 			(match c.cl_kind with
-			| KExpr e -> Ast.s_expr e
+			| KExpr e -> Ast.Printer.s_expr e
 			| _ -> s_type_path c.cl_path ^ s_type_params ctx tl)
 		| TType (t,tl) ->
 			s_type_path t.t_path ^ s_type_params ctx tl

+ 1 - 1
src/core/json/genjson.ml

@@ -520,7 +520,7 @@ and generate_class_field' ctx cfs cf =
 			in
 			begin match value with
 				| None -> jnull
-				| Some e -> jobject ["string",jstring (Ast.s_expr e)]
+				| Some e -> jobject ["string",jstring (Ast.Printer.s_expr e)]
 			end
 		| GMMinimum ->
 			jnull

+ 1 - 1
src/core/texpr.ml

@@ -47,7 +47,7 @@ let rec equal e1 e2 = match e1.eexpr,e2.eexpr with
 	| TThrow e1,TThrow e2 -> equal e1 e2
 	| TCast(e1,None),TCast(e2,None) -> equal e1 e2
 	| TCast(e1,Some mt1),TCast(e2,Some mt2) -> equal e1 e2 && mt1 == mt2
-	| TMeta((m1,el1,_),e1),TMeta((m2,el2,_),e2) -> m1 = m2 && safe_for_all2 (fun e1 e2 -> (* TODO: cheating? *) (Ast.s_expr e1) = (Ast.s_expr e2)) el1 el2 && equal e1 e2
+	| TMeta((m1,el1,_),e1),TMeta((m2,el2,_),e2) -> m1 = m2 && safe_for_all2 (fun e1 e2 -> (* TODO: cheating? *) (Ast.Printer.s_expr e1) = (Ast.Printer.s_expr e2)) el1 el2 && equal e1 e2
 	| (TBreak,TBreak) | (TContinue,TContinue) -> true
 	| TEnumParameter(e1,ef1,i1),TEnumParameter(e2,ef2,i2) -> equal e1 e2 && ef1 == ef2 && i1 = i2
 	| _ -> false

+ 5 - 5
src/core/type.ml

@@ -1029,7 +1029,7 @@ let rec s_type ctx t =
 		s_type_path e.e_path ^ s_type_params ctx tl
 	| TInst (c,tl) ->
 		(match c.cl_kind with
-		| KExpr e -> Ast.s_expr e
+		| KExpr e -> Ast.Printer.s_expr e
 		| _ -> s_type_path c.cl_path ^ s_type_params ctx tl)
 	| TType (t,tl) ->
 		s_type_path t.t_path ^ s_type_params ctx tl
@@ -1220,7 +1220,7 @@ let rec s_expr s_type e =
 	| TCast (e,t) ->
 		sprintf "Cast %s%s" (match t with None -> "" | Some t -> s_type_path (t_path t) ^ ": ") (loop e)
 	| TMeta ((n,el,_),e) ->
-		sprintf "@%s%s %s" (Meta.to_string n) (match el with [] -> "" | _ -> "(" ^ (String.concat ", " (List.map Ast.s_expr el)) ^ ")") (loop e)
+		sprintf "@%s%s %s" (Meta.to_string n) (match el with [] -> "" | _ -> "(" ^ (String.concat ", " (List.map Ast.Printer.s_expr el)) ^ ")") (loop e)
 	| TIdent s ->
 		"Ident " ^ s
 	) in
@@ -1291,7 +1291,7 @@ let rec s_expr_pretty print_var_ids tabs top_level s_type e =
 	| TCast (e,Some mt) ->
 		sprintf "cast (%s,%s)" (loop e) (s_type_path (t_path mt))
 	| TMeta ((n,el,_),e) ->
-		sprintf "@%s%s %s" (Meta.to_string n) (match el with [] -> "" | _ -> "(" ^ (String.concat ", " (List.map Ast.s_expr el)) ^ ")") (loop e)
+		sprintf "@%s%s %s" (Meta.to_string n) (match el with [] -> "" | _ -> "(" ^ (String.concat ", " (List.map Ast.Printer.s_expr el)) ^ ")") (loop e)
 	| TIdent s ->
 		s
 
@@ -1377,7 +1377,7 @@ let rec s_expr_ast print_var_ids tabs s_type e =
 		let s = Meta.to_string m in
 		let s = match el with
 			| [] -> s
-			| _ -> sprintf "%s(%s)" s (String.concat ", " (List.map Ast.s_expr el))
+			| _ -> sprintf "%s(%s)" s (String.concat ", " (List.map Ast.Printer.s_expr el))
 		in
 		tag "Meta" [s; loop e1]
 	| TIdent s ->
@@ -1436,7 +1436,7 @@ module Printer = struct
 	let s_doc = s_opt (fun s -> s)
 
 	let s_metadata_entry (s,el,_) =
-		Printf.sprintf "@%s%s" (Meta.to_string s) (match el with [] -> "" | el -> "(" ^ (String.concat ", " (List.map Ast.s_expr el)) ^ ")")
+		Printf.sprintf "@%s%s" (Meta.to_string s) (match el with [] -> "" | el -> "(" ^ (String.concat ", " (List.map Ast.Printer.s_expr el)) ^ ")")
 
 	let s_metadata metadata =
 		s_list " " s_metadata_entry metadata

+ 1 - 1
src/generators/genhxold.ml

@@ -146,7 +146,7 @@ let generate_type com t =
 			| _ ->
 			match pl with
 			| [] -> p "@%s " (Meta.to_string m)
-			| l -> p "@%s(%s) " (Meta.to_string m) (String.concat "," (List.map Ast.s_expr pl))
+			| l -> p "@%s(%s) " (Meta.to_string m) (String.concat "," (List.map Ast.Printer.s_expr pl))
 		) ml
 	in
 	let access is_read a = s_access is_read a in

+ 1 - 1
src/macro/eval/evalDebugSocket.ml

@@ -85,7 +85,7 @@ let var_to_json name value vio env =
 		| VObject o ->
 			begin try
 				let e = (get_ctx()).curapi.MacroApi.decode_expr v in
-				jv "Expr" (Ast.s_expr e) 2
+				jv "Expr" (Ast.Printer.s_expr e) 2
 			with _ ->
 				let fields = object_fields o in
 				jv "Anonymous" (fields_string fields) (List.length fields)

+ 1 - 1
src/optimization/analyzerConfig.ml

@@ -103,7 +103,7 @@ let update_config_from_meta com config meta =
 							config
 					end
 				| _ ->
-					let s = Ast.s_expr e in
+					let s = Ast.Printer.s_expr e in
 					com.warning (StringError.string_error s all_flags ("Unrecognized analyzer option: " ^ s)) (pos e);
 					config
 			) config el

+ 1 - 1
src/typing/generic.ml

@@ -40,7 +40,7 @@ let make_generic ctx ps pt p =
 			let s_type_path_underscore (p,s) = match p with [] -> s | _ -> String.concat "_" p ^ "_" ^ s in
 			let rec loop top t = match follow t with
 				| TInst(c,tl) -> (match c.cl_kind with
-					| KExpr e -> ident_safe (Ast.s_expr e)
+					| KExpr e -> ident_safe (Ast.Printer.s_expr e)
 					| _ -> (ident_safe (s_type_path_underscore c.cl_path)) ^ (loop_tl tl))
 				| TEnum(en,tl) -> (s_type_path_underscore en.e_path) ^ (loop_tl tl)
 				| TAnon(a) -> "anon_" ^ String.concat "_" (PMap.foldi (fun s f acc -> (s ^ "_" ^ (loop false (follow f.cf_type))) :: acc) a.a_fields [])

+ 1 - 1
src/typing/matcher.ml

@@ -168,7 +168,7 @@ module Pattern = struct
 		let ctx = pctx.ctx in
 		let p = pos e in
 		let fail () =
-			error ("Unrecognized pattern: " ^ (Ast.s_expr e)) p
+			error ("Unrecognized pattern: " ^ (Ast.Printer.s_expr e)) p
 		in
 		let unify_expected t' =
 			unify ctx t' t p