Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
let failwithf f = Printf.ksprintf failwith f
(*
t -> bool | int
e -> true | false
| 0 | 1 | 2 | …
| e : t
| if e then e else e
*)
module Type = struct
type t = Bool | Int
let to_string = function Bool -> "bool" | Int -> "int"
end
module Term = struct
type t =
| Bool of bool
| Int of int
| Annotation of t * Type.t
| If of {conditional: t; consequence: t; alternative: t}
end
open Term
module Using_exceptions = struct
let rec infer = function
| Bool _ -> Type.Bool
| Int _ -> Type.Int
| Annotation (term, annotated_t) ->
let term_t = infer term in
if term_t <> annotated_t then
failwithf "Expected %s, but got %s"
(Type.to_string annotated_t)
(Type.to_string term_t)
else
annotated_t
| If {conditional; consequence; alternative} ->
let conditional_t = infer conditional in
let consequence_t = infer consequence in
let alternative_t = infer alternative in
if conditional_t <> Type.Bool then
failwithf "If condition must be boolean"
else if consequence_t <> alternative_t then
failwithf "If branches must match: %s vs. %s"
(Type.to_string consequence_t)
(Type.to_string alternative_t)
else
consequence_t
end
module Using_result_with_polymorphic_variant = struct
let return x = Ok x
let error x = Error x
let (let*) = Result.bind
(* or *)
let (let*) body callback = match body with
| Ok ok -> callback ok
| Error e -> Error e
let rec infer = function
| Bool _ -> return Type.Bool
| Int _ -> return Type.Int
| Annotation (term, annotated_t) ->
let* term_t = infer term in
if term_t <> annotated_t then
error (`Expected_x_got_y (annotated_t, term_t))
else
return annotated_t
| If {conditional; consequence; alternative} ->
let* conditional_t = infer conditional in
let* consequence_t = infer consequence in
let* alternative_t = infer alternative in
if conditional_t <> Type.Bool then
error `If_conditional_must_be_boolean
else if consequence_t <> alternative_t then
error (`If_branches_must_match (consequence_t,
alternative_t))
else
return consequence_t
end
module Multiple_errors_example = struct
let return x = Ok x
let error x = Error [x]
let (let*) = Result.bind
let (and*) left right = match left, right with
| Ok left, Ok right -> Ok (left, right)
| Error left, Error right -> Error (left @ right)
| Error e, _ | _, Error e -> Error e
let rec infer = function
| Bool _ -> return Type.Bool
| Int _ -> return Type.Int
| Annotation (term, annotated_t) ->
let* term_t = infer term in
if term_t <> annotated_t then
error (`Expected_x_got_y (annotated_t, term_t))
else
return annotated_t
| If {conditional; consequence; alternative} ->
let* () =
let* conditional_t = infer conditional in
if conditional_t <> Type.Bool then
error `If_conditional_must_be_boolean
else
return ()
and* result_t =
let* consequence_t = infer consequence
and* alternative_t = infer alternative in
if consequence_t <> alternative_t then
error (`If_branches_must_match (consequence_t, alternative_t))
else
return consequence_t
in
return result_t
module Test = struct
assert (infer (If {
conditional=Bool true;
consequence=Int 1;
alternative=Int 2;
}) = Ok Type.Int);
(* if 1 then 2 else true *)
assert (infer (If {
conditional=Int 1;
consequence=Int 2;
alternative=Bool true;
}) = Error [
`If_conditional_must_be_boolean;
`If_branches_must_match (Type.Int, Type.Bool);
]);
(* if (1: bool) then (2: bool) else (true: int) *)
assert (infer (If {
conditional=Annotation (Int 1, Type.Bool);
consequence=Annotation (Int 2, Type.Bool);
alternative=Annotation (Bool true, Type.Int);
}) = Error [
`Expected_x_got_y (Type.Bool, Type.Int);
`Expected_x_got_y (Type.Bool, Type.Int);
`Expected_x_got_y (Type.Int, Type.Bool);
]);
end
end
module Error_recovery_example = struct
(* invariant: match outcome with {result=None; errors=[]} -> false | _ -> true *)
type ('ok, 'error) outcome = {
result: 'ok option;
errors: 'error list;
}
module Outcome = struct
type ('ok, 'error) t = ('ok, 'error) outcome = {
result: 'ok option;
errors: 'error list;
}
let return x = {result=Some x; errors=[]}
let error x = {result=None; errors=[x]}
let recoverable_error x = {result=Some (); errors=[x]}
let (let*) body callback = match body with
| {result=None; errors} as e -> e
| {result=Some ok; errors=previous_errors} ->
let {result; errors} = callback ok in
{result; errors=previous_errors @ errors}
let (and*) left right =
let result = match left.result, right.result with
| Some left, Some right -> Some (left, right)
| _ -> None
in
{result; errors=left.errors @ right.errors}
end
open Outcome
let rec infer = function
| Bool _ -> return Type.Bool
| Int _ -> return Type.Int
| Annotation (term, annotated_t) ->
let* term_t = infer term in
let* () =
if term_t <> annotated_t then
recoverable_error (
`Expected_x_got_y (annotated_t, term_t))
else
return ()
in
return annotated_t
| If {conditional; consequence; alternative} ->
let* () =
let* conditional_t = infer conditional in
if conditional_t <> Type.Bool then
error `If_conditional_must_be_boolean
else
return ()
and* result_t =
let* consequence_t = infer consequence
and* alternative_t = infer alternative in
if consequence_t <> alternative_t then
error (`If_branches_must_match (consequence_t,
alternative_t))
else
return consequence_t
in
return result_t
module Test = struct
assert (infer (If {
conditional=Bool true;
consequence=Int 1;
alternative=Int 2;
}) = {
result=Some Type.Int;
errors=[];
});
(* if (1: bool) then (2: bool) else (true: int) *)
assert (infer (If {
conditional=Annotation (Int 1, Type.Bool);
consequence=Annotation (Int 2, Type.Bool);
alternative=Annotation (Bool true, Type.Int);
}) = {
result=None;
errors=[
`Expected_x_got_y (Type.Bool, Type.Int);
`Expected_x_got_y (Type.Bool, Type.Int);
`Expected_x_got_y (Type.Int, Type.Bool);
`If_branches_must_match (Type.Bool, Type.Int);
];
});
assert (infer (If {
conditional=Int 1;
consequence=Int 2;
alternative=Bool true;
}) = {
result=None;
errors=[
`If_conditional_must_be_boolean;
`If_branches_must_match (Type.Int, Type.Bool);
];
});
(* if true then (false: int) else 42 *)
assert (infer (If {
conditional=Bool true;
consequence=Annotation (Bool false, Type.Int);
alternative=Int 42;
}) = {
result=Some Type.Int;
errors=[
`Expected_x_got_y (Type.Int, Type.Bool);
];
});
end
end
(* Bonus: warnings *)
module Multiple_errors_and_warnings_example = struct
module Warned = struct
type ('ok, 'error, 'warning) t = {
result: ('ok, 'error list) result;
warnings: 'warning list;
}
let return x = {result=Ok x; warnings=[]}
let error x = {result=Error [x]; warnings=[]}
let warn warning = {result=Ok (); warnings=[warning]}
let (let*) body callback = match body with
| {result=Error e; warnings} as w -> w
| {result=Ok ok; warnings=previous_warnings} ->
let {result; warnings} = callback ok in
{result; warnings=previous_warnings @ warnings}
let (and*) left right =
let warnings = left.warnings @ right.warnings in
let result = match left.result, right.result with
| Ok left, Ok right -> Ok (left, right)
| Error left, Error right -> Error (left @ right)
| Error e, _ | _, Error e -> Error e in
{result; warnings}
(*
let product left right = match left, right with
| Ok left, Ok right -> Ok (left, right)
| Error left, Error right -> Error (left @ right)
| (Error _ as e), _ | _, (Error _ as e) -> e
let (and* ) left right =
let result = product left.result right.result in
{result; warnings=left.warnings @ right.warnings}
*)
end
open Warned
let rec infer = function
| Bool _ -> return Type.Bool
| Int _ -> return Type.Int
| Annotation (term, annotated_t) ->
let* term_t = infer term in
if term_t <> annotated_t then
error (`Expected_x_got_y (annotated_t, term_t))
else
return annotated_t
| If {conditional; consequence; alternative} ->
let* () =
let* conditional_t = infer conditional in
if conditional_t <> Type.Bool then
error `If_conditional_must_be_boolean
else
match conditional with
| Bool value ->
warn (`Conditional_always value)
| _ ->
return ()
and* result_t =
let* consequence_t = infer consequence
and* alternative_t = infer alternative in
if consequence_t <> alternative_t then
error (`If_branches_must_match (consequence_t,
alternative_t))
else
return consequence_t
in
return result_t
module Test = struct
assert (infer (If {
conditional=Bool true;
consequence=Int 1;
alternative=Int 2;
}) = {
result=Ok Type.Int;
warnings=[`Conditional_always true];
});
assert (infer (If {
conditional=Annotation (Int 1, Type.Bool);
consequence=Annotation (Int 1, Type.Bool);
alternative=Annotation (Bool true, Type.Int);
}) = {
result=Error [
`Expected_x_got_y (Type.Bool, Type.Int);
`Expected_x_got_y (Type.Bool, Type.Int);
`Expected_x_got_y (Type.Int, Type.Bool);
];
warnings=[];
});
assert (infer (If {
conditional=Int 1;
consequence=Int 2;
alternative=Bool true;
}) = {
result=Error ([
`If_conditional_must_be_boolean;
`If_branches_must_match (Type.Int, Type.Bool);
]);
warnings=[];
});
end
end
let () = print_endline "."
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment