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

SCM Repository

[diderot] Annotation of /branches/vis12/src/compiler/typechecker/util.sml
ViewVC logotype

Annotation of /branches/vis12/src/compiler/typechecker/util.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 80 - (view) (download)
Original Path: trunk/src/typechecker/util.sml

1 : jhr 80 (* util.sml
2 :     *
3 :     * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *
6 :     * Utilities for typechecking
7 :     *)
8 :    
9 :     structure Util =
10 :     struct
11 :    
12 :     structure Ty = Types
13 :    
14 :     (* prune out instantiated meta variables from a type *)
15 :     fun prune ty = let
16 :     fun pruneDiff (Ty.DiffVar(Dfv{bind=ref(SOME diff), ...}, i)) = (
17 :     case pruneDiff diff
18 :     of Ty.DiffVar(dv, i') => Ty.DiffVar(dv, i+i')
19 :     | Ty.DiffConst i' => Ty.DiffConst(i+i')
20 :     (* end case *))
21 :     | prunDiff diff = diff
22 :     fun pruneDim dim = (case dim
23 :     of Ty.DimVar(Ty.DV{bind=ref(SOME dim), ...}) => pruneDim dim
24 :     | dim => dim
25 :     (* end case *))
26 :     fun pruneShape shape = (case shape
27 :     of ShapeVar(Ty.SV{bind=ref(SOME shape), ...}) => pruneShape shape
28 :     | ShapeExt(shape, dim) => ShapeExt(pruneShape shape, pruneDim dim)
29 :     | _ => shape
30 :     (* end case *))
31 :     fun prune' (ty as Ty.T_Var(Ty.TV{bind, ...})) = (case !bind
32 :     of NONE => ty
33 :     | SOME ty => prune' ty
34 :     (* end case *))
35 :     | prune' (Ty.T_Kernel diff) = Ty.T_Kernel(pruneDiff diff)
36 :     | prune' (Ty.T_Tensor shape) = Ty.T_Tensor(pruneShape shape)
37 :     | prune' (Ty.T_Image{dim, shape}) = Ty.T_Image{
38 :     dim = pruneDim dim,
39 :     shape = pruneShape shape
40 :     }
41 :     | prune' (Ty.T_Field{diff, dim, shape}) = Ty.T_Field{
42 :     diff = pruneDiff diff,
43 :     dim = pruneDim dim,
44 :     shape = pruneShape shape
45 :     }
46 :     | prune' (Ty.T_Fun(tys1, tys2)) = Ty.T_Fun(List.map prune' tys1, List.map prune' tys2)
47 :     | prune' ty = ty
48 :     in
49 :     prune' ty
50 :     end
51 :    
52 :     fun matchTypes (ty1, ty2) = let
53 :     fun match (Ty.T_Var tv1, Ty.T_Var tv2) =
54 :     | match (Ty.T_Var tv1, ty2) =
55 :     | match (ty1, Ty.T_Var tv2) =
56 :     | match (Ty.T_Bool, Ty.T_Bool) = true
57 :     | match (Ty.T_Int, Ty.T_Int) = true
58 :     | match (Ty.T_String, Ty.T_String) = true
59 :     | match (Ty.T_Kernel d1, Ty.T_Kernel d2) =
60 :     | match (Ty.T_Tensor s1, Ty.T_Tensor s2) =
61 :     | match (Ty.T_Image{dim=d1, shape=s1}, Ty.T_Image{dim=d2, shape=s2}) =
62 :     | match (Ty.T_Field{diff=k1, dim=d1, shape=s1}, Ty.T_Field{diff=k2, dim=d2, shape=s2}) =
63 :     | match (Ty.T_Fun(tys11, tys22), Ty.T_Fun(tys21, tys22)) =
64 :     | match _ = false
65 :     in
66 :     match (prune ty1, prune ty2)
67 :     end
68 :    
69 :     end

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