Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2015 Matthew Fluet. |
2 | * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh | |
3 | * Jagannathan, and Stephen Weeks. | |
4 | * Copyright (C) 1997-2000 NEC Research Institute. | |
5 | * | |
6 | * MLton is released under a BSD-style license. | |
7 | * See the file MLton-LICENSE for details. | |
8 | *) | |
9 | ||
10 | functor GenericScheme (S: GENERIC_SCHEME_STRUCTS): GENERIC_SCHEME = | |
11 | struct | |
12 | ||
13 | open S | |
14 | ||
15 | type ty = Type.t | |
16 | type tyvar = Tyvar.t | |
17 | ||
18 | datatype t = T of {tyvars: tyvar vector, | |
19 | ty: ty} | |
20 | ||
21 | local | |
22 | fun make f (T r) = f r | |
23 | in | |
24 | val ty = make #ty | |
25 | end | |
26 | ||
27 | fun layout (T {tyvars, ty}) = | |
28 | let open Layout | |
29 | val ty = Type.layout ty | |
30 | in | |
31 | if Vector.isEmpty tyvars | |
32 | then ty | |
33 | else | |
34 | align [seq [str "Forall ", | |
35 | Vector.layout Tyvar.layout tyvars, | |
36 | str "."], | |
37 | ty] | |
38 | end | |
39 | ||
40 | fun apply (T {tyvars, ty}, args) = | |
41 | if Vector.isEmpty tyvars andalso Vector.isEmpty args | |
42 | then ty (* Must special case this, since don't want to substitute | |
43 | * in monotypes. | |
44 | *) | |
45 | else Type.substitute (ty, Vector.zip (tyvars, args)) | |
46 | ||
47 | val apply = | |
48 | Trace.trace ("GenericScheme.apply", Layout.tuple2 (layout, Vector.layout Type.layout), Type.layout) | |
49 | apply | |
50 | ||
51 | end |