debug utils
This commit is contained in:
parent
b349849b80
commit
91e62c04f6
6 changed files with 55 additions and 0 deletions
27
lib/term.ml
27
lib/term.ml
|
@ -19,3 +19,30 @@ type t =
|
||||||
| Fun of Identifier.t * t
|
| Fun of Identifier.t * t
|
||||||
| App of t * t
|
| App of t * t
|
||||||
[@@deriving eq, ord, show]
|
[@@deriving eq, ord, show]
|
||||||
|
|
||||||
|
let rec string_of_term = function
|
||||||
|
| Var v -> "Var '" ^ v ^ "'"
|
||||||
|
| IntConst n -> "IntConst(" ^ string_of_int n ^ ")"
|
||||||
|
| Binop (a, b, c) ->
|
||||||
|
"Binop ("
|
||||||
|
^ string_of_term a
|
||||||
|
^ ", "
|
||||||
|
^ (match b with
|
||||||
|
| Plus -> "+"
|
||||||
|
| Minus -> "-"
|
||||||
|
| Times -> "*"
|
||||||
|
| Div -> "/")
|
||||||
|
^ string_of_term c
|
||||||
|
^ ")"
|
||||||
|
| Pair (a, b) -> "Pair (" ^ string_of_term a ^ ", " ^ string_of_term b ^ ")"
|
||||||
|
| Proj (a, b) ->
|
||||||
|
"Proj ("
|
||||||
|
^ (match a with
|
||||||
|
| First -> "fst"
|
||||||
|
| Second -> "snd")
|
||||||
|
^ ", "
|
||||||
|
^ string_of_term b
|
||||||
|
^ ")"
|
||||||
|
| Fun (a, b) -> "Fun ('" ^ a ^ "', " ^ string_of_term b ^ ")"
|
||||||
|
| App (a, b) -> "App (" ^ string_of_term a ^ ", " ^ string_of_term b ^ ")"
|
||||||
|
;;
|
||||||
|
|
|
@ -26,3 +26,6 @@ type t =
|
||||||
| Fun of Identifier.t * t
|
| Fun of Identifier.t * t
|
||||||
| App of t * t
|
| App of t * t
|
||||||
[@@deriving eq, ord, show]
|
[@@deriving eq, ord, show]
|
||||||
|
|
||||||
|
(* Term to string *)
|
||||||
|
val string_of_term : t -> string
|
||||||
|
|
|
@ -4,3 +4,10 @@ type t =
|
||||||
| Product of t * t
|
| Product of t * t
|
||||||
| Arrow of t * t
|
| Arrow of t * t
|
||||||
[@@deriving eq, ord, show]
|
[@@deriving eq, ord, show]
|
||||||
|
|
||||||
|
let rec string_of_type = function
|
||||||
|
| Var v -> "Var '" ^ v ^ "'"
|
||||||
|
| Int -> "Int"
|
||||||
|
| Product (a, b) -> "Product(" ^ string_of_type a ^ ", " ^ string_of_type b ^ ")"
|
||||||
|
| Arrow (a, b) -> "Arrow(" ^ string_of_type a ^ ", " ^ string_of_type b ^ ")"
|
||||||
|
;;
|
||||||
|
|
|
@ -4,3 +4,6 @@ type t =
|
||||||
| Product of t * t
|
| Product of t * t
|
||||||
| Arrow of t * t
|
| Arrow of t * t
|
||||||
[@@deriving eq, ord, show]
|
[@@deriving eq, ord, show]
|
||||||
|
|
||||||
|
(* Type to string *)
|
||||||
|
val string_of_type : t -> string
|
||||||
|
|
|
@ -38,4 +38,18 @@ let compose s2 s1 =
|
||||||
s2
|
s2
|
||||||
;;
|
;;
|
||||||
|
|
||||||
|
let to_string map =
|
||||||
|
let rec ty_str = function
|
||||||
|
| Type.Var s -> "Var('" ^ s ^ "')"
|
||||||
|
| Type.Int -> "Int"
|
||||||
|
| Type.Product (a, b) -> "Product(" ^ ty_str a ^ ", " ^ ty_str b ^ ")"
|
||||||
|
| Type.Arrow (a, b) -> "Arrow(" ^ ty_str a ^ ", " ^ ty_str b ^ ")"
|
||||||
|
in
|
||||||
|
"{"
|
||||||
|
^ (IdentifierMap.bindings map
|
||||||
|
|> List.map (fun (id, ty) -> Printf.sprintf "'%s' typed as %s" id (ty_str ty))
|
||||||
|
|> String.concat "\n")
|
||||||
|
^ "}"
|
||||||
|
;;
|
||||||
|
|
||||||
let find = IdentifierMap.find_opt
|
let find = IdentifierMap.find_opt
|
||||||
|
|
|
@ -7,3 +7,4 @@ val compose : t -> t -> t
|
||||||
val empty : t
|
val empty : t
|
||||||
val singleton : Identifier.t -> Type.t -> t
|
val singleton : Identifier.t -> Type.t -> t
|
||||||
val find : Identifier.t -> t -> Type.t option
|
val find : Identifier.t -> t -> Type.t option
|
||||||
|
val to_string : t -> string
|
||||||
|
|
Reference in a new issue