Top
This file has been processed with:
Hiding administrative data
(code in tests
/
exprbis
.
ml
, run with
./
ocamlorn
tests
/
stdlib
.
mli
tests
/
exprbis
.
ml
)
We described the code for a simple interpreter.
We start with some library functions (should be part of stdlib)
type 'a option =
| Some of 'a
| None
type 'a list =
| Nil
| Cons of 'a * 'a list |
And a few functions on lists:
let rec find x l = match l with
| Cons ((k,v), t) ->
begin match equal k x with True -> Some v | _ -> find x t end
| Nil -> None
let rec remove x l = match l with
| Cons (h, t) ->
let t' = remove x t in
begin match equal x h with True -> t' | False -> Cons (h, t') end
| Nil -> Nil
let rec append l1 l2 = match l1 with
| Cons (h, t) -> Cons (h, append t l2)
| Nil -> l2 |
Here is the abstract syntax of the lambda-calculus with constants:
type expr =
| Var of string
| Abs of string * expr
| App of expr * expr
| Const of int |
and its evalation function:
let rec eval env e = match e with
| Var x ->
begin match find x env with
| Some v -> Some v
| None -> None
end
| App (u, v) ->
begin match eval env u with
| Some (Abs (x, f)) ->
begin match eval env v with
| Some w -> eval (Cons ((x, w), env)) f
| None -> None
end
| Some w -> None
| None -> None
end
| v -> Some v |
As a first step, we want to a better treatment of erronesous evaluation by
returning not some an None
in case of failure but also a string
indicating the source of the error. We assume defined two messages:
val str__Unbound_variable : string
val str__Not_a_function : string |
The result of the evaluation will be a ornamented version of the option
type:
type ('a,'err) result =
| Ok of 'a
| Error of 'err |
type ornament ('a, 'err) optres : 'a option => ('a, 'err) result with
| Some a => Ok a
| None => Error _ |
We may then lift the eval
function at the expected type:
let eval_mes_ =
lifting eval : _ -> _ -> ('a, 'err) optres with
ornament * <- @id |
This is incomplete:
let rec eval_mes_ env e = match e with
| Var x ->
begin match find x env with
| Some a -> Ok a
| None -> Error #30
end
| App(u, v) ->
begin match eval_mes_ env u with
| Ok (Abs(x, f)) ->
begin match eval_mes_ env v with
| Ok a -> eval_mes_ (Cons((x, a), env)) f
| Error _ -> Error #14
end
| Ok (Var _) -> Error #22
| Ok (App(_, _)) -> Error #12
| Ok (Const _) -> Error #10
| Error _ -> Error #8
end
| (Abs (_, _) | Const _) -> Ok e |
Indeed, we must indicate for each source of error the
right message to report to the user:
let eval_mes =
lifting eval : _ -> _ -> ('a, 'err) optres with
ornament * <- @id
patch #30[str__Unbound_variable]
patch (match _a with Ok _ -> Error (#[str__Not_a_function]))
patch (match _a with Error a -> Error (#[a])) |
let rec eval_mes env e = match e with
| Var x ->
begin match find x env with
| Some a -> Ok a
| None -> Error str__Unbound_variable
end
| App(u, v) ->
begin match eval_mes env u with
| Ok (Abs(x, f)) ->
begin match eval_mes env v with
| Ok a -> eval_mes (Cons((x, a), env)) f
| Error x -> Error x
end
| ((Ok (Var _) | Ok (App(_, _))) | Ok (Const _)) ->
Error str__Not_a_function
| Error x -> Error x
end
| (Abs (_, _) | Const _) -> Ok e |
To further improve error reporting, with the source location of the
error. We need a type extended with locations, and a result
type
to return either a value or the location of the error.
type location = Location of string * int * int |
Remark that instead of attaching locations directly to the constructor, one
would rather systematically lift locations to the
type expr_loc = expr' * location
and expr' =
| Var' of string
| Abs' of (string * expr_loc)
| App' of expr_loc * expr_loc
| Const' of int |
However, our prototype does not implement type abbraviation yet. Hence to
fit with these syntactic restriction, we may equivalently defined:
type expr' =
| Var' of string
| Abs' of string * (expr' * location)
| App' of (expr' * location) * (expr' * location)
| Const' of int |
and use expr' loc
instead of expr_loc
:
type ornament add_loc : expr => expr' * location with
| Var x => (Var' x, _)
| Abs (x, f) => (Abs' (x, f), _) when f : add_loc
| App (u, v) => (App' (u, v), _) when u v : add_loc
| Const i => (Const' i, _) |
type ornament ('a, 'mes, 'err) optres' : ('a, 'mes) result
=> ('a, 'mes * 'err) result with
| Ok a => Ok a
| Error b => Error (b, _) |
let _eval_loc =
lifting eval_mes :
(_ * add_loc) list -> add_loc -> (_, _, _) optres'
with ornament * <- @id |
We get the following program:
let rec _eval_loc env e = match e with
| (Var' x, _) ->
begin match find x env with
| Some a -> Ok a
| None -> Error (str__Unbound_variable, #33)
end
| (App'(u, v), _) ->
begin match _eval_loc env u with
| Ok (Abs'(x, f), _) ->
begin match _eval_loc env v with
| Ok a -> _eval_loc (Cons((x, a), env)) f
| Error (b, _) -> Error (b, #16)
end
| Ok (Var' _, _) -> Error (str__Not_a_function, #24)
| Ok (App'(_, _), _) ->
Error (str__Not_a_function, #13)
| Ok (Const' _, _) ->
Error (str__Not_a_function, #10)
| Error (b, _) -> Error (b, #8)
end
| ((Abs'(_, _), _) | (Const' _, _)) -> Ok e |
Which we can patch similarly:
let eval_loc =
lifting eval_mes : (_ * add_loc) list -> add_loc
-> (_, _, _) optres' with
ornament * <- @id
patch #33[begin match e with (_, loc) -> loc (* unbound *) end]
patch match _a with Ok(_, _b) -> Error (_c, (#[_b]))
patch match _a with Error(_, _b) -> Error (_c, (#[_b])) |
let rec eval_loc env e = match e with
| (Var' x, loc) ->
begin match find x env with
| Some a -> Ok a
| None -> Error (str__Unbound_variable, loc)
end
| (App'(u, v), _) ->
begin match eval_loc env u with
| Ok (Abs'(x, f), _) ->
begin match eval_loc env v with
| Ok a -> eval_loc (Cons((x, a), env)) f
| Error (b, x) -> Error (b, x)
end
| ((Ok (Var' _, x) | Ok (App'(_, _), x))
| Ok (Const' _, x)) ->
Error (str__Not_a_function, x)
| Error (b, x) -> Error (b, x)
end
| ((Abs'(_, _), _) | (Const' _, _)) -> Ok e |
If we were not interested in the locations in the output, we could simply write:
let _eval_loc =
lifting eval_mes : (_ * add_loc) list -> add_loc -> _ with
ornament * <- @id |
let rec _eval_loc env e = match e with
| (Var' x, _) ->
begin match find x env with
| Some a -> Ok a
| None -> Error str__Unbound_variable
end
| (App'(u, v), _) ->
begin match _eval_loc env u with
| Ok (Abs'(x, f), _) ->
begin match _eval_loc env v with
| Ok a -> _eval_loc (Cons((x, a), env)) f
| Error x -> Error x
end
| ((Ok (Var' _, _) | Ok (App'(_, _), _))
| Ok (Const' _, _)) -> Error str__Not_a_function
| Error x -> Error x
end
| ((Abs'(_, _), _) | (Const' _, _)) -> Ok e |
which does not need any patch.
Listing free variables
let rec free_vars e = match e with
| Var x -> Cons (x, Nil)
| Abs (x, f) -> remove x (free_vars f)
| App (u, v) -> append (free_vars u) (free_vars v)
| Const i -> Nil |
let free_vars_loc = lifting free_vars : add_loc -> string list
with ornament * <- @id |
let rec free_vars_loc e = match e with
| (Var' x, _) -> Cons(x, Nil)
| (Abs'(x, f), _) -> remove x (free_vars_loc f)
| (App'(u, v), _) ->
append (free_vars_loc u) (free_vars_loc v)
| (Const' _, _) -> Nil |