enum generation and construction ok, little handling of "ignore" and returns restricted to final path atm

src/generators/genml.ml

@@ -32,6 +32,8 @@ type ctx = {
 	mutable tabs : string;
 	mutable separator : bool;
 	dirs : (string list, bool) Hashtbl.t;
+	mutable vars : (int, bool) Hashtbl.t;
+	mutable current_module : path;
 }
 
 type ml_type =
@@ -76,7 +78,8 @@ let begin_module ctx (path,name) =
 		Hashtbl.add ctx.dirs path true;
 	end;
 	let file = ctx.com.file ^ (match path with [] -> "" | _ -> "/" ^ String.concat "/" path) ^ "/" ^ name ^ ".ml" in
-	ctx.ch <- open_out_bin file
+	ctx.ch <- open_out_bin file;
+	ctx.current_module <- (path,name)
 
 let flush ctx =
 	Rbuffer.output_buffer ctx.ch ctx.buf;
@@ -110,6 +113,10 @@ let rec to_type ctx t p =
 		MInst c.cl_path
 	| TInst (c,pl) ->
 		MParams (MInst c.cl_path, List.map (fun t -> to_type ctx t p) pl)
+	| TEnum (e,[]) ->
+		MInst e.e_path
+	| TEnum (e,pl) ->
+		MParams (MInst e.e_path, List.map (fun t -> to_type ctx t p) pl)
 	| TAbstract (a,pl) ->
 		if Meta.has Meta.CoreType a.a_meta then
 			(match a.a_path with
@@ -125,7 +132,10 @@ let rec to_type ctx t p =
 
 
 let module_path ctx path =
-	snd path
+	if path = ctx.current_module then
+		""
+	else
+		snd path ^ "."
 
 let rec type_str ctx = function
 	| MUnit -> "unit"
@@ -135,14 +145,44 @@ let rec type_str ctx = function
 	| MString -> "string"
 	| MOption t -> type_str ctx t ^ " option"
 	| MFun tl -> String.concat " -> " (List.map (type_str ctx) tl)
-	| MInst path -> module_path ctx path ^ ".t"
+	| MInst path -> module_path ctx path ^ "t"
 	| MParams (t,[]) -> type_str ctx t
 	| MParams (t,[p]) -> type_str ctx p ^ " " ^ type_str ctx p
-	| MParams (t,pl) -> "(" ^ String.concat " * " (List.map (type_str ctx) pl) ^ ") " ^ type_str ctx t
+	| MParams (t,pl) -> "(" ^ String.concat ", " (List.map (type_str ctx) pl) ^ ") " ^ type_str ctx t
+
+let rec def_value ctx = function
+	| MUnit -> "()"
+	| MInt -> "0"
+	| MFloat -> "0."
+	| MBool -> "false"
+	| MString -> "\"\""
+	| MOption t -> "None"
+	| MFun tl -> "(fun " ^ String.concat " " (List.map (fun _ -> "_") tl) ^ " -> assert false)"
+	| MParams (t,_) -> def_value ctx t
+	| MInst path -> "Obj.magic 0"
 
 let s_type ctx t p = type_str ctx (to_type ctx t p)
 
-let rec gen_expr ctx e =
+let scan_vars ctx e =
+	let old = ctx.vars in
+	ctx.vars <- Hashtbl.create 0;
+	let rec loop e =
+		(match e.eexpr with
+		| TBinop ((OpAssign | OpAssignOp _), { eexpr = TLocal v },_) -> Hashtbl.replace ctx.vars v.v_id true
+		| _ -> ());
+		Type.iter loop e
+	in
+	loop e;
+	(fun() -> ctx.vars <- old)
+
+let gen_list ctx sep f list =
+	let first = ref true in
+	List.iter (fun e ->
+		if !first then first := false else spr ctx sep;
+		f ctx e
+	) list
+
+let rec gen_expr ctx e is_final =
 	match e.eexpr with
 	| TConst c ->
 		(match c with
@@ -154,42 +194,71 @@ let rec gen_expr ctx e =
 		| TThis -> spr ctx "this"
 		| TSuper -> assert false)
 	| TLocal v ->
-		spr ctx (ident v.v_name)
+		let vid = ident v.v_name in
+		if Hashtbl.mem ctx.vars v.v_id then print ctx "!%s" vid else spr ctx vid
+	| TVar (v,init) ->
+		let mut = Hashtbl.mem ctx.vars v.v_id in
+		let t = to_type ctx v.v_type e.epos in
+		print ctx "let %s : %s = %s" (ident v.v_name) (type_str ctx t) (if mut then "ref " else "");
+		(match init with None -> spr ctx (def_value ctx t) | Some e -> gen_expr ctx e false);
+		spr ctx " in ";
+		ctx.separator <- true;
 	| TBlock [] ->
 		spr ctx "()"
 	| TBlock el ->
 		spr ctx "begin";
 		ctx.separator <- true;
 		let b = open_block ctx in
-		List.iter (fun e ->
-			newline ctx;
-			gen_expr ctx e
-		) el;
+		let rec loop = function
+			| [] -> assert false
+			| [e] ->
+				newline ctx;
+				gen_expr ctx e is_final
+			| e :: el ->
+				newline ctx;
+				(match follow e.etype with TAbstract ({ a_path = [],"Void" },_) -> () | _ -> spr ctx "ignore ");
+				gen_expr ctx e false;
+				loop el
+		in
+		loop el;
 		b();
 		newline ctx;
 		spr ctx "end";
+	| TCall ({ eexpr = TField (_,FEnum _) } as e, (_ :: _ :: _ as pl)) ->
+		gen_expr ctx e false;
+		spr ctx "(";
+		gen_list ctx ", " (fun ctx e -> gen_expr ctx e false) pl;
+		spr ctx ")"
 	| TCall (e, pl) ->
-		gen_expr ctx e;
+		gen_expr ctx e false;
+		if pl = [] then spr ctx "()";
 		List.iter (fun e ->
 			spr ctx " ";
-			gen_expr ctx e;
+			gen_expr ctx e false;
 		) pl;
 	| TField (e, ft) ->
 		(match ft with
 		| FInstance _ -> assert false
+		| FEnum (e,ef) ->
+			print ctx "%s%s" (module_path ctx e.e_path) (ident ef.ef_name)
 		| FStatic (c,cf) ->
 			let rec loop = function
 				| (Meta.Custom ":mlNative",[EConst (String s),_],_) :: _ ->
 					spr ctx s
 				| _ :: l -> loop l
 				| [] ->
-					print ctx "%s.%s" (module_path ctx c.cl_path) (ident cf.cf_name)
+					print ctx "%s%s" (module_path ctx c.cl_path) (ident cf.cf_name)
 			in
 			loop cf.cf_meta
 		| FAnon f -> assert false
 		| FDynamic _ -> assert false
-		| FClosure _ -> assert false
-		| FEnum _ -> assert false);
+		| FClosure _ -> assert false);
+	| TReturn _ when not is_final ->
+		abort "Unallowed not final return" e.epos
+	| TReturn None ->
+		spr ctx "()"
+	| TReturn (Some e) ->
+		gen_expr ctx e is_final
 	| _ ->
 		abort ("Unsupported expr " ^ s_expr_kind e) e.epos
 
@@ -220,16 +289,33 @@ let generate_class ctx c =
 		| Var v -> assert false
 		| Method _ ->
 			let args, ret = (match follow f.cf_type with TFun (args, ret) -> args, ret | _ -> assert false) in
+			let tret = to_type ctx ret f.cf_pos in
 			print ctx "let %s %s : %s = " (ident f.cf_name) (if args = [] then "()" else String.concat " " (List.map (fun (n,o,t) ->
 				if o then abort "Unsupported optional arg" f.cf_pos;
 				sprintf "(%s:%s)" (ident n) (s_type ctx t f.cf_pos)
-			) args)) (s_type ctx ret f.cf_pos);
+			) args)) (type_str ctx tret);
 			(match f.cf_expr with
-			| Some { eexpr = TFunction f } -> gen_expr ctx f.tf_expr
+			| Some { eexpr = TFunction f } ->
+				let e = f.tf_expr in
+				let old = scan_vars ctx e in
+				if tret = MUnit && to_type ctx e.etype e.epos <> MUnit then spr ctx "ignore ";
+				gen_expr ctx e true;
+				old()
 			| _ -> assert false);
 			spr ctx "\n"
 	) c.cl_ordered_statics
 
+let generate_enum ctx e =
+	print ctx "type t =";
+	List.iter (fun n ->
+		let c = PMap.find n e.e_constrs in
+		print ctx "\n\t| %s" (ident n);
+		(match follow c.ef_type with
+		| TFun (args,_) -> print ctx " of %s" (String.concat " * " (List.map (fun (n,o,t) -> s_type ctx t c.ef_pos) args))
+		| _ -> ())
+	) e.e_names;
+	spr ctx "\n\n"
+
 let generate_type ctx t =
 	match t with
 	| TClassDecl { cl_extern = true } ->
@@ -242,6 +328,11 @@ let generate_type ctx t =
 		() (* core type *)
 	| TTypeDecl td ->
 		begin_module ctx td.t_path;
+		spr ctx "TODO";
+		end_module ctx;
+	| TEnumDecl e ->
+		begin_module ctx e.e_path;
+		generate_enum ctx e;
 		end_module ctx;
 	| _ ->
 		abort "Unsupported module type"  (t_infos t).mt_pos
@@ -254,6 +345,8 @@ let generate com =
 		separator = false;
 		dirs = Hashtbl.create 0;
 		buf = Rbuffer.create 65536;
+		vars = Hashtbl.create 0;
+		current_module = [],"";
 	} in
 	(try Unix.mkdir ctx.com.file 0o755 with _ -> ());
 	List.iter (generate_type ctx) com.types;
@@ -261,7 +354,6 @@ let generate com =
 	| None -> ()
 	| Some e ->
 		begin_module ctx ([],"MLBoot");
-		gen_expr ctx e;
-		spr ctx "()";
+		gen_expr ctx e true;
 		newline ctx;
 		end_module ctx)