Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/ast/meta-var.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log 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