aboutsummaryrefslogtreecommitdiff
path: root/src/elaborator
diff options
context:
space:
mode:
Diffstat (limited to 'src/elaborator')
-rw-r--r--src/elaborator/Elaborator.ml34
-rw-r--r--src/elaborator/dune2
2 files changed, 18 insertions, 18 deletions
diff --git a/src/elaborator/Elaborator.ml b/src/elaborator/Elaborator.ml
index 0f72f24..df2a358 100644
--- a/src/elaborator/Elaborator.ml
+++ b/src/elaborator/Elaborator.ml
@@ -26,9 +26,9 @@ let lookup (id : Ident.t) : D.t * S.t = match Ident.to_local id with
| Some ix ->
let tp = Bwd.nth env.tps ix in
(tp, S.Var ix)
- | None -> Reporter.unbound_variable id
+ | None -> Error.unbound_variable id
end
- | None -> Reporter.unbound_variable id
+ | None -> Error.unbound_variable id
let bind ~(name : Ident.local) ~(tp : D.t) f =
let arg = D.var (Eff.read()).size in
@@ -58,61 +58,61 @@ let pp () = let names = (Eff.read()).names in fun fmt tm ->
(** Main algorithm *)
let rec check ~(tm : A.expr) ~(tp : D.t) : S.t =
- Reporter.tracef ?loc:tm.loc "when checking against the type @[%a@]" (pp()) (quote tp) @@ fun () ->
+ Error.tracef ?loc:tm.loc "when checking against the type @[%a@]" (pp()) (quote tp) @@ fun () ->
match tm.value with
| A.Pi ((name, base), fam) -> begin match tp with
| D.Type ->
let base = check ~tm:base ~tp in
let fam = bind ~name:name.value ~tp:(eval base) @@ fun _ -> check ~tm:fam ~tp in
S.Pi (name.value, base, fam)
- | _ -> Reporter.fatalf Reporter.Message.IllTyped "expected an element of type @[%a@], but found an element of a universe" (pp()) (quote tp) end
+ | _ -> Error.fatalf Error.Message.IllTyped "expected an element of type @[%a@], but found an element of a universe" (pp()) (quote tp) end
| A.Lam (name, body) -> begin match tp with
| D.Pi (_, base, fam) ->
let body = bind ~name:name.value ~tp:base @@ fun arg ->
let fib = NbE.inst_clo fam arg in
check ~tm:body ~tp:fib in
S.Lam (name.value, body)
- | _ -> Reporter.fatalf Reporter.Message.IllTyped "expected an element of type @[%a@], but found an element of a Pi type" (pp()) (quote tp)
+ | _ -> Error.fatalf Error.Message.IllTyped "expected an element of type @[%a@], but found an element of a Pi type" (pp()) (quote tp)
end
| A.Sg ((name, base), fam) -> begin match tp with
| D.Type ->
let base = check ~tm:base ~tp in
let fam = bind ~name:name.value ~tp:(eval base) @@ fun _ -> check ~tm:fam ~tp in
S.Sg (name.value, base, fam)
- | _ -> Reporter.fatalf Reporter.Message.IllTyped "expected an element of type @[%a@], but found an element of a universe" (pp()) (quote tp) end
+ | _ -> Error.fatalf Error.Message.IllTyped "expected an element of type @[%a@], but found an element of a universe" (pp()) (quote tp) end
| A.Pair (fst, snd) -> begin match tp with
| D.Sg (_, base, fam) ->
let fst = check ~tm:fst ~tp:base in
let fib = NbE.inst_clo fam (eval fst) in
let snd = check ~tm:snd ~tp:fib in
S.Pair (fst, snd)
- | _ -> Reporter.fatalf Reporter.Message.IllTyped "expected an element of type @[%a@], but found an element of a Sigma type" (pp()) (quote tp)
+ | _ -> Error.fatalf Error.Message.IllTyped "expected an element of type @[%a@], but found an element of a Sigma type" (pp()) (quote tp)
end
| A.Type -> begin match tp with (* TODO type-in-type *)
| D.Type -> S.Type
- | _ -> Reporter.fatalf Reporter.Message.IllTyped "expected an element of type @[%a@], but found an element of a universe" (pp()) (quote tp)
+ | _ -> Error.fatalf Error.Message.IllTyped "expected an element of type @[%a@], but found an element of a universe" (pp()) (quote tp)
end
| A.Bool -> begin match tp with
| D.Type -> S.Bool
- | _ -> Reporter.fatalf Reporter.Message.IllTyped "expected an element of type @[%a@], but found an element of a universe" (pp()) (quote tp)
+ | _ -> Error.fatalf Error.Message.IllTyped "expected an element of type @[%a@], but found an element of a universe" (pp()) (quote tp)
end
| A.True -> begin match tp with
| D.Bool -> S.True
- | _ -> Reporter.fatalf Reporter.Message.IllTyped "expected an element of type @[%a@], but found an element of type Bool" (pp()) (quote tp)
+ | _ -> Error.fatalf Error.Message.IllTyped "expected an element of type @[%a@], but found an element of type Bool" (pp()) (quote tp)
end
| A.False -> begin match tp with
| D.Bool -> S.False
- | _ -> Reporter.fatalf Reporter.Message.IllTyped "expected an element of type @[%a@], but found an element of type Bool" (pp()) (quote tp)
+ | _ -> Error.fatalf Error.Message.IllTyped "expected an element of type @[%a@], but found an element of type Bool" (pp()) (quote tp)
end
| _ -> let (inferred_tp, tm) = infer tm in begin
try NbE.equate ~size:((Eff.read()).size) inferred_tp tp with
| NbE.Unequal ->
- Reporter.fatalf Reporter.Message.IllTyped "expected an element of type @[%a@], but found an element of type @[%a@]" (pp()) (quote tp) (pp()) (quote inferred_tp)
+ Error.fatalf Error.Message.IllTyped "expected an element of type @[%a@], but found an element of type @[%a@]" (pp()) (quote tp) (pp()) (quote inferred_tp)
end;
tm
and infer (tm : A.expr) : D.t * S.t =
- Reporter.tracef ?loc:tm.loc "when inferring the type" @@ fun () ->
+ Error.tracef ?loc:tm.loc "when inferring the type" @@ fun () ->
match tm.value with
| A.Var name -> lookup name
| A.Check (tm, tp) ->
@@ -125,18 +125,18 @@ and infer (tm : A.expr) : D.t * S.t =
let tp = NbE.inst_clo fam (eval arg) in
let tm = S.App (fn, arg) in
(tp, tm)
- | _ -> Reporter.fatalf Reporter.Message.IllTyped "cannot apply this term because it is not a function"
+ | _ -> Error.fatalf Error.Message.IllTyped "cannot apply this term because it is not a function"
end
| A.Fst p -> begin match infer p with
| (D.Sg (_, base, _), p) -> (base, S.Fst p)
- | _ -> Reporter.fatalf Reporter.Message.IllTyped "cannot apply first projection to this term because it is not of sigma type"
+ | _ -> Error.fatalf Error.Message.IllTyped "cannot apply first projection to this term because it is not of sigma type"
end
| A.Snd p -> begin match infer p with
| (D.Sg (_, _, fam), p) ->
let tp = NbE.inst_clo fam (eval (S.Fst p)) in
let tm = S.Snd p in
(tp, tm)
- | _ -> Reporter.fatalf Reporter.Message.IllTyped "cannot apply second projection to this term because it is of sigma type"
+ | _ -> Error.fatalf Error.Message.IllTyped "cannot apply second projection to this term because it is of sigma type"
end
| A.BoolElim { motive_var; motive_body; true_case; false_case; scrut } ->
let scrut = check ~tm:scrut ~tp:D.Bool in
@@ -149,7 +149,7 @@ and infer (tm : A.expr) : D.t * S.t =
let false_case = check ~tm:false_case ~tp:motive_false in
let tm = S.BoolElim { motive_var = motive_var.value; motive; true_case; false_case; scrut } in
(motive_scrut, tm)
- | _ -> Reporter.fatalf Reporter.Message.CannotInferType "cannot infer type"
+ | _ -> Error.fatalf Error.Message.CannotInferType "cannot infer type"
let empty_env : env = {
tps = Emp;
diff --git a/src/elaborator/dune b/src/elaborator/dune
index 46227f0..941027a 100644
--- a/src/elaborator/dune
+++ b/src/elaborator/dune
@@ -8,4 +8,4 @@
toytt.ident
toytt.nbe
toytt.pretty
- toytt.reporter))
+ toytt.error))