Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge pull request #4 from MarwanG/leaf

Leaf
  • Loading branch information...
commit fcddb536fcb7de34239c071b31138a34d2c4b1d2 2 parents b2dce09 + b462219
@fredokun authored
View
30 src/Arbogen.ml
@@ -117,7 +117,16 @@ Arg.parse [
global_options.max_try <- n;
global_options.max_try_set <- true
end),
- "<n> : set the maximum of tries when generating trees")
+ "<n> : set the maximum of tries when generating trees");
+ ("-type", Arg.String(fun x ->
+ match x with
+ |"arb" -> global_options.output_type <- 0;
+ |"dot" -> global_options.output_type <- 1;
+ |"both" -> global_options.output_type <- 2;
+ |_ -> eprintf "Error: wrong option value must be strictly 0 or 1\n...aborting\n";
+ exit 1;
+ ),
+ "<n>: set the type of output generated at the end");
]
(fun arg ->
if (String.compare global_options.grammar_file "")=0
@@ -166,13 +175,22 @@ in match result with
eprintf "Error: no tree generated ==> try to use different parameters\n%!" ;
exit 1
| Some (tree,size) ->
- if (global_options.verbosity) > 0
+ if (global_options.verbosity) > 0
then begin
printf "==> Tree generated with size=%d\n%!" size ;
- printf "Saving file to 'tree.arb'\n%!" ;
- Tree.file_of_tree true global_options.with_prefix "tree.arb" tree ;
- printf "==> file saved\n%!"
- end
+ if (global_options.output_type) = 0
+ then
+ printf "Saving file to 'tree.arb'\n%!" ;
+ Tree.file_of_tree true global_options.with_prefix "tree.arb" tree ;
+ if (global_options.output_type) = 1 then
+ printf "Saving file to 'tree.dot'\n%!" ;
+ Tree.file_of_dot true "tree.dot" tree;
+ if (global_options.output_type = 2) then
+ printf "Saving both files to 'tree.arb' and 'tree.dot'\n%!" ;
+ Tree.file_of_tree true global_options.with_prefix "tree.arb" tree ;
+ Tree.file_of_dot true "tree.dot" tree;
+ printf "==> file saved\n%!"
+ end
View
11 src/Gen.ml
@@ -102,6 +102,8 @@ let rec gen_stack_tree
sub_component_list
in
(* ICI TRAITEMENT DE SUBCOMPONENTLIST *)
+ let subst_rule = ref ""
+ in
let (next_rules_list,arity) =
List.fold_left
(fun (l,n) elt ->
@@ -110,13 +112,18 @@ let rec gen_stack_tree
(* print_endline (string_of_float rdm);*)
let n' = int_of_float (floor((log( Random.float 1.)) /. (log rdm))) in
((List.append (concat_n [rul] n) l),(n'+n-1))
- | ELEM(rul) -> ((rul::l),n))
+ | ELEM(rul) -> if(List.exists (fun x -> x = rul) leafs) then
+ begin subst_rule := rul; (l,0) end
+ else ((rul::l),n))
([],arity')
next_rules_list'
in
(*Trouves les futurs composants et leur nombre *)
List.iter (fun elt -> Queue.push elt next_rules) next_rules_list;
- Stack.push (next_rule,arity) current_rules;
+ (if arity = 0 then
+ Stack.push(!subst_rule,arity) current_rules
+ else
+ Stack.push (next_rule,arity) current_rules);
gen_stack_tree
(size+arity)
next_rules current_rules
View
2  src/Options.ml
@@ -29,6 +29,7 @@ type options_record = {
mutable ratio_rejected_set: bool;
mutable max_refine: int;
mutable max_refine_set: bool;
+ mutable output_type: int;
} ;;
let global_options = {
@@ -61,6 +62,7 @@ let global_options = {
ratio_rejected_set = false;
max_refine = 6;
max_refine_set = false;
+ output_type = 0;
} ;;
exception Option_Error of string ;;
View
8 src/Tree.ml
@@ -45,7 +45,7 @@ let rec tree_out show_type show_id tree out =
else "")
in
match tree with
- | Leaf(typ,id) -> output_string out ((label typ id) ^ ".")
+ | Leaf(typ,id) -> output_string out (label typ id)
| Node(typ,id,ts) ->
output_string out (label typ id) ;
output_list
@@ -93,3 +93,9 @@ let dot_of_tree show_type t =
| Leaf(_,_) -> ""
| Node(_,id,ts) -> (string_of_list (fun t -> edges 1 id t) "" "" "" ts))
^ "}\n"
+
+ let file_of_dot show_type fname tree =
+ let out = open_out fname
+ in
+ output_string out (dot_of_tree show_type tree);
+ close_out out
View
7 src/Util.ml
@@ -17,10 +17,13 @@
let fold_map mop fop finit a =
List.fold_left (fun r e -> fop (mop e) r) finit a
-let rec string_of_list str_of_elem op dl cl l = match l with
+
+let string_of_list str_of_elem op dl cl l =
+ let rec aux = function
| [] -> cl
| [e] -> op ^ (str_of_elem e) ^ cl
- | e::l' -> op ^ (str_of_elem e) ^ dl ^ (string_of_list str_of_elem "" dl cl l')
+ | e::l' -> op ^ (str_of_elem e) ^ dl ^ (aux l')
+in op ^ (aux l)
let rec output_list out output_elem op dl cl l = match l with
| [] -> output_string out cl
Please sign in to comment.
Something went wrong with that request. Please try again.