Skip to content

Commit 72ed0eb

Browse files
committed
refactor: simplify examples
1 parent e190580 commit 72ed0eb

File tree

1 file changed

+17
-19
lines changed

1 file changed

+17
-19
lines changed

examples/stlc/Checker.ml

Lines changed: 17 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -13,18 +13,18 @@ struct
1313
let bind_var nm tp k =
1414
Reader.scope (fun env -> Snoc(env, (nm, tp))) k
1515

16-
let lookup ?loc nm =
16+
let lookup nm =
1717
let ctx = Reader.read () in
1818
match Bwd.find_opt (fun (nm', _) -> String.equal nm nm') ctx with
1919
| Some (_, tp) -> tp
2020
| None ->
21-
Reporter.fatalf ?loc `UnboundVariable "variable '%s' is not in scope" nm
21+
Reporter.fatalf `UnboundVariable "variable '%s' is not in scope" nm
2222

23-
let expected_connective ?loc conn tp =
24-
Reporter.fatalf ?loc `TypeError "expected a %s, but got %a" conn pp_tp tp
23+
let expected_connective conn tp =
24+
Reporter.fatalf `TypeError "expected a %s, but got %a" conn pp_tp tp
2525

26-
let rec equate ?loc expected actual =
27-
Reporter.tracef ?loc "when equating terms" @@ fun () ->
26+
let rec equate expected actual =
27+
Reporter.tracef "when equating terms" @@ fun () ->
2828
match expected, actual with
2929
| Fun (a0, b0), Fun (a1, b1) ->
3030
equate a0 a1;
@@ -35,7 +35,7 @@ struct
3535
| Nat, Nat ->
3636
()
3737
| _, _ ->
38-
Reporter.fatalf ?loc `TypeError "expected type %a, but got %a" pp_tp expected pp_tp actual
38+
Reporter.fatalf `TypeError "expected type %a, but got %a" pp_tp expected pp_tp actual
3939

4040
let rec chk (tm : tm) (tp : tp) : unit =
4141
Reporter.tracef ?loc:tm.loc "when checking it against %a" Syntax.pp_tp tp @@ fun () ->
@@ -44,53 +44,53 @@ struct
4444
bind_var nm a @@ fun () ->
4545
chk body b
4646
| Lam (_, _), _ ->
47-
expected_connective ?loc:tm.loc "function type" tp
47+
expected_connective "function type" tp
4848
| Pair (l, r), Tuple (a, b) ->
4949
chk l a;
5050
chk r b;
5151
| Pair (_, _), _ ->
52-
expected_connective ?loc:tm.loc "pair type" tp
52+
expected_connective "pair type" tp
5353
| Lit _, Nat ->
5454
()
5555
| Lit _, _ ->
56-
expected_connective ?loc:tm.loc "" tp
56+
expected_connective "" tp
5757
| Suc n, Nat ->
5858
chk n Nat
5959
| Suc _, _ ->
60-
expected_connective ?loc:tm.loc "" tp
60+
expected_connective "" tp
6161
| _ ->
6262
let actual_tp = syn tm in
63-
equate ?loc:tm.loc tp actual_tp
63+
equate tp actual_tp
6464

6565
and syn (tm : tm) : tp =
6666
Reporter.tracef ?loc:tm.loc "when synthesizing its type" @@ fun () ->
6767
match tm.value with
6868
| Var nm ->
69-
lookup ?loc:tm.loc nm
69+
lookup nm
7070
| Ap (fn, arg) ->
7171
begin
7272
match syn fn with
7373
| Fun (a, b) ->
7474
chk arg a;
7575
b
7676
| tp ->
77-
expected_connective ?loc:tm.loc "function type" tp
77+
expected_connective "function type" tp
7878
end
7979
| Fst tm ->
8080
begin
8181
match syn tm with
8282
| Tuple (l, _) ->
8383
l
8484
| tp ->
85-
expected_connective ?loc:tm.loc "pair type" tp
85+
expected_connective "pair type" tp
8686
end
8787
| Snd tm ->
8888
begin
8989
match syn tm with
9090
| Tuple (_, r) ->
9191
r
9292
| tp ->
93-
expected_connective ?loc:tm.loc "pair type" tp
93+
expected_connective "pair type" tp
9494
end
9595
| NatRec (z, s, scrut) ->
9696
begin
@@ -114,9 +114,7 @@ struct
114114
Reporter.fatalf ~loc:(Asai.Range.of_lexbuf lexbuf) `LexingError "unrecognized token %S" tok
115115
| Grammar.Error ->
116116
Reporter.fatalf ~loc:(Asai.Range.of_lexbuf lexbuf) `LexingError "failed to parse"
117-
in
118-
Elab.Reader.run ~env:Emp @@ fun () ->
119-
Elab.chk tm tp
117+
in Elab.Reader.run ~env:Emp @@ fun () -> Elab.chk tm tp
120118

121119
let load mode filepath =
122120
let display : Reporter.Message.t Asai.Diagnostic.t -> unit =

0 commit comments

Comments
 (0)