Annotation of /trunk/src/compiler/ast/meta-var.sml

Parent Directory | Revision Log

---

Revision 182 - (view) (download)

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

---

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