diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/main.ml | 11 | ||||
| -rw-r--r-- | src/pretty_print.ml | 134 | ||||
| -rw-r--r-- | src/pretty_print.mli | 3 |
3 files changed, 123 insertions, 25 deletions
diff --git a/src/main.ml b/src/main.ml index b5e7878b..baa887f6 100644 --- a/src/main.ml +++ b/src/main.ml @@ -347,6 +347,7 @@ let _ = let lib = ref [] let opt_print_version = ref false +let opt_print_verbose = ref false let opt_file_arguments = ref ([]:string list) let options = Arg.align ([ ( "-i", @@ -383,6 +384,9 @@ let options = Arg.align ([ (* ( "-print_types", Arg.Unit (fun b -> opt_print_types := true), " print types on stdout");*) + ( "-verbose", + Arg.Unit (fun b -> opt_print_verbose := true), + " pretty-print out the file"); ( "-v", Arg.Unit (fun b -> opt_print_version := true), " print version"); @@ -402,7 +406,12 @@ let _ = let main() = if !(opt_print_version) then Printf.printf "L2 pre alpha \n" - else ignore(List.map (fun f -> (parse_file f)) !opt_file_arguments) + else let parsed = (List.map (fun f -> (parse_file f)) !opt_file_arguments) in + let merged = List.flatten [parsed] in + let ast = convert_ast (List.hd merged) in + if !(opt_print_verbose) + then ((Pretty_print.pp_defs Format.std_formatter) ast) + else () let _ = try begin diff --git a/src/pretty_print.ml b/src/pretty_print.ml index 400b5f0b..da7d978f 100644 --- a/src/pretty_print.ml +++ b/src/pretty_print.ml @@ -1,15 +1,39 @@ open Ast +open Format + let rec list_format (sep : string) (fmt : 'a -> string) (ls : 'a list) : string = match ls with | [] -> "" | [a] -> fmt a | a::ls -> (fmt a) ^ sep ^ (list_format sep fmt ls) +let rec list_pp i_format l_format = + fun ppf l -> + match l with + | [] -> fprintf ppf "" + | [i] -> fprintf ppf "%a" l_format i + | i::is -> fprintf ppf "%a%a" i_format i (list_pp i_format l_format) is + +let kwd ppf s = fprintf ppf "%s" s +let base ppf s = fprintf ppf "%s" s + +let parens is_atomic v base = + if (is_atomic v) then base + else "(" ^ base ^ ")" + +let pp_parens is_atomic format = + fun ppf v -> + if (is_atomic v) + then format ppf v + else fprintf ppf "%a %a %a" kwd "(" format v kwd ")" + let pp_format_id (Id_aux(i,_)) = match i with | Id(i) -> i - | DeIid(x) -> "(:" ^ x ")" + | DeIid(x) -> "(:" ^ x ^ ")" + +let pp_id ppf id = base ppf (pp_format_id id) let pp_format_bkind (BK_aux(k,_)) = match k with @@ -18,23 +42,36 @@ let pp_format_bkind (BK_aux(k,_)) = | BK_order -> "Order" | BK_effects -> "Effects" +let pp_bkind ppf bk = base ppf (pp_format_bkind bk) + let pp_format_kind (K_aux(K_kind(klst),_)) = list_format " -> " pp_format_bkind klst + +let pp_kind ppf k = base ppf (pp_format_kind k) + +let is_atomic_typ (Typ_aux(t,_)) = + match t with + | Typ_var _ | Typ_tup _ -> true + | _ -> false +let is_atomic_nexp (Nexp_aux(n,_)) = + match n with + | Nexp_id _ | Nexp_constant _ | Nexp_exp _ -> true + | _ -> false let rec pp_format_typ (Typ_aux(t,_)) = match t with - | Typ_id(id) -> pp_format_id id + | Typ_var(id) -> pp_format_id id | Typ_wild -> "_" - | Typ_fn(arg,ret,efct) -> (pp_format_typ arg) ^ " -> " ^ - (pp_format_typ ret) ^ " " ^ - (pp_format_effect efct) - | Typ_tup(typs) -> "(" ^ (list_format ", " pp_format_typ args) ^ ")" - | Typ_app(id,args) -> (pp_format_id id) ^ (list_format " " pp_format_typ_arg args) + | Typ_fn(arg,ret,efct) -> (parens is_atomic_typ arg (pp_format_typ arg)) ^ " -> " ^ + (parens is_atomic_typ ret (pp_format_typ ret)) ^ " " ^ + (pp_format_effects efct) + | Typ_tup(typs) -> "(" ^ (list_format ", " pp_format_typ typs) ^ ")" + | Typ_app(id,args) -> "(" ^ (pp_format_id id) ^ " " ^ (list_format " " pp_format_typ_arg args) ^ ")" and pp_format_nexp (Nexp_aux(n,_)) = match n with | Nexp_id(id) -> pp_format_id id | Nexp_constant(i) -> string_of_int i - | Nexp_sum(n1,n2) -> "(" ^ (pp_format_nexp n1) ^ " + ^ " (pp_format_nexp n2) ^ ")" + | Nexp_sum(n1,n2) -> "(" ^ (pp_format_nexp n1) ^ " + " ^ (pp_format_nexp n2) ^ ")" | Nexp_times(n1,n2) -> "(" ^ (pp_format_nexp n1) ^ " * " ^ (pp_format_nexp n2) ^ ")" | Nexp_exp(n1) -> "2** (" ^ (pp_format_nexp n1) ^ ")" and pp_format_ord (Ord_aux(o,_)) = @@ -42,9 +79,9 @@ and pp_format_ord (Ord_aux(o,_)) = | Ord_id(id) -> pp_format_id id | Ord_inc -> "inc" | Ord_dec -> "dec" -and pp_format_effect (Effects_aux(e,_)) = +and pp_format_effects (Effects_aux(e,_)) = match e with - | Effects_var(id) -> "effect " ^ pp_format id + | Effects_var(id) -> "effect " ^ pp_format_id id | Effects_set(efcts) -> if (efcts = []) then "pure" @@ -59,13 +96,18 @@ and pp_format_effect (Effects_aux(e,_)) = | Effect_undef -> "undef" | Effect_unspec -> "unspec" | Effect_nondet -> "nondet") - efcts) " }" + efcts) ^ " }" and pp_format_typ_arg (Typ_arg_aux(t,_)) = match t with | Typ_arg_typ(t) -> pp_format_typ t | Typ_arg_nexp(n) -> pp_format_nexp n | Typ_arg_order(o) -> pp_format_ord o - | Typ_arg_Efct(e) -> pp_format_effects e + | Typ_arg_effects(e) -> pp_format_effects e + +let pp_typ ppf t = base ppf (pp_format_typ t) +let pp_nexp ppf n = base ppf (pp_format_nexp n) +let pp_ord ppf o = base ppf (pp_format_ord o) +let pp_effects ppf e = base ppf (pp_format_effects e) let pp_format_nexp_constraint (NC_aux(nc,_)) = match nc with @@ -78,13 +120,17 @@ let pp_format_nexp_constraint (NC_aux(nc,_)) = list_format ", " string_of_int bounds ^ "}" +let pp_nexp_constraint ppf nc = base ppf (pp_format_nexp_constraint nc) + let pp_format_qi (QI_aux(qi,_)) = match qi with - | QI_const(n_const) -> pp_format_nexp_constraint qi + | QI_const(n_const) -> pp_format_nexp_constraint n_const | QI_id(KOpt_aux(ki,_)) -> (match ki with | KOpt_none(id) -> pp_format_id id - | KOpt_kind(k,id) -> pp_format_kind k ^ " " pp_format_id id) + | KOpt_kind(k,id) -> pp_format_kind k ^ " " ^ pp_format_id id) + +let pp_qi ppf qi = base ppf (pp_format_qi qi) let pp_format_typquant (TypQ_aux(tq,_)) = match tq with @@ -94,9 +140,13 @@ let pp_format_typquant (TypQ_aux(tq,_)) = (list_format ", " pp_format_qi qlist) ^ ". " +let pp_typquant ppf tq = base ppf (pp_format_typquant tq) + let pp_format_typscm (TypSchm_aux(TypSchm_ts(tq,t),_)) = (pp_format_typquant tq) ^ pp_format_typ t +let pp_typscm ppf ts = base ppf (pp_format_typscm ts) + let pp_format_lit (L_aux(l,_)) = match l with | L_unit -> "()" @@ -106,7 +156,9 @@ let pp_format_lit (L_aux(l,_)) = | L_false -> "false" | L_num(i) -> string_of_int i | L_hex(n) | L_bin(n) -> n - | L_string(s) -> "\"" ^ s "\"" + | L_string(s) -> "\"" ^ s ^ "\"" + +let pp_lit ppf l = base ppf (pp_format_lit l) let rec pp_format_pat (P_aux(p,l)) = match p with @@ -117,19 +169,53 @@ let rec pp_format_pat (P_aux(p,l)) = | P_typ(typ,pat) -> "<" ^ pp_format_typ typ ^ "> " ^ pp_format_pat pat | P_app(id,pats) -> pp_format_id id ^ "(" ^ list_format ", " pp_format_pat pats ^ ")" - | P_record(fpats) -> "{" ^ + | P_record(fpats,_) -> "{" ^ list_format "; " (fun (FP_aux(FP_Fpat(id,fpat),_)) -> - pp_format_id id ^ " = " pp_format_pat fpat) fpats + pp_format_id id ^ " = " ^ pp_format_pat fpat) fpats ^ "}" - | P_vector(pats) -> "[" ^ list_format "; " pp_format_pats pats ^ "]" + | P_vector(pats) -> "[" ^ list_format "; " pp_format_pat pats ^ "]" | P_vector_indexed(ipats) -> - "[" ^ list_format "; " (fun (i,p) -> string_of_int i ^ " = " pp_format_pat p) ipats ^ "]" - | P_vector_concat(pats) -> - list_format " ^ " pp_format_pats pats - | P_tup(pats) -> "(" ^ (list_format ", " pp_format_pats pats) ^ ")" - | P_list(pats) -> "[|" ^ (list_format "; " pp_format_pats pats) ^ "|]" + "[" ^ list_format "; " (fun (i,p) -> string_of_int i ^ " = " ^ pp_format_pat p) ipats ^ "]" + | P_vector_concat(pats) -> list_format " ^ " pp_format_pat pats + | P_tup(pats) -> "(" ^ (list_format ", " pp_format_pat pats) ^ ")" + | P_list(pats) -> "[|" ^ (list_format "; " pp_format_pat pats) ^ "|]" + +let pp_pat ppf p = base ppf (pp_format_pat p) + +let rec pp_let ppf (LB_aux(lb,_)) = + match lb with + | LB_val_explicit(ts,pat,exp) -> fprintf ppf "@[<0>%a %a %a %a@ %a@]" kwd "let" pp_typscm ts pp_pat pat kwd " =" pp_exp exp + | LB_val_implicit(pat,exp) -> fprintf ppf "@[<0>%a %a %a@ %a@]" kwd "let" pp_pat pat kwd " =" pp_exp exp + +(* Need an is_atomic? check and insert parens otherwise *) +and pp_exp ppf (E_aux(e,_)) = + match e with + | E_block(exps) -> fprintf ppf "@[<0>%a %a@ %a@]" + kwd "{" + (list_pp pp_semi_exp pp_exp) exps + kwd "}" + | E_id(id) -> pp_id ppf id + | E_lit(lit) -> pp_lit ppf lit + | E_cast(typ,exp) -> fprintf ppf "@[<0>%a%a%a %a@]" kwd "<" pp_typ typ kwd ">" pp_exp exp + | E_app(f,args) -> fprintf ppf "@[<0>%a %a@]" pp_exp f (list_pp pp_exp pp_exp) args + | E_app_infix(l,op,r) -> fprintf ppf "@[<0>%a %a %a@]" pp_exp l pp_id op pp_exp r + | E_tuple(exps) -> fprintf ppf "@[<0>%a %a %a@]" kwd "(" (list_pp pp_comma_exp pp_exp) exps kwd ")" + | E_if(c,t,e) -> fprintf ppf "@[<0> %a %a @[<1> %a %a@] @[<1> %a@ %a@]@]" kwd "if " pp_exp c kwd "then" pp_exp t kwd "else" pp_exp e + +and pp_semi_exp ppf e = fprintf ppf "@[<1>%a %a@]" pp_exp e kwd ";" + +and pp_comma_exp ppf e = fprintf ppf "@[<1>%a %a@]" pp_exp e kwd "," +let pp_default ppf (DT_aux(df,_)) = + match df with + | DT_kind(bk,id) -> fprintf ppf "@[<0>%a %a %a@]@\n" kwd "default" pp_bkind bk pp_id id + | DT_typ(ts,id) -> fprintf ppf "@[<0>%a %a %a@]@\n" kwd "default" pp_typscm ts pp_id id +let pp_def ppf (DEF_aux(d,_)) = + match d with + | DEF_default(df) -> pp_default ppf df +let pp_format_ast defs = "" -let pp_format_ast defs = assert false +let pp_defs ppf (Defs(defs)) = + fprintf ppf "@[%a@]@\n" (list_pp pp_def pp_def) defs diff --git a/src/pretty_print.mli b/src/pretty_print.mli index 54a5555b..30f15181 100644 --- a/src/pretty_print.mli +++ b/src/pretty_print.mli @@ -1,4 +1,7 @@ open Ast open Type_internal +open Format val pp_format_ast : tannot defs -> string + +val pp_defs : Format.formatter -> tannot defs -> unit |