Skip to content

Commit ffb8846

Browse files
kape1395kape1395
authored
Merge pull request #155 from glondu/cmdliner-translate
Use cmdliner in translate
2 parents d8ade9a + c46c2e6 commit ffb8846

File tree

4 files changed

+116
-121
lines changed

4 files changed

+116
-121
lines changed

‎.merlin

Lines changed: 0 additions & 20 deletions
This file was deleted.

‎translate/dune

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@
66
(executable
77
(name main)
88
(public_name translate)
9+
(libraries cmdliner)
910
(modules_without_implementation fotypes))
1011

1112
(install ; It has to be installed under 2 names for some reason.

‎translate/fofunctions.ml

Lines changed: 35 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -618,9 +618,8 @@ let rename proposition formula =
618618
(* DSNF TRANSFORMATIONS *)
619619
(******************************************************************)
620620

621-
(* this reference controls how fo formulas are processed: if false,
622-
then by de Morgan laws, by renaming else*)
623-
let useFOrenaming = ref false;;
621+
(* the useFOrenaming argument controls how fo formulas are processed:
622+
if false, then by de Morgan laws, by renaming else*)
624623

625624
(*
626625
(* Transformation to CNF by renaming *)
@@ -675,13 +674,13 @@ let fodsnfselect form =
675674
(* iP uP sP eP *)
676675
(* *)
677676
(* ASSUME that formula is in NNF *)
678-
let rec dsnfWrap form =
677+
let rec dsnfWrap ~useFOrenaming form =
679678
debug ("dsnfWrap input: " ^ (string_of_formula form));
680679
match form with
681680
| f when (isTemporalFree f) -> (f, [], [], [])
682681
| And(x,y) ->
683-
let (iP1, uP1,sP1,eP1) = dsnfWrap x
684-
and (iP2, uP2,sP2,eP2) = dsnfWrap y
682+
let (iP1, uP1,sP1,eP1) = dsnfWrap ~useFOrenaming x
683+
and (iP2, uP2,sP2,eP2) = dsnfWrap ~useFOrenaming y
685684
in (And(iP1, iP2), union uP1 uP2, union sP1 sP2, union eP1 eP2)
686685
| Always (f) when (isTemporalFree f) ->
687686
(True, [f], [], [])
@@ -695,9 +694,9 @@ let rec dsnfWrap form =
695694
(True, [], [Always(Or(lhs,rhs))], [])
696695

697696
(* else use the standard transformations *)
698-
| _ -> dsnf form
697+
| _ -> dsnf ~useFOrenaming form
699698

700-
and dsnf form =
699+
and dsnf ~useFOrenaming form =
701700
debug ("dsnf input: " ^ (string_of_formula form));
702701
(* if isTemporalFree form *)
703702
(* then fodsnfselect form *)
@@ -712,26 +711,26 @@ and dsnf form =
712711
match form with
713712
(* booleans go first *)
714713
| Not x ->
715-
let (iP,uP,sP,eP) = dsnf x
714+
let (iP,uP,sP,eP) = dsnf ~useFOrenaming x
716715
in (Not(iP), uP,sP,eP)
717716
| And(x,y) ->
718-
let (iP1, uP1,sP1,eP1) = dsnf x
719-
and (iP2, uP2,sP2,eP2) = dsnf y
717+
let (iP1, uP1,sP1,eP1) = dsnf ~useFOrenaming x
718+
and (iP2, uP2,sP2,eP2) = dsnf ~useFOrenaming y
720719
in (And(iP1, iP2), union uP1 uP2, union sP1 sP2, union eP1 eP2)
721720
(* | Or(x,y) ->
722-
let (iP1, uP1,sP1,eP1) = dsnf x
723-
and (iP2, uP2,sP2,eP2) = dsnf y
721+
let (iP1, uP1,sP1,eP1) = dsnf ~useFOrenaming x
722+
and (iP2, uP2,sP2,eP2) = dsnf ~useFOrenaming y
724723
in (Or(iP1, iP2), union uP1 uP2, union sP1 sP2, union eP1 eP2)*)
725-
| Or(f, g) when ((not !useFOrenaming) || (isLiteral f) || (isLiteral g)) ->
726-
let (iP1, uP1, sP1, eP1) = dsnf f
727-
and (iP2, uP2, sP2, eP2) = dsnf g
724+
| Or(f, g) when ((not useFOrenaming) || (isLiteral f) || (isLiteral g)) ->
725+
let (iP1, uP1, sP1, eP1) = dsnf ~useFOrenaming f
726+
and (iP2, uP2, sP2, eP2) = dsnf ~useFOrenaming g
728727
in
729728
(Or(iP1, iP2), (union uP1 uP2), (union sP1 sP2), (union eP1 eP2))
730-
| Or(f, g) when (!useFOrenaming) (* both are non-litarls & useFOrenaming *) ->
729+
| Or(f, g) when (useFOrenaming) (* both are non-litarls & useFOrenaming *) ->
731730
let newP = newLiteral (freeVars f)
732-
and (iP1, uP1, sP1, eP1) = dsnf f
731+
and (iP1, uP1, sP1, eP1) = dsnf ~useFOrenaming f
733732
in setSeen iP1 newP ;
734-
let (iP2, uP2, sP2, eP2) = dsnf g
733+
let (iP2, uP2, sP2, eP2) = dsnf ~useFOrenaming g
735734
in
736735
(Or(newP, iP2),
737736
(rename newP iP1)::(union uP1 uP2), (union sP1 sP2), (union eP1 eP2))
@@ -742,15 +741,15 @@ and dsnf form =
742741
in (Implies(iP1, iP2), union uP1 uP2, union sP1 sP2, union eP1 eP2)*)
743742
(* Quantifiers *)
744743
| Forall(v,y) ->
745-
let (iP,uP,sP,eP) = dsnf y
744+
let (iP,uP,sP,eP) = dsnf ~useFOrenaming y
746745
in (Forall(v, iP), uP,sP,eP)
747746
| Exists(v,y) ->
748-
let (iP,uP,sP,eP) = dsnf y
747+
let (iP,uP,sP,eP) = dsnf ~useFOrenaming y
749748
in (Exists(v, iP), uP,sP,eP)
750749
(* Temporal operators *)
751750
| Always(f) ->
752751
let newP = newLiteral (freeVars f)
753-
and (iP,uP,sP,eP) = dsnf f
752+
and (iP,uP,sP,eP) = dsnf ~useFOrenaming f
754753
in setSeen (Always(f)) newP ;
755754
(newP,
756755
(rename newP iP)::uP,
@@ -764,7 +763,7 @@ and dsnf form =
764763
if (isLiteral f) then f
765764
else (newLiteral (freeVars f))
766765
)
767-
and (iP,uP,sP,eP) = dsnf f
766+
and (iP,uP,sP,eP) = dsnf ~useFOrenaming f
768767
in setSeen (Next (f)) newP ;
769768
(newP,
770769
(if (isLiteral f) then uP else
@@ -775,7 +774,7 @@ and dsnf form =
775774
| Sometime(f) ->
776775
let newP = newLiteral (freeVars f)
777776
and newQ = newLiteral (freeVars f)
778-
and (iP,uP,sP,eP) = dsnf f
777+
and (iP,uP,sP,eP) = dsnf ~useFOrenaming f
779778
in setSeen (Sometime(f)) newP ;
780779
(newP,
781780
(rename newQ iP)::uP,
@@ -786,24 +785,24 @@ and dsnf form =
786785
if not (isLiteral f)
787786
then
788787
let newP = newLiteral (freeVars (Until(f,g)))
789-
in let (iP,uP,sP,eP) = dsnf (Until(newP, g))
790-
and (iP2,uP2,sP2,eP2) = dsnf (f)
788+
in let (iP,uP,sP,eP) = dsnf ~useFOrenaming (Until(newP, g))
789+
and (iP2,uP2,sP2,eP2) = dsnf ~useFOrenaming (f)
791790
in (iP,
792791
(rename newP iP2)::(uP@uP2),
793792
sP@sP2, eP@eP2)
794793
else if not (isLiteral g)
795794
then
796795
let newQ = newLiteral (freeVars (Until(f,g)))
797-
in let (iP,uP,sP,eP) = dsnf (Until(f, newQ))
798-
and (iP2,uP2,sP2,eP2) = dsnf (g)
796+
in let (iP,uP,sP,eP) = dsnf ~useFOrenaming (Until(f, newQ))
797+
and (iP2,uP2,sP2,eP2) = dsnf ~useFOrenaming (g)
799798
in (iP,
800799
(rename newQ iP2)::(uP@uP2),
801800
sP@sP2, eP@eP2)
802801
else (* Both f and g are atoms *)
803802
let newP = newLiteral (freeVars (Until(f,g)))
804803
and newQ = newLiteral (freeVars (Until(f,g)))
805-
and (iP1,uP1,sP1,eP1) = dsnf f
806-
and (iP2,uP2,sP2,eP2) = dsnf g
804+
and (iP1,uP1,sP1,eP1) = dsnf ~useFOrenaming f
805+
and (iP2,uP2,sP2,eP2) = dsnf ~useFOrenaming g
807806
in setSeen (Until(f,g)) newP ;
808807
(newP,
809808
(
@@ -820,24 +819,24 @@ and dsnf form =
820819
if not (isLiteral f)
821820
then
822821
let newP = newLiteral (freeVars (Unless(f,g)))
823-
in let (iP,uP,sP,eP) = dsnf (Unless(newP, g))
824-
and (iP2,uP2,sP2,eP2) = dsnf (f)
822+
in let (iP,uP,sP,eP) = dsnf ~useFOrenaming (Unless(newP, g))
823+
and (iP2,uP2,sP2,eP2) = dsnf ~useFOrenaming (f)
825824
in (iP,
826825
(rename newP iP2)::(uP@uP2),
827826
sP@sP2,eP@eP2)
828827
else if not (isLiteral g)
829828
then
830829
let newQ = newLiteral (freeVars (Unless(f,g)))
831-
in let (iP,uP,sP,eP) = dsnf (Unless(f, newQ))
832-
and (iP2,uP2,sP2,eP2) = dsnf (g)
830+
in let (iP,uP,sP,eP) = dsnf ~useFOrenaming (Unless(f, newQ))
831+
and (iP2,uP2,sP2,eP2) = dsnf ~useFOrenaming (g)
833832
in (iP,
834833
(rename newQ iP2)::(uP@uP2),
835834
sP@sP2,eP@eP2)
836835
else (* Both f and g are atoms *)
837836
let newP = newLiteral (freeVars (Unless(f,g)))
838837
and newQ = newLiteral (freeVars (Unless(f,g)))
839-
and (iP1,uP1,sP1,eP1) = dsnf f
840-
and (iP2,uP2,sP2,eP2) = dsnf g
838+
and (iP1,uP1,sP1,eP1) = dsnf ~useFOrenaming f
839+
and (iP2,uP2,sP2,eP2) = dsnf ~useFOrenaming g
841840
in setSeen (Unless(f,g)) newP ;
842841
(newP,
843842
(

‎translate/main.ml

Lines changed: 80 additions & 65 deletions
Original file line numberDiff line numberDiff line change
@@ -5,94 +5,75 @@ open Fotypes;;
55
open Fofunctions;;
66

77

8-
let verbose = ref false;;
9-
let useSimplification = ref false;;
10-
let filename = ref "";;
11-
let inx = ref stdin;;
12-
let outx = ref stdout;;
13-
let fo = ref false;;
14-
let atoms = ref false;;
15-
16-
(*let resetVerbose = verbose := false;;*)
17-
18-
let setInFilename name = inx := open_in name;;
19-
let setOutFilename name = outx := open_out name;;
20-
21-
let args_spec = ("-v", Arg.Set verbose, "Be verbose (print intermediate transformations).")::
22-
("-s", Arg.Set useSimplification, "Use simplifications.")::
23-
("-r", Arg.Set useFOrenaming, "Transform to CNF by renaming")::
24-
(*("-fo", Arg.Set fo, "Perform transformation for FO (expanding domains).")::*)
25-
("-al", Arg.Set atoms, "Include the 'order' statement with the list of all atoms in the input formula (experimental feature).")::
26-
("-i", Arg.String setInFilename,
27-
"Specify the input file. If not given, stdin is used.")::
28-
("-o", Arg.String setOutFilename,
29-
"Specify the output file. If not given, stdout is used.")::
30-
[];;
31-
32-
let usage_spec = "Usage: translate [-v] [-s] [-i infile] [-o outfile]";;
33-
34-
let anonfun astring = Arg.usage args_spec usage_spec; exit 0;;
35-
368
(* main function *)
37-
let _ =
9+
let main verbose useSimplification useFOrenaming atoms inFilename outFilename =
3810
try
3911
(*print_string ( Filename.basename Sys.argv.(0) );*)
40-
if ( (String.sub ( Filename.basename Sys.argv.(0)) 0 2 ) = "fo") then fo:=true;
41-
Arg.parse args_spec anonfun usage_spec ;
42-
let lexbuf = Lexing.from_channel !inx in
12+
let fo = String.starts_with ~prefix:"fo" (Filename.basename Sys.argv.(0)) in
13+
let inx =
14+
match inFilename with
15+
| None -> stdin
16+
| Some name -> open_in name
17+
in
18+
let outx =
19+
match outFilename with
20+
| None -> stdout
21+
| Some name -> open_out name
22+
in
23+
let lexbuf = Lexing.from_channel inx in
4324
let result = Foyacc.start Folex.lexer lexbuf in
4425
let constList = constsOf result in
45-
if !atoms=true then begin
26+
if atoms then begin
4627
let atomList = getAtoms result in
47-
output_string !outx ("order(" ^ (string_of_clause atomList) ^ ").\n");
28+
output_string outx ("order(" ^ (string_of_clause atomList) ^ ").\n");
4829
end;
49-
if !verbose=true then begin
50-
output_string !outx ("Input: " ^ string_of_formula result^"\n");
51-
flush !outx
30+
if verbose then begin
31+
output_string outx ("Input: " ^ string_of_formula result^"\n");
32+
flush outx
5233
end;
5334
let inNNF = nnf result in
54-
if !verbose then begin
55-
output_string !outx "In NNF: ";
56-
output_string !outx (string_of_formula inNNF^"\n");
35+
if verbose then begin
36+
output_string outx "In NNF: ";
37+
output_string outx (string_of_formula inNNF^"\n");
5738
debug("DONE");
58-
flush !outx;
39+
flush outx;
5940
debug("DONE");
6041
end;
6142
debug("done ");
6243
let simplified =
63-
if !useSimplification then
64-
simplify inNNF !outx !verbose
44+
if useSimplification then
45+
simplify inNNF outx verbose
6546
else inNNF
6647
in
67-
if !verbose then begin
68-
output_string !outx "After all simplifications:\n";
69-
output_string !outx (string_of_formula simplified^"\n");
70-
flush !outx
48+
if verbose then begin
49+
output_string outx "After all simplifications:\n";
50+
output_string outx (string_of_formula simplified^"\n");
51+
flush outx
7152
end;
72-
let (iP,uP,sP,eP) = dsnfWrap simplified in
73-
if !verbose then begin
74-
output_string !outx "After transformations, the DSNF is\n";
75-
output_string !outx "iP = {\n";
76-
output_string !outx ((string_of_formula iP)^"\n}\n");
77-
output_string !outx "uP = {\n";
78-
output_string !outx ((string_of_formulas uP)^"\n}\n");
79-
output_string !outx "sP = {\n";
80-
output_string !outx ((string_of_formulas sP)^"\n}\n");
81-
output_string !outx "eP = {\n";
82-
output_string !outx ((string_of_formulas eP)^"\n}\n");
83-
flush !outx
53+
let (iP,uP,sP,eP) = dsnfWrap ~useFOrenaming simplified in
54+
if verbose then begin
55+
output_string outx "After transformations, the DSNF is\n";
56+
output_string outx "iP = {\n";
57+
output_string outx ((string_of_formula iP)^"\n}\n");
58+
output_string outx "uP = {\n";
59+
output_string outx ((string_of_formulas uP)^"\n}\n");
60+
output_string outx "sP = {\n";
61+
output_string outx ((string_of_formulas sP)^"\n}\n");
62+
output_string outx "eP = {\n";
63+
output_string outx ((string_of_formulas eP)^"\n}\n");
64+
flush outx
8465
end;
8566
(* Skolemization *)
8667
let skolemisedIP = eliminateQ iP
8768
and skolemisedUP = eliminateQl uP
8869
and skolemisedSP = eliminateQl sP
89-
and skolemisedEP = if !fo then (eliminateQl (flood eP constList)) else (eliminateQl eP)
70+
and skolemisedEP = if fo then (eliminateQl (flood eP constList)) else (eliminateQl eP)
9071
in
9172
(* FO transformations *)
92-
let processedIP = if !fo then (processFOconstants skolemisedIP) else skolemisedIP
93-
and processedUP = if !fo then (processFOconstantsl skolemisedUP) else skolemisedUP
94-
and processedSP = if !fo then (foStepClauses skolemisedSP) else skolemisedSP
95-
and processedEP = if !fo then (processFOconstantsl skolemisedEP) else skolemisedEP
73+
let processedIP = if fo then (processFOconstants skolemisedIP) else skolemisedIP
74+
and processedUP = if fo then (processFOconstantsl skolemisedUP) else skolemisedUP
75+
and processedSP = if fo then (foStepClauses skolemisedSP) else skolemisedSP
76+
and processedEP = if fo then (processFOconstantsl skolemisedEP) else skolemisedEP
9677
in
9778
(**)
9879
let cnfedIP = cnf processedIP
@@ -126,8 +107,42 @@ let _ =
126107
(* Collect strings *)
127108
let resultStr = preamble^icstring^ucstring^scstring^ecstring^ending^"\n" in
128109
(*print_string (string_of_clause (!newNamesList));*)
129-
output_string !outx (resultStr); if !outx != stdout then close_out !outx
110+
output_string outx (resultStr); if outx != stdout then close_out outx
130111
with Parsing.Parse_error -> print_endline ("Parse error line " ^
131112
string_of_int (!Folex.currentLine) ^ " characters " ^
132113
string_of_int (!Folex.posmin) ^ "-" ^ string_of_int (!Folex.posmax))
133114
| Sys_error astring -> print_endline (astring);;
115+
116+
open Cmdliner
117+
118+
let verbose =
119+
let doc = "Be verbose (print intermediate transformations)." in
120+
Arg.(value & flag & info ["v"] ~doc)
121+
122+
let useSimplification =
123+
let doc = "Use simplifications." in
124+
Arg.(value & flag & info ["s"] ~doc)
125+
126+
let useFOrenaming =
127+
let doc = "Transform to CNF by renaming." in
128+
Arg.(value & flag & info ["r"] ~doc)
129+
130+
let atoms =
131+
let doc = "Include the 'order' statement with the list of all atoms in the input formula (experimental feature)." in
132+
Arg.(value & flag & info ["al"] ~doc)
133+
134+
let inFilename =
135+
let doc = "Specify the input file. If not given, stdin is used." in
136+
Arg.(value & opt (some file) None & info ["i"] ~doc)
137+
138+
let outFilename =
139+
let doc = "Specify the output file. If not given, stdout is used." in
140+
Arg.(value & opt (some string) None & info ["o"] ~doc)
141+
142+
let main_t = Term.(const main $ verbose $ useSimplification $ useFOrenaming $ atoms $ inFilename $ outFilename)
143+
144+
let cmd =
145+
let info = Cmd.info "translate" in
146+
Cmd.v info main_t
147+
148+
let () = exit (Cmd.eval cmd)

0 commit comments

Comments
 (0)