Annotation of /branches/vis15/src/compiler/ast/meta-var.sml

Parent Directory | Revision Log

---

Revision 3384 - (view) (download)

1 :	jhr	3384	(* meta-var.sml
2 :			*
3 :			* This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :			*
5 :			* COPYRIGHT (c) 2015 The University of Chicago
6 :			* All rights reserved.
7 :			*
8 :			* The Diderot typechecker uses four kinds of meta variables:
9 :			*
10 :			* type variables
11 :			* differentiation variables
12 :			* shape variables
13 :			* dimension variables
14 :			*)
15 :
16 :			structure MetaVar =
17 :			struct
18 :
19 :			datatype ty_var = datatype Types.ty_var
20 :			datatype diff_var = datatype Types.diff_var
21 :			datatype shape_var = datatype Types.shape_var
22 :			datatype dim_var = datatype Types.dim_var
23 :			datatype kind = datatype Types.kind
24 :
25 :
26 :			(***** Type variables ****)
27 :
28 :			fun newTyVar () = TV{
29 :			id = Stamp.new(),
30 :			bind = ref NONE
31 :			}
32 :
33 :			(* create a type variable that is instantiated to a given type *)
34 :			fun newFromType ty = TV{
35 :			id = Stamp.new(),
36 :			bind = ref(SOME ty)
37 :			}
38 :
39 :			fun tyVarToString (TV{id, ...}) = "'ty" ^ Stamp.toString id
40 :
41 :
42 :			(***** Differentiation variables ****)
43 :
44 :			fun newDiffVar bnd = DfV{
45 :			id = Stamp.new(),
46 :			bound = ref bnd,
47 :			bind = ref NONE
48 :			}
49 :
50 :			fun diffVarToString (DfV{id, ...}) = "'diff" ^ Stamp.toString id
51 :
52 :
53 :			(***** Shape variables ****)
54 :
55 :			fun newShapeVar () = SV{
56 :			id = Stamp.new(),
57 :			bind = ref NONE
58 :			}
59 :
60 :			fun shapeVarToString (SV{id, ...}) = "'shp" ^ Stamp.toString id
61 :
62 :
63 :			(***** Dimension variables ****)
64 :
65 :			fun newDimVar () = DV{
66 :			id = Stamp.new(),
67 :			bind = ref NONE
68 :			}
69 :
70 :			fun dimVarToString (DV{id, ...}) = "'dim" ^ Stamp.toString id
71 :
72 :			fun sameDimVar (DV{id=a, ...}, DV{id=b, ...}) = Stamp.same(a, b)
73 :
74 :
75 :			(***** Meta variables ****)
76 :
77 :			fun metaToString (TYPE tv) = tyVarToString tv
78 :			| metaToString (DIFF dv) = diffVarToString dv
79 :			| metaToString (SHAPE sv) = shapeVarToString sv
80 :			| metaToString (DIM dv) = dimVarToString dv
81 :
82 :			fun stamp (TYPE(TV{id, ...})) = id
83 :			| stamp (DIFF(DfV{id, ...})) = id
84 :			| stamp (SHAPE(SV{id, ...})) = id
85 :			| stamp (DIM(DV{id, ...})) = id
86 :
87 :			fun copy (TYPE _) = TYPE(newTyVar())
88 :			| copy (DIFF(k as DfV{bound, ...})) = DIFF(newDiffVar(!bound))
89 :			| copy (SHAPE _) = SHAPE(newShapeVar())
90 :			| copy (DIM _) = DIM(newDimVar())
91 :
92 :			fun toType (TYPE(TV{bind, ...})) = (case !bind
93 :			of SOME ty => ty
94 :			| NONE => raise Fail "unbound type meta variable"
95 :			(* end case *))
96 :			| toType mv = raise Fail(concat["toType(", metaToString mv, ")"])
97 :
98 :			fun toDiff (DIFF(DfV{bind, ...})) = (case !bind
99 :			of SOME ty => ty
100 :			| NONE => raise Fail "unbound diff meta variable"
101 :			(* end case *))
102 :			| toDiff mv = raise Fail(concat["toDiff(", metaToString mv, ")"])
103 :
104 :			fun toShape (SHAPE(SV{bind, ...})) = (case !bind
105 :			of SOME ty => ty
106 :			| NONE => raise Fail "unbound shape meta variable"
107 :			(* end case *))
108 :			| toShape mv = raise Fail(concat["toShape(", metaToString mv, ")"])
109 :
110 :			fun toDim (DIM(DV{bind, ...})) = (case !bind
111 :			of SOME ty => ty
112 :			| NONE => raise Fail "unbound dimension meta variable"
113 :			(* end case *))
114 :			| toDim mv = raise Fail(concat["toDim(", metaToString mv, ")"])
115 :
116 :
117 :			structure Map = RedBlackMapFn (
118 :			struct
119 :			type ord_key = Types.meta_var
120 :			fun compare (mv1, mv2) = Stamp.compare(stamp mv1, stamp mv2)
121 :			end)
122 :
123 :			end

---

root@smlnj-gforge.cs.uchicago.edu	ViewVC Help
Powered by ViewVC 1.0.0