fix oepn dependency

.gitignore

@@ -78,5 +78,6 @@ syntax.ml
 large_program_tes/*
 lexer_compile_test/*
 !lexer_compile_test/try.sh
+!lexer_compile_test/compile.sh
 lexer_output_sample.ml
 tes.c

lexer_compile_test/compile.sh

@@ -0,0 +1,26 @@
+rm ./srcs/* -f
+cp ../src/lex/*.ml ./srcs/
+cp ../src/lex/*.mli ./srcs/
+cp ../src/lex/*.mly ./srcs/
+cp ../src/lex/*.mll ./srcs/
+rm ./srcs/lexer.ml
+rm -f ./srcs/lexer.mli 
+rm ./srcs/parser.ml
+rm ./srcs/parser.mli
+rm ./srcs/nfa.ml
+rm ./srcs/nfa.mli
+(cd ./srcs;
+patch main.ml < ../patch_main.patch;
+); 
+
+cd ./build
+rm *
+cp ../srcs/* ./
+../../my_lex lexer.mll > lexer.ml
+../../my_yacc parser.mly > myparser.output
+#../../main -mli lexer.ml -l ../../lib/ # 若干Openまわりが壊れてるのでいったん諦める
+cp ../lexer.mli lexer.mli
+../../main syntax.ml parser.ml lexer.ml convert.ml main.ml -l ../../lib
+
+mv a.out ../a.out
+

lexer_compile_test/try.sh

@@ -28,9 +28,9 @@ cp ../srcs/* ./
 #exit
 #exit
 
-#../../main syntax.ml parser.ml lexer.ml convert.ml main.ml -l ../../lib
+../../main syntax.ml parser.ml lexer.ml convert.ml main.ml -l ../../lib
 
-cp ../stub.s ./
+#cp ../stub.s ./
 
 #OCAMLRUNPARAM=p ../../main -s lexer.ml -l ../../lib
 #../../main -s syntax.ml -l ../../lib
@@ -39,7 +39,7 @@ cp ../stub.s ./
 #OCAMLRUNPARAM=p ../../main -s convert.ml -l ../../lib
 #OCAMLRUNPARAM=p ../../main -s main.ml -l ../../lib
 
-#exit
+exit
 
 (cd ../../lib/ml;
 #../../main -s parsing.ml -l ../;

src/compiler/main.ml

@@ -149,7 +149,7 @@ let get_header file =
 	let astp = Preprocess.preprocess tast in
 	let hs = Type_checker.export_header file astp opens in
 	print_string "typed";  print_newline ();
-	Spec.top2header hs
+	Spec.top2header hs opens
 
 let compile_to_header fn = 
 	let hfn = changext fn ".ml" ".mli" in
@@ -245,25 +245,70 @@ let _ =
 
 			(* TODO(satos) いったん循環参照checkはommitする *)
 			(* これたぶんcheckするようにするとpervasive.ml がやられますね *)
-			let db_check = ref [] in
-			let rec f rems = 
-				match rems with
-				| [] -> []
-				| None :: xs -> f xs
-				| Some(x) :: xs -> (
-					if List.mem x !db_check then f xs else (
-						Printf.printf "open %s\n" x;
-						db_check := x :: !db_check;
-						assert (hasext x ".ml");
-						let (_,_,_,opens) as d = load_source x in
-						Printf.printf "%s :: %s\n" x (String.concat " @@ " opens);
-						let tos = List.map open2fn opens in
-						(x,d) :: (f (xs @ tos))
-					)
-				)
-			in
+			(* 初手pervasive.ml 解放はやっていいはず。あとはdagになりそう *)
+			(* というか別にDAGだったら入力ファイル順番気にしなくていいのでは？？？ *)
 
-			let fn_ast_specs = f (List.map (fun x -> Some x) (List.rev !files)) in
+			(* fn_ast_specs は、上から順に依存関係がない *)
+			let fn_ast_specs = 
+				let db_check = ref [] in
+				let rec add_open na = 
+					try
+						List.assoc na (!db_check)
+					with
+						| Not_found -> (
+							assert (hasext na ".ml");
+							Printf.printf "open %s\n" na;
+							let nc = ref 0 in
+							let nv = ref [] in
+							let (_,_,_,opens) as d = load_source na in
+							db_check := (na,(nv,nc,d)) :: !db_check;
+							Printf.printf "%s :: %s\n" na (String.concat " @@ " opens);
+							let tos = List.fold_left (fun r x -> match x with None -> r | Some d -> d :: r) [] (List.map open2fn opens) in
+							List.iter (fun x -> 
+								if x = na || na = libp ^ "/ml/pervasive.ml" then () else (
+									Printf.printf "Depend from %s to %s\n" na x; 
+									let p,_,_ = add_open x in
+									p := na :: !p;
+									nc := !nc + 1
+								)
+							) tos;
+
+							(if na = libp ^ "/ml/pervasive.ml" then (
+								nc := 0
+							) else ());
+							(nv,nc,d)
+						)
+				in
+				(* TODO(satos) なんかもう手続き型なんだよな... *)
+				List.iter (fun x -> let _ = add_open x in ()) !files;
+				List.iter (fun (na,(p,q,_)) -> 
+					Printf.printf "Depend edge :: %s :: (%s),%d\n" na (String.concat "," !p) !q
+				) !db_check;
+				let result = ref [] in
+				let rec remove_some ds = 
+					match ds with
+					| [] -> []
+					| (na,(p,q,r)) :: xs -> (
+							if !q > 0 then (na,(p,q,r)) :: (remove_some xs) 
+							else (
+								result := (na,r) :: !result;
+								List.iter (fun x -> 
+									let _,t,_ = List.assoc x !db_check in
+									t := !t - 1;
+								) !p;
+								xs
+							)
+						)
+				in
+				let rec loop () = 
+					db_check := remove_some !db_check;
+					match !db_check with
+					| [] -> ()
+					| _ -> loop ()
+				in
+					loop ();
+					!result
+			in
 
 			List.iter (fun (fn,astspec) -> 
 				let sfn = ast_spec_to_sfile astspec in

src/compiler/parser.mly

@@ -104,7 +104,7 @@ decl:
 		}
 	| TYPE var EQ type_expr    { DTypeRename($2,$4) }
 	| TYPE var EQ variant_defs { DVariant($2,$4) }
-	| OPEN variant_name        { DOpen($2) }
+	| OPEN variant_name        { implicit_open $2; DOpen($2) }
 ;
 
 
@@ -117,7 +117,7 @@ specification:
 	| VAL var COLON type_expr  { SValtype($2,$4)    }
 	| TYPE var EQ type_expr    { STypeRename($2,$4) }
 	| TYPE var EQ variant_defs { SVariant($2,$4) }
-	| OPEN variant_name        { SOpen($2)       }
+	| OPEN variant_name        { implicit_open $2; SOpen($2) }
 ;
 
 

src/compiler/spec.ml

@@ -22,13 +22,17 @@ let check_type_definition tyenv specs =
 *)
 
 
-let top2header vs = 
-	String.concat "" (List.map (fun x -> 
+let top2header vs opens = 
+	(String.concat "" (List.map (fun x -> 
+		Printf.sprintf "Open %s\n" x
+	) opens)) ^ 
+	(String.concat "" (List.map (fun x -> 
 		match x with
 		| SValtype(na,te) -> (
-				Printf.sprintf "val %s : %s\n" na (type_expr2header te)
+				let cf = (try let _ = String.index na '@' in (fun s -> "(* " ^ s ^ " *)") with Not_found -> (fun s -> s)) in
+				(cf (Printf.sprintf "val %s : %s" na (type_expr2header te))) ^ "\n"
 			)
-	) vs)
+	) vs))
 
 let spec_open_list = ref []
 

src/compiler/spec.mli

@@ -8,7 +8,7 @@ type spec_decl =
 
 type top = spec_decl list
 
-val top2header : top -> string
+val top2header : top -> (string list) -> string
 
 val spec_open_list : (string list) ref
 val implicit_open : string -> unit