X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_notation%2FcicNotationPp.ml;fp=helm%2Focaml%2Fcic_notation%2FcicNotationPp.ml;h=d51d1a65ec37dd14aaac2cd8307370bda65a7926;hb=1ca0ec89cfc2c3f85af95d5b1bdad07597d976bd;hp=9118d1c11d359c4c9767252ee0cb7e290cd6ab9e;hpb=172e33ea0aabf7ef066e73fbe577061955327693;p=helm.git diff --git a/helm/ocaml/cic_notation/cicNotationPp.ml b/helm/ocaml/cic_notation/cicNotationPp.ml index 9118d1c11..d51d1a65e 100644 --- a/helm/ocaml/cic_notation/cicNotationPp.ml +++ b/helm/ocaml/cic_notation/cicNotationPp.ml @@ -25,8 +25,8 @@ open Printf -open CicNotationEnv -open CicNotationPt +module Ast = CicNotationPt +module Env = CicNotationEnv (* when set to true debugging information, not in sync with input syntax, will * be added to the output of pp_term. @@ -53,34 +53,34 @@ let pp_literal = function (* debugging version *) let rec pp_term ?(pp_parens = true) t = let t_pp = match t with - | AttributedTerm (`Href _, term) when debug_printing -> + | Ast.AttributedTerm (`Href _, term) when debug_printing -> sprintf "#[%s]" (pp_term ~pp_parens:false term) - | AttributedTerm (`IdRef id, term) when debug_printing -> + | Ast.AttributedTerm (`IdRef id, term) when debug_printing -> sprintf "x(%s)[%s]" id (pp_term ~pp_parens:false term) - | AttributedTerm (_, term) when debug_printing -> + | Ast.AttributedTerm (_, term) when debug_printing -> sprintf "@[%s]" (pp_term ~pp_parens:false term) - | AttributedTerm (`Raw text, _) -> text - | AttributedTerm (_, term) -> pp_term ~pp_parens:false term + | Ast.AttributedTerm (`Raw text, _) -> text + | Ast.AttributedTerm (_, term) -> pp_term ~pp_parens:false term - | Appl terms -> + | Ast.Appl terms -> sprintf "%s" (String.concat " " (List.map pp_term terms)) - | Binder (`Forall, (Ident ("_", None), typ), body) - | Binder (`Pi, (Ident ("_", None), typ), body) -> + | Ast.Binder (`Forall, (Ast.Ident ("_", None), typ), body) + | Ast.Binder (`Pi, (Ast.Ident ("_", None), typ), body) -> sprintf "%s \\to %s" (match typ with None -> "?" | Some typ -> pp_term typ) (pp_term body) - | Binder (kind, var, body) -> + | Ast.Binder (kind, var, body) -> sprintf "\\%s %s.%s" (pp_binder kind) (pp_capture_variable var) (pp_term body) - | Case (term, indtype, typ, patterns) -> + | Ast.Case (term, indtype, typ, patterns) -> sprintf "%smatch %s with %s" (match typ with None -> "" | Some t -> sprintf "[%s]" (pp_term t)) (pp_term term) (pp_patterns patterns) - | Cast (t1, t2) -> sprintf "(%s: %s)" (pp_term t1) (pp_term t2) - | LetIn (var, t1, t2) -> + | Ast.Cast (t1, t2) -> sprintf "(%s: %s)" (pp_term t1) (pp_term t2) + | Ast.LetIn (var, t1, t2) -> sprintf "let %s = %s in %s" (pp_capture_variable var) (pp_term t1) (pp_term t2) - | LetRec (kind, definitions, term) -> + | Ast.LetRec (kind, definitions, term) -> sprintf "let %s %s in %s" (match kind with `Inductive -> "rec" | `CoInductive -> "corec") (String.concat " and " @@ -89,30 +89,30 @@ let rec pp_term ?(pp_parens = true) t = sprintf "%s = %s" (pp_capture_variable var) (pp_term body)) definitions)) (pp_term term) - | Ident (name, Some []) | Ident (name, None) - | Uri (name, Some []) | Uri (name, None) -> + | Ast.Ident (name, Some []) | Ast.Ident (name, None) + | Ast.Uri (name, Some []) | Ast.Uri (name, None) -> name - | Ident (name, Some substs) - | Uri (name, Some substs) -> + | Ast.Ident (name, Some substs) + | Ast.Uri (name, Some substs) -> sprintf "%s \\subst [%s]" name (pp_substs substs) - | Implicit -> "?" - | Meta (index, substs) -> + | Ast.Implicit -> "?" + | Ast.Meta (index, substs) -> sprintf "%d[%s]" index (String.concat "; " (List.map (function None -> "_" | Some t -> pp_term t) substs)) - | Num (num, _) -> num - | Sort `Set -> "Set" - | Sort `Prop -> "Prop" - | Sort `Type -> "Type" - | Sort `CProp -> "CProp" - | Symbol (name, _) -> "'" ^ name - - | UserInput -> "" - - | Literal l -> pp_literal l - | Layout l -> pp_layout l - | Magic m -> pp_magic m - | Variable v -> pp_variable v + | Ast.Num (num, _) -> num + | Ast.Sort `Set -> "Set" + | Ast.Sort `Prop -> "Prop" + | Ast.Sort `Type -> "Type" + | Ast.Sort `CProp -> "CProp" + | Ast.Symbol (name, _) -> "'" ^ name + + | Ast.UserInput -> "" + + | Ast.Literal l -> pp_literal l + | Ast.Layout l -> pp_layout l + | Ast.Magic m -> pp_magic m + | Ast.Variable v -> pp_variable v in if pp_parens then sprintf "(%s)" t_pp else t_pp @@ -139,43 +139,46 @@ and pp_capture_variable = function and pp_box_spec (kind, spacing, indent) = let int_of_bool b = if b then 1 else 0 in let kind_string = - match kind with H -> "H" | V -> "V" | HV -> "HV" | HOV -> "HOV" + match kind with + Ast.H -> "H" | Ast.V -> "V" | Ast.HV -> "HV" | Ast.HOV -> "HOV" in sprintf "%sBOX%d%d" kind_string (int_of_bool spacing) (int_of_bool indent) and pp_layout = function - | Sub (t1, t2) -> sprintf "%s \\SUB %s" (pp_term t1) (pp_term t2) - | Sup (t1, t2) -> sprintf "%s \\SUP %s" (pp_term t1) (pp_term t2) - | Below (t1, t2) -> sprintf "%s \\BELOW %s" (pp_term t1) (pp_term t2) - | Above (t1, t2) -> sprintf "%s \\ABOVE %s" (pp_term t1) (pp_term t2) - | Over (t1, t2) -> sprintf "[%s \\OVER %s]" (pp_term t1) (pp_term t2) - | Atop (t1, t2) -> sprintf "[%s \\ATOP %s]" (pp_term t1) (pp_term t2) - | Frac (t1, t2) -> sprintf "\\FRAC %s %s" (pp_term t1) (pp_term t2) - | Sqrt t -> sprintf "\\SQRT %s" (pp_term t) - | Root (arg, index) -> + | Ast.Sub (t1, t2) -> sprintf "%s \\SUB %s" (pp_term t1) (pp_term t2) + | Ast.Sup (t1, t2) -> sprintf "%s \\SUP %s" (pp_term t1) (pp_term t2) + | Ast.Below (t1, t2) -> sprintf "%s \\BELOW %s" (pp_term t1) (pp_term t2) + | Ast.Above (t1, t2) -> sprintf "%s \\ABOVE %s" (pp_term t1) (pp_term t2) + | Ast.Over (t1, t2) -> sprintf "[%s \\OVER %s]" (pp_term t1) (pp_term t2) + | Ast.Atop (t1, t2) -> sprintf "[%s \\ATOP %s]" (pp_term t1) (pp_term t2) + | Ast.Frac (t1, t2) -> sprintf "\\FRAC %s %s" (pp_term t1) (pp_term t2) + | Ast.Sqrt t -> sprintf "\\SQRT %s" (pp_term t) + | Ast.Root (arg, index) -> sprintf "\\ROOT %s \\OF %s" (pp_term index) (pp_term arg) - | Break -> "\\BREAK" + | Ast.Break -> "\\BREAK" (* | Space -> "\\SPACE" *) - | Box (box_spec, terms) -> + | Ast.Box (box_spec, terms) -> sprintf "\\%s [%s]" (pp_box_spec box_spec) (String.concat " " (List.map pp_term terms)) - | Group terms -> + | Ast.Group terms -> sprintf "\\GROUP [%s]" (String.concat " " (List.map pp_term terms)) and pp_magic = function - | List0 (t, sep_opt) -> sprintf "list0 %s%s" (pp_term t) (pp_sep_opt sep_opt) - | List1 (t, sep_opt) -> sprintf "list1 %s%s" (pp_term t) (pp_sep_opt sep_opt) - | Opt t -> sprintf "opt %s" (pp_term t) - | Fold (kind, p_base, names, p_rec) -> + | Ast.List0 (t, sep_opt) -> + sprintf "list0 %s%s" (pp_term t) (pp_sep_opt sep_opt) + | Ast.List1 (t, sep_opt) -> + sprintf "list1 %s%s" (pp_term t) (pp_sep_opt sep_opt) + | Ast.Opt t -> sprintf "opt %s" (pp_term t) + | Ast.Fold (kind, p_base, names, p_rec) -> let acc = match names with acc :: _ -> acc | _ -> assert false in sprintf "fold %s %s rec %s %s" (pp_fold_kind kind) (pp_term p_base) acc (pp_term p_rec) - | Default (p_some, p_none) -> + | Ast.Default (p_some, p_none) -> sprintf "default %s %s" (pp_term p_some) (pp_term p_none) - | If (p_test, p_true, p_false) -> + | Ast.If (p_test, p_true, p_false) -> sprintf "if %s then %s else %s" (pp_term p_test) (pp_term p_true) (pp_term p_false) - | Fail -> "fail" + | Ast.Fail -> "fail" and pp_fold_kind = function | `Left -> "left" @@ -186,29 +189,29 @@ and pp_sep_opt = function | Some sep -> sprintf " sep %s" (pp_literal sep) and pp_variable = function - | NumVar s -> "number " ^ s - | IdentVar s -> "ident " ^ s - | TermVar s -> "term " ^ s - | Ascription (t, n) -> assert false - | FreshVar n -> "fresh " ^ n + | Ast.NumVar s -> "number " ^ s + | Ast.IdentVar s -> "ident " ^ s + | Ast.TermVar s -> "term " ^ s + | Ast.Ascription (t, n) -> assert false + | Ast.FreshVar n -> "fresh " ^ n let pp_term t = pp_term ~pp_parens:false t let rec pp_value = function - | TermValue t -> sprintf "$%s$" (pp_term t) - | StringValue s -> sprintf "\"%s\"" s - | NumValue n -> n - | OptValue (Some v) -> "Some " ^ pp_value v - | OptValue None -> "None" - | ListValue l -> sprintf "[%s]" (String.concat "; " (List.map pp_value l)) + | Env.TermValue t -> sprintf "$%s$" (pp_term t) + | Env.StringValue s -> sprintf "\"%s\"" s + | Env.NumValue n -> n + | Env.OptValue (Some v) -> "Some " ^ pp_value v + | Env.OptValue None -> "None" + | Env.ListValue l -> sprintf "[%s]" (String.concat "; " (List.map pp_value l)) let rec pp_value_type = function - | TermType -> "Term" - | StringType -> "String" - | NumType -> "Number" - | OptType t -> "Maybe " ^ pp_value_type t - | ListType l -> "List " ^ pp_value_type l + | Env.TermType -> "Term" + | Env.StringType -> "String" + | Env.NumType -> "Number" + | Env.OptType t -> "Maybe " ^ pp_value_type t + | Env.ListType l -> "List " ^ pp_value_type l let pp_env env = String.concat "; "