aboutsummaryrefslogtreecommitdiff
path: root/src/elaborator
diff options
context:
space:
mode:
authorMalte Voos <git@mal.tc>2024-07-08 23:59:31 +0200
committerMalte Voos <git@mal.tc>2024-07-08 23:59:31 +0200
commit3cf472b13c9b329b711a5c254fc6f89268a99eda (patch)
treef04d63e829246924d1c8f808a06af8ad1ff9d327 /src/elaborator
parent66cf5d3c5fff84a1cac333c1aa81a8e1f21ee6f4 (diff)
downloadtoytt-3cf472b13c9b329b711a5c254fc6f89268a99eda.tar.gz
toytt-3cf472b13c9b329b711a5c254fc6f89268a99eda.zip
implement argument lists for top-level definitions
Diffstat (limited to 'src/elaborator')
-rw-r--r--src/elaborator/Elaborator.ml27
1 files changed, 24 insertions, 3 deletions
diff --git a/src/elaborator/Elaborator.ml b/src/elaborator/Elaborator.ml
index d15a7f3..6fa44ff 100644
--- a/src/elaborator/Elaborator.ml
+++ b/src/elaborator/Elaborator.ml
@@ -128,14 +128,14 @@ and check_connective connective ~(name : Name.local) ~(base : A.expr) ~(fam : A.
end
| _ -> Error.type_mismatch (pp_val()) tp Fmt.string "type"
-and check_tp (tp : A.expr) = eval @@ check ~tp:D.Type ~tm:tp
+and check_tp (tp : A.expr) = check ~tp:D.Type ~tm:tp
and infer (tm : A.expr) : D.t * S.t =
Error.tracef ?loc:tm.loc "when inferring the type" @@ fun () ->
match tm.value with
| A.Var name -> lookup name
| A.Check (tm, tp) ->
- let tp = check_tp tp in
+ let tp = eval @@ check_tp tp in
let tm = check ~tp ~tm in
(tp, tm)
| A.App (fn, arg) -> begin match infer fn with
@@ -170,6 +170,24 @@ and infer (tm : A.expr) : D.t * S.t =
(motive_scrut, tm)
| _ -> Error.not_inferable ()
+(* elaborating definitions *)
+
+let check_def ~(args : A.arg list) ~(tp : A.expr) ~(tm : A.expr) : S.t * S.t =
+ let check_arg ((arg_name, arg_tp) : A.arg) cont () =
+ let arg_tp = check_tp arg_tp in
+ bind ~name:arg_name.value ~tp:(eval arg_tp) @@ fun _ ->
+ let (tp, tm) = cont () in
+ let tp = S.Pi (arg_name.value, arg_tp, tp) in
+ let tm = S.Lam (arg_name.value, tm) in
+ (tp, tm)
+ in
+ let check_rhs () =
+ let tp = check_tp tp in
+ let tm = check ~tp:(eval tp) ~tm in
+ (tp, tm)
+ in
+ List.fold_right check_arg args check_rhs ()
+
(* interface *)
let initial_env toplvl : env = {
@@ -187,4 +205,7 @@ let check_tp_toplevel ~(toplvl : TopLevel.t) (tp : A.expr) =
Eff.run ~env:(initial_env toplvl) @@ fun () -> check_tp tp
let infer_toplevel ~(toplvl : TopLevel.t) (tm : A.expr) =
- Eff.run ~env:(initial_env toplvl) @@ fun () -> infer tm \ No newline at end of file
+ Eff.run ~env:(initial_env toplvl) @@ fun () -> infer tm
+
+let check_def_toplevel ~(toplvl : TopLevel.t) ~(args : A.arg list) ~(tp : A.expr) ~(tm : A.expr) =
+ Eff.run ~env:(initial_env toplvl) @@ fun () -> check_def ~args ~tp ~tm \ No newline at end of file