diff --git a/src/parsing/pretty.ml b/src/parsing/pretty.ml index c109d2173..662892a34 100644 --- a/src/parsing/pretty.ml +++ b/src/parsing/pretty.ml @@ -127,7 +127,7 @@ let rec term : p_term pp = fun ppf t -> match ts with | None -> () | Some [||] when !empty_context -> () - | Some ts -> out ppf "[%a]" (Array.pp func "; ") ts + | Some ts -> out ppf ".[%a]" (Array.pp func "; ") ts in match (t.elt, priority) with | (P_Type , _ ) -> out ppf "TYPE" @@ -154,9 +154,8 @@ let rec term : p_term pp = fun ppf t -> out ppf "@[@[let @[<2>%a%a%a@] ≔@ %a@ @]in@ %a@]" ident x params_list xs typ a func t func u | (P_NLit(i) , _ ) -> out ppf "%i" i - (* We print minimal parentheses, and ignore the [Wrap] constructor. *) - | (P_Wrap(t) , _ ) -> pp priority ppf t - | (P_Expl(t) , _ ) -> out ppf "{@[%a@]}" func t + | (P_Wrap(t) , _ ) -> out ppf "(@[%a@])" func t + | (P_Expl(t) , _ ) -> out ppf "[@[%a@]]" func t | (_ , _ ) -> out ppf "(@[%a@])" func t in let rec toplevel ppf t = @@ -172,9 +171,10 @@ let rec term : p_term pp = fun ppf t -> toplevel ppf t and params : p_params pp = fun ppf (ids, t, b) -> - match b with - | false -> out ppf "@[(@,@[<2>%a%a@]@,)@]" param_ids ids typ t - | true -> out ppf "@[{@,@[<2>%a%a@]@,}@]" param_ids ids typ t + if b then out ppf "@[[@,@[<2>%a%a@]@,]@]" param_ids ids typ t + else match t with + | Some t -> out ppf "@[(@,@[<2>%a : %a@]@,)@]" param_ids ids term t + | None -> out ppf "@[@,@[<2>%a@]@,@]" param_ids ids (* starts with a space if the list is not empty *) and params_list : p_params list pp = fun ppf -> @@ -188,9 +188,9 @@ let rule : string -> p_rule pp = fun kw ppf {elt=(l,r);_} -> out ppf "%s %a ↪ %a" kw term l term r let inductive : string -> p_inductive pp = - let cons ppf (id,a) = out ppf "| %a : %a" ident id term a in + let cons ppf (id,a) = out ppf "@,| %a : %a" ident id term a in fun kw ppf {elt=(id,a,cs);_} -> - out ppf "@[%s %a : %a ≔@,%a@]" kw ident id term a (List.pp cons "@,") cs + out ppf "@[%s %a : %a ≔%a@]" kw ident id term a (List.pp cons "") cs let equiv : (p_term * p_term) pp = fun ppf (l,r) -> out ppf "%a ≡ %a" term l term r @@ -245,18 +245,18 @@ let query : p_query pp = fun ppf { elt; _ } -> match elt with | P_query_assert(true, a) -> out ppf "assertnot ⊢ %a" assertion a | P_query_assert(false,a) -> out ppf "assert ⊢ %a" assertion a - | P_query_debug(true ,s) -> out ppf "set debug \"+%s\"" s - | P_query_debug(false,s) -> out ppf "set debug \"-%s\"" s + | P_query_debug(true ,s) -> out ppf "debug \"+%s\"" s + | P_query_debug(false,s) -> out ppf "debug \"-%s\"" s | P_query_flag(s, b) -> - out ppf "set flag \"%s\" %s" s (if b then "on" else "off") + out ppf "flag \"%s\" %s" s (if b then "on" else "off") | P_query_infer(t, _) -> out ppf "type %a" term t | P_query_normalize(t, _) -> out ppf "compute %a" term t - | P_query_prover s -> out ppf "set prover \"%s\"" s - | P_query_prover_timeout n -> out ppf "set prover_timeout %d" n + | P_query_prover s -> out ppf "prover \"%s\"" s + | P_query_prover_timeout n -> out ppf "prover_timeout %d" n | P_query_print None -> out ppf "print" | P_query_print(Some qid) -> out ppf "print %a" qident qid | P_query_proofterm -> out ppf "proofterm" - | P_query_verbose i -> out ppf "set verbose %i" i + | P_query_verbose i -> out ppf "verbose %i" i let tactic : p_tactic pp = fun ppf { elt; _ } -> begin match elt with @@ -273,10 +273,10 @@ let tactic : p_tactic pp = fun ppf { elt; _ } -> | P_tac_refl -> out ppf "reflexivity" | P_tac_rewrite(b,p,t) -> let dir ppf b = if not b then out ppf " left" in - let pat ppf p = out ppf " [%a]" rw_patt p in + let pat ppf p = out ppf " .[%a]" rw_patt p in out ppf "rewrite%a%a %a" dir b (Option.pp pat) p term t - | P_tac_simpl None -> out ppf "simpl" - | P_tac_simpl (Some qid) -> out ppf "simpl %a" qident qid + | P_tac_simpl None -> out ppf "simplify" + | P_tac_simpl (Some qid) -> out ppf "simplify %a" qident qid | P_tac_solve -> out ppf "solve" | P_tac_sym -> out ppf "symmetry" | P_tac_why3 p -> @@ -298,7 +298,7 @@ let notation : Sign.notation pp = fun ppf -> function | _ -> () let rec subproof : p_subproof pp = fun ppf sp -> - out ppf "<@[@ %a@ @]>" proofsteps sp + out ppf "{@[@ %a@ @]}" proofsteps sp and subproofs : p_subproof list pp = fun ppf spl -> out ppf "@[%a@]" (pp_print_list ~pp_sep:pp_print_space subproof) spl @@ -310,7 +310,7 @@ and proofstep : p_proofstep pp = fun ppf (Tactic (t, spl)) -> out ppf "@[%a@,%a;@]" tactic t subproofs spl let proof : (p_proof * p_proof_end) pp = fun ppf (p, pe) -> - out ppf "begin@[@ %a@ @]%a" + out ppf "begin@ @[%a@]@ %a" (fun ppf -> function | [block] -> proofsteps ppf block (* No braces for a single toplevel block *) @@ -322,11 +322,10 @@ let command : p_command pp = fun ppf { elt; _ } -> | P_builtin (s, qid) -> out ppf "@[builtin \"%s\"@ ≔ %a@]" s qident qid | P_inductive (_, _, []) -> assert false (* not possible *) | P_inductive (ms, xs, i :: il) -> - out ppf "@[@[%a%a@]%a@,%a@,end@]" - modifiers ms - (List.pp params " ") xs - (inductive "inductive") i - (List.pp (inductive "with") "@,") il + let with_ind ppf i = out ppf "@,%a" (inductive "with") i in + out ppf "@[@[%a%a@]%a%a@]" + modifiers ms (List.pp params " ") xs + (inductive "inductive") i (List.pp with_ind "") il | P_notation (qid, n) -> out ppf "notation %a %a" qident qid notation n | P_open ps -> out ppf "open %a" (List.pp path " ") ps | P_query q -> query ppf q @@ -336,7 +335,9 @@ let command : p_command pp = fun ppf { elt; _ } -> (List.pp path " ") ps | P_require_as (p,i) -> out ppf "@[require %a@ as %a@]" path p ident i | P_rules [] -> assert false (* not possible *) - | P_rules (r :: rs) -> rule "rule" ppf r; List.iter (rule "with" ppf) rs + | P_rules (r :: rs) -> + let with_rule ppf r = out ppf "@.%a" (rule "with") r in + rule "rule" ppf r; List.iter (with_rule ppf) rs | P_symbol { p_sym_mod; p_sym_nam; p_sym_arg; p_sym_typ; p_sym_trm; p_sym_prf; p_sym_def } -> diff --git a/tests/export.sh b/tests/export_dk.sh similarity index 91% rename from tests/export.sh rename to tests/export_dk.sh index 491c01035..e468a3f7d 100755 --- a/tests/export.sh +++ b/tests/export_dk.sh @@ -19,6 +19,8 @@ do escape_path|'a b/escape file');; # because dedukti does not accept spaces in module names 262_private_in_lhs);; # because dedukti does not accept protected symbols in rule LHS arguments 273);; # because dedukti SR algorithm fails + file.with.dot|req.file.with.dot);; #FIXME + indind);; #FIXME *) lp_files="$dir/$f.lp $lp_files"; f=`echo $f | sed -e 's/\//_/g'`; dk_files="${outdir}_$f.dk $dk_files"; @@ -29,11 +31,11 @@ done # compile lp files (optional) compile() { cd $root - echo compile lp files (optional) ... + echo 'compile lp files (optional) ...' #$lambdapi check -w -c $lp_files # does not work because of #802 for f in $lp_files do - echo compile $f ... + echo "compile $f ..." $lambdapi check -w -v 0 -c $f done } @@ -42,7 +44,7 @@ time compile # can be commented # translate lp files to dk files translate() { cd $root - echo translate lp files ... + echo 'translate lp files ...' for f in $lp_files do f=${f%.lp} diff --git a/tests/export_lp.sh b/tests/export_lp.sh new file mode 100755 index 000000000..196d02f9a --- /dev/null +++ b/tests/export_lp.sh @@ -0,0 +1,38 @@ +#!/bin/bash + +# Test lp export + +TIMEFORMAT="%E" +root=`pwd` +lambdapi='dune exec -- lambdapi' + +outdir=.tmp +#rm -rf $outdir +mkdir -p "$outdir/OK/a b" +cp -f lambdapi.pkg $outdir + +# translate lp files +translate() { + cd $root + echo translate lp files ... + for f in OK/*.lp 'OK/a b/escape file.lp' + do + out=$outdir/$f + echo "$f --> $out ..." + $lambdapi export -o lp -w -v 0 "$f" > "$out" + if test $? -ne 0; then echo KO; exit 1; fi + done +} +time translate + +# check lp files +check() { + cd $outdir + echo check lp files ... + $lambdapi check -w -v 0 OK/*.lp + if test $? -ne 0; then echo KO; exit 1; fi +} +time check + +cd $root +echo OK