Permalink
Browse files

added types

  • Loading branch information...
1 parent d84bd65 commit 646b9bf3eb4630736c39b378f6444101322c4dfd @MarwanG MarwanG committed Jul 2, 2013
Showing with 42 additions and 38 deletions.
  1. +18 −18 src/GParser.ml
  2. +9 −5 src/Gen.ml
  3. +6 −6 src/Grammar.ml
  4. +1 −1 src/OracleSimple.ml
  5. +8 −8 src/Tree.ml
View
@@ -21,7 +21,7 @@ type character =
Char of char
| EOF;;
-let contains s1 s2 =
+let contains (s1:string) (s2:string) =
try
let len = String.length s2 in
for i = 0 to String.length s1 - len do
@@ -34,24 +34,24 @@ let is_space = function
| Char(ch) -> ch == ' ' or ch == '\n' or ch == '\t' or ch == '\r'
| EOF -> false ;;
-let get_char str i =
+let get_char (str:string) (i:int) =
try Char (String.get str i) with
_ -> EOF;;
-let rec skip_spaces str i =
+let rec skip_spaces (str:string) (i:int) =
let ichar = get_char str i in
if is_space ichar then skip_spaces str (i+1)
else i ;;
-let rec skip_until_eol str i =
+let rec skip_until_eol (str:string) (i:int) =
let ichar = get_char str i in
match ichar with
| EOF -> i
| Char(ch) ->
if ch='\n' then i+1
else skip_until_eol str (i+1);;
-let rec skip_until_starslash str i =
+let rec skip_until_starslash (str:string) (i:int) =
let ichar = get_char str i in
match ichar with
| EOF -> raise (Parse_Error "Missing end of comment: */")
@@ -64,7 +64,7 @@ let rec skip_until_starslash str i =
(* skip_until_starslash "/* toto titi tata */ tutu" 2 ;; *)
-let rec skip_comments str i =
+let rec skip_comments (str:string) (i:int) =
let ichar = get_char str i in
match ichar with
| EOF -> i
@@ -81,7 +81,7 @@ let rec skip_comments str i =
(* skip_comments "/* toto titi tata */ tutu" 0 ;; *)
-let rec skip str i =
+let rec skip (str:string) (i:int) =
let i' = skip_comments str i in
if not (i'==i) then skip str i'
else i;;
@@ -100,7 +100,7 @@ let string_of_list l =
list_iteri (fun ch i -> String.set str ch i) l ;
str ;;
-let next_word str i =
+let next_word (str:string) (i:int) =
let rec aux i word =
let ichar = get_char str i in
match ichar with
@@ -117,13 +117,13 @@ let next_word str i =
let (word,i') = aux (skip str i) [] in
(string_of_list word,i') ;;
-let advance str i expect =
+let advance (str:string) (i:int) (expect:string) =
let (word,i') = next_word str i
in
if word = expect then i'
else raise (Parse_Error ("Missing '" ^ expect ^ "'")) ;;
-let parse_component str i =
+let parse_component (str:string) (i:int) =
let rec aux i weight refs =
let (componentName,i') = next_word str i in
if componentName="<z>" then
@@ -160,7 +160,7 @@ let parse_component str i =
(* parse_component "<z> * BinNode * BinNode +" 0 ;; *)
-let parse_components str i =
+let parse_components (str:string) (i:int) =
let rec aux i comps =
let (comp,i') = parse_component str i in
let (next,i'') = next_word str i' in
@@ -174,7 +174,7 @@ let parse_components str i =
(* parse_components "Leaf * <z> + BinNode * BinNode ;" 0 ;; *)
-let parse_rule str i =
+let parse_rule (str:string) (i:int) =
let (ruleName,i') = next_word str i in
if ruleName="" then
raise (Parse_Error "Missing rule name")
@@ -187,7 +187,7 @@ let parse_rule str i =
(* parse_rule "BinNode ::= Leaf * <z> + BinNode * BinNode ;" 0 ;; *)
-let parse_int str i =
+let parse_int (str:string) (i:int) =
let int_str, i' = next_word str i
in
try
@@ -196,7 +196,7 @@ let parse_int str i =
(int_val, i')
with Failure _ -> raise (Parse_Error (sprintf "cannot convert '%s' to an integer" int_str))
-let parse_float str i =
+let parse_float (str:string) (i:int) =
let float_str, i' = next_word str i
in
try
@@ -206,7 +206,7 @@ let parse_float str i =
with Failure _ -> raise (Parse_Error (sprintf "cannot convert '%s' to a float" float_str))
-let parse_option str i =
+let parse_option (str:string) (i:int) =
let opt_id, i' = next_word str i
in match opt_id with
| "min" ->
@@ -276,7 +276,7 @@ let parse_option str i =
| _ -> raise (Parse_Error (sprintf "Uknown or unsupported option: %s" opt_id))
-let parse_grammar str =
+let parse_grammar (str:string) =
let rec aux i rules =
match next_word str i with
("",_) -> List.rev rules
@@ -292,7 +292,7 @@ let parse_grammar str =
(* parse_grammar "BinNode ::= Leaf * <z> + BinNode * BinNode;" ;; *)
-let string_of_file fname =
+let string_of_file (fname:string) =
let inchan = open_in fname in
let rec read str =
try let next = input_line inchan in
@@ -301,7 +301,7 @@ let string_of_file fname =
in
read "" ;;
-let parse_from_file fname =
+let parse_from_file (fname:string) =
let input = string_of_file fname in
let grm = parse_grammar input
in
View
@@ -20,6 +20,7 @@ open CombSys
open Grammar
open OracleSimple
+
(* g must be completed
Renvoie une map des poids total de chaque composant (somme des pondération des sous composants)
et une map de la grammaire sous forme de (composant -> liste des (liste des sous_composants * pondération)) *)
@@ -79,11 +80,14 @@ let pondere2 (g:grammar) (y:float array)
in
List.fold_left aux StringMap.empty g_comp
+type 'a queue = 'a Queue.t
+type 'a stack = 'a Stack.t
+
let rec gen_stack_tree
(size:int)
- next_rules current_rules
+ (next_rules: string queue) (current_rules: (string * int) stack)
map
- sizemax
+ (sizemax:int)
leafs =
if size<sizemax then
if (Queue.is_empty next_rules) then
@@ -137,8 +141,8 @@ let rec gen_stack_tree
let rec gen_tree_of_stack_rec
(stack,size)
- current_rules
- with_prefix idprefix =
+ (current_rules: tree queue)
+ (with_prefix:bool) (idprefix:string) =
match (Stack.is_empty stack) with
|true -> ()
|false -> let prefix = if with_prefix then idprefix ^ (string_of_int (size)) else (string_of_int (size)) in
@@ -154,7 +158,7 @@ let rec gen_tree_of_stack_rec
let gen_tree_of_stack
(stack,size)
- with_prefix idprefix =
+ (with_prefix:bool) (idprefix:string) =
let queue = Queue.create () in
match size with
| 0 -> (None,0)
View
@@ -34,7 +34,7 @@ let (plane_tree:(Elem.t * (int * Elem.t list) list) list) = [ (ELEM("T"),[(0,[SE
(* StringSet.iter (fun x -> print_endline (name_of_elem x)) (names_of_grammar plane_tree);; *)
-let name_of_elem elt =
+let name_of_elem (elt:elem) =
match elt with
|SEQ(name) -> name
|ELEM(name) -> name ;;
@@ -45,23 +45,23 @@ let names_of_component (_,comps) =
let names_of_rule (_,comps) =
List.fold_left (fun names comp -> StringSet.union (names_of_component comp) names) (StringSet.empty) comps ;;
-let names_of_grammar grm =
+let names_of_grammar (grm:grammar) =
List.fold_left (fun gnames rule -> StringSet.union (names_of_rule rule) gnames) (StringSet.empty) grm ;;
-let rule_names_of_grammar grm =
+let rule_names_of_grammar (grm:grammar) =
List.fold_left (fun rnames (rname,_) -> StringSet.add rname rnames) (StringSet.empty) grm ;;
-let leafs_of_grammar grm =
+let leafs_of_grammar (grm:grammar) =
let leafs = StringSet.diff (names_of_grammar grm) (rule_names_of_grammar grm)
in
StringSet.fold (fun leaf l -> leaf::l) leafs [] ;;
-let completion grm =
+let completion (grm:grammar) =
let leafs = leafs_of_grammar grm
in
grm @ (List.fold_left (fun lrules leaf -> (leaf,[(0,[])])::lrules) [] leafs) ;;
-let count elt liste =
+let count (elt:elem) (liste: elem list) =
let rec count_rec e l i =
match l with
|[] -> i
View
@@ -44,7 +44,7 @@ let diverge (y:float array) (epsilon:float):bool =
dvgi 0 ((Array.length y) - 1)
(* output:zmin,zmax,vectorY *)
-let rec searchSingularity phi (zmin:float) (zmax:float) (epsilon1:float) (epsilon2:float)(zstart:float):float *float* float array =
+let rec searchSingularity (phi:combsys) (zmin:float) (zmax:float) (epsilon1:float) (epsilon2:float)(zstart:float):float *float* float array =
if zmax -. zmin < epsilon1 then
(zmin,zmax,iterationSimple phi zmin epsilon2)
else
View
@@ -25,7 +25,7 @@ let rec indent_string = function
| 0 -> ""
| n -> " " ^ indent_string (n-1)
-let indent_string_of_tree t =
+let indent_string_of_tree (t:tree) =
let rec tree level t = match t with
| Leaf(typ,id) -> (indent_string level) ^ "Leaf[" ^ typ ^ "," ^ id ^ "]"
| Node(typ,id,ts) ->
@@ -37,7 +37,7 @@ let indent_string_of_tree t =
in tree 0 t
-let rec tree_out show_type show_id tree out =
+let rec tree_out (show_type:bool) (show_id:bool) (tree:tree) out =
let label typ id =
(if show_id then id else "") ^
(if show_type
@@ -53,20 +53,20 @@ let rec tree_out show_type show_id tree out =
(fun (out:out_channel) (t:tree) -> (tree_out show_type show_id t out))
"[" "," "]" ts ;;
-let file_of_tree show_type show_id fname tree =
+let file_of_tree (show_type:bool) (show_id:bool) (fname:string) (tree:tree) =
let out = open_out fname
in
tree_out show_type show_id tree out ;
close_out out
-let xml_of_tree t =
+let xml_of_tree (t:tree) =
let rec aux = function
| Leaf(typ,id) -> "<leaf type=\"" ^ typ ^ "\" id=\"" ^ id ^ "\"/>"
| Node(typ,id,ts) -> "<node type=\"" ^ typ ^ "\" id=\"" ^ id ^ "\">" ^ (string_of_list aux "" "" "</node>" ts)
in "<?xml version=\"1.0\"?><tree>" ^ (aux t) ^ "</tree>"
-let indent_xml_of_tree t =
+let indent_xml_of_tree (t:tree) =
let rec tree level t = match t with
| Leaf(typ,id) -> (indent_string level) ^ "<leaf type=\"" ^ typ ^ "\" id=\"" ^ id ^ "\"/>"
| Node(typ,id,ts) ->
@@ -77,7 +77,7 @@ let indent_xml_of_tree t =
| t::f' -> (tree level t) ^ "\n" ^ (forest level f')
in "<?xml version=\"1.0\"?>\n<tree>\n" ^ (tree 1 t) ^ "\n</tree>\n"
-let dot_of_tree show_type t =
+let dot_of_tree (show_type:bool) (t:tree) =
let rec nodes = function
| Leaf(typ,id) -> " " ^ id ^ (if show_type then (" [label=\"" ^ typ ^ "\"];\n") else " [shape=point];\n")
| Node(typ,id,ts) ->
@@ -94,13 +94,13 @@ let dot_of_tree show_type t =
| Node(_,id,ts) -> (string_of_list (fun t -> edges 1 id t) "" "" "" ts))
^ "}\n"
- let file_of_dot show_type fname tree =
+ let file_of_dot (show_type:bool) (fname:string) (tree:tree) =
let out = open_out fname
in
output_string out (dot_of_tree show_type tree);
close_out out
-let file_of_xml fname tree =
+let file_of_xml (fname:string) (tree:tree) =
let out = open_out fname
in
output_string out(xml_of_tree tree);

0 comments on commit 646b9bf

Please sign in to comment.