Skip to content

Commit 6cf5780

Browse files
cyrus-cyrus-
authored
Add all of the builtins (#1734)
2 parents b552595 + 0693e86 commit 6cf5780

17 files changed

+4304
-492
lines changed

‎src/language/Builtins.re‎

Lines changed: 0 additions & 458 deletions
This file was deleted.

‎src/language/builtins/Builtins.re‎

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
open BuiltinsUtil;
2+
3+
/* Built-in functions for Hazel.
4+
Update src/menhirParser/Lexer.mll when any new builtin is added */
5+
6+
let builtins =
7+
List.map(fn_builtin, BuiltinsBase.string_fns)
8+
@ List.map(fn_builtin, BuiltinsBase.pair_fns)
9+
@ List.map(of_atom_builtin, Atom.converter_builtins)
10+
@ List.map(of_atom_builtin, Operators.builtins)
11+
@ List.map(hazel_fn_builtin, BuiltinsList.builtins)
12+
@ List.map(hazel_fn_builtin, BuiltinsADT.builtins)
13+
@ List.map(fn_builtin, BuiltinsBase.numeric_fns)
14+
@ List.map(const_builtin, BuiltinsBase.numeric_constants);
15+
16+
/* Check for accidental duplicates */
17+
let _ = to_map(builtins);
18+
19+
let ctx_entries =
20+
List.map(ctx_entry_of_builtin, builtins)
21+
@ List.map(entry => Ctx.LivelitEntry(entry), Livelit.livelits)
22+
@ BuiltinsADT.constructor_entries;
23+
24+
let ctx_init: option(Operators.mode) => Ctx.t =
25+
use_mode => {
26+
use_mode,
27+
entries: ctx_entries,
28+
};
29+
30+
let forms_init: forms = List.filter_map(form_of_builtin, builtins);
31+
32+
let env_init: Environment.t =
33+
builtins
34+
|> List.map(imp_of_builtin)
35+
|> List.fold_left(Environment.extend, Environment.empty);

‎src/language/builtins/BuiltinsADT.re‎

Lines changed: 192 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,192 @@
1+
open BuiltinsUtil;
2+
module Fresh = IdTagged.FreshGrammar;
3+
open Fresh.Typ;
4+
5+
let sum_type = (variants: list((string, option(Typ.t)))): Typ.t =>
6+
variants
7+
|> List.map(((name, typ_opt)) =>
8+
ConstructorMap.Variant(name, [Id.mk()], typ_opt)
9+
)
10+
|> sum;
11+
12+
let meta_type: Typ.t = sum_type([("$e", None), ("$v", None)]);
13+
14+
module Ord = {
15+
let t: Typ.t = sum_type([("Lt", None), ("Eq", None), ("Gt", None)]);
16+
17+
open IdTagged.FreshGrammar;
18+
let lt = Exp.constructor("Lt", Some(Some(t)));
19+
let eq = Exp.constructor("Eq", Some(Some(t)));
20+
let gt = Exp.constructor("Gt", Some(Some(t)));
21+
let lt_pat = Pat.constructor("Lt", Some(Some(t)));
22+
let eq_pat = Pat.constructor("Eq", Some(Some(t)));
23+
let gt_pat = Pat.constructor("Gt", Some(Some(t)));
24+
};
25+
26+
module Either = {
27+
let t: Typ.t =
28+
sum_type([
29+
("Left", Some(Unknown(Internal) |> Typ.fresh)),
30+
("Right", Some(Unknown(Internal) |> Typ.fresh)),
31+
]);
32+
33+
open IdTagged.FreshGrammar;
34+
let left =
35+
Exp.constructor("Left", Some(Some(arrow(unknown(SynSwitch), t))));
36+
let right =
37+
Exp.constructor("Right", Some(Some(arrow(unknown(SynSwitch), t))));
38+
39+
let pat_left =
40+
Pat.constructor("Left", Some(Some(arrow(unknown(SynSwitch), t))));
41+
let pat_right =
42+
Pat.constructor("Right", Some(Some(arrow(unknown(SynSwitch), t))));
43+
};
44+
45+
module Option = {
46+
let t: Typ.t =
47+
sum_type([
48+
("None", None),
49+
("Some", Some(Unknown(Internal) |> Typ.fresh)),
50+
]);
51+
52+
open IdTagged.FreshGrammar;
53+
54+
// Confirm that we want the type on the constructors for both expressions and patterns
55+
let none = Exp.constructor("None", Some(Some(t)));
56+
57+
let some =
58+
Exp.constructor("Some", Some(Some(arrow(unknown(SynSwitch), t))));
59+
60+
let pat_none = Pat.constructor("None", Some(Some(t)));
61+
62+
let pat_some =
63+
Pat.constructor("Some", Some(Some(arrow(unknown(SynSwitch), t))));
64+
65+
let builtins: list(hazel_fn) = [
66+
{
67+
str: {|fun (opt, f) -> case opt
68+
| None => None
69+
| Some(x) => Some(f(x))
70+
end|},
71+
name: "option_map",
72+
arg: Prod([t, arrow(unknown(Internal), unknown(Internal))]),
73+
ret: Unknown(Internal),
74+
imp: {
75+
Fresh.(
76+
Exp.(
77+
fn(
78+
Pat.tuple([Pat.var("opt"), Pat.var("f")]),
79+
match(
80+
var("opt"),
81+
[
82+
(pat_none, none),
83+
(
84+
Pat.ap(pat_some, Pat.var("x")),
85+
ap(Forward, some, ap(Forward, var("f"), var("x"))),
86+
),
87+
],
88+
),
89+
None,
90+
None,
91+
)
92+
)
93+
);
94+
},
95+
},
96+
{
97+
str: {|fun (opt, f) -> case opt
98+
| None => None
99+
| Some x => f(x)
100+
end|},
101+
name: "option_bind",
102+
arg: Prod([t, arrow(unknown(Internal), unknown(Internal))]),
103+
ret: Unknown(Internal),
104+
imp: {
105+
Fresh.(
106+
Exp.(
107+
fn(
108+
Pat.tuple([Pat.var("opt"), Pat.var("f")]),
109+
match(
110+
var("opt"),
111+
[
112+
(pat_none, none),
113+
(
114+
Pat.ap(pat_some, Pat.var("x")),
115+
ap(Forward, var("f"), var("x")),
116+
),
117+
],
118+
),
119+
None,
120+
None,
121+
)
122+
)
123+
);
124+
},
125+
},
126+
{
127+
name: "option_to_list",
128+
arg: t.term,
129+
ret: List(unknown(Internal)),
130+
str: {|fun opt -> case opt
131+
| None => []
132+
| Some x => [x]
133+
end|},
134+
imp: {
135+
Fresh.(
136+
Exp.(
137+
fn(
138+
Pat.var("opt"),
139+
match(
140+
var("opt"),
141+
[
142+
(pat_none, list_lit([])),
143+
(Pat.ap(pat_some, Pat.var("x")), list_lit([var("x")])),
144+
],
145+
),
146+
None,
147+
None,
148+
)
149+
)
150+
);
151+
},
152+
},
153+
];
154+
};
155+
156+
// List of type aliases to add to the context
157+
let type_aliases: list((string, Typ.t)) = [
158+
("Ord", Ord.t),
159+
("Option", Option.t),
160+
("Either", Either.t),
161+
("$Meta", meta_type),
162+
];
163+
164+
let create_type_alias = (name: string, typ: Typ.t): Ctx.entry =>
165+
Ctx.TVarEntry({
166+
name,
167+
id: Id.invalid,
168+
kind: Ctx.Singleton(typ),
169+
});
170+
171+
// Convert type aliases to context entries
172+
let types: list(Ctx.entry) =
173+
List.map(((name, typ)) => create_type_alias(name, typ), type_aliases);
174+
175+
// Add constructors for type aliases to the context
176+
let constructors: Ctx.t = {
177+
List.fold_left(
178+
(ctx, (name, typ)) => {
179+
let cons_map =
180+
switch (Typ.term_of(typ)) {
181+
| Sum(cons_map) => cons_map
182+
| _ => failwith("Type alias must be a sum type")
183+
};
184+
Ctx.add_ctrs(ctx, name, Id.invalid, cons_map);
185+
},
186+
Ctx.empty,
187+
type_aliases,
188+
);
189+
};
190+
191+
let builtins = Option.builtins;
192+
let constructor_entries = constructors.entries @ types;

0 commit comments

Comments
 (0)