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

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/typechecker/check-type.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/typechecker/check-type.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3396 - (view) (download)

1 : jhr 3396 (* check-type.sml
2 :     *
3 :     * The typechecker for type expressions.
4 :     *
5 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
6 :     *
7 :     * COPYRIGHT (c) 2015 The University of Chicago
8 :     * All rights reserved.
9 :     *)
10 :    
11 :     structure CheckType : sig
12 :    
13 :     (* check the well-formedness of a type and translate it to an AST type *)
14 :     val checkTy : Env.env * Env.context * ParseTree.ty -> Types.ty
15 :    
16 :     end = struct
17 :    
18 :     structure PT = ParseTree
19 :     structure Ty = Types
20 :    
21 :     val err = TypeError.error
22 :    
23 :     datatype tokens = datatype TypeError.tokens
24 :    
25 :     (* check a differentiation level, which must be >= 0 *)
26 :     fun checkDiff (cxt, k) =
27 :     if (k < 0)
28 :     then err (cxt, [S "differentiation must be >= 0"])
29 :     else Ty.DiffConst(IntInf.toInt k)
30 :    
31 :     (* check a sequence dimension, which must be > 0 *)
32 :     fun checkSeqDim (cxt, d) =
33 :     if (d < 0)
34 :     then err (cxt, [S "invalid dimension; must be positive"])
35 :     else Ty.DimConst(IntInf.toInt d)
36 :    
37 :     (* check a dimension, which must be 1, 2 or 3 *)
38 :     fun checkDim (cxt, d) =
39 :     if (d < 1) orelse (3 < d)
40 :     then err (cxt, [S "invalid dimension; must be 1, 2, or 3"])
41 :     else Ty.DimConst(IntInf.toInt d)
42 :    
43 :     (* check a shape *)
44 :     fun checkShape (cxt, shape) = let
45 :     fun checkDim d =
46 :     if (d <= 1)
47 :     then err (cxt, [S "invalid tensor-shape dimension; must be > 1"])
48 :     else Ty.DimConst(IntInf.toInt d)
49 :     in
50 :     Ty.Shape(List.map checkDim shape)
51 :     end
52 :    
53 :     (* check the well-formedness of a type and translate it to an AST type *)
54 :     fun checkTy (env, cxt, ty) = (case ty
55 :     of PT.T_Mark m => checkTy (Env.withEnvAndContext(env, cxt, m))
56 :     | PT.T_Bool => Ty.T_Bool
57 :     | PT.T_Int => Ty.T_Int
58 :     | PT.T_Real => Ty.realTy
59 :     | PT.T_Strand strand => (case Env.findStrand(env, strand)
60 :     of SOME _ => Ty.T_Named strand
61 :     | NONE => (
62 :     err(cxt, [S "unknown type '", A strand, "'"]);
63 :     Ty.T_Error)
64 :     (* end case *))
65 :     | PT.T_String => Ty.T_String
66 :     | PT.T_Kernel k => Ty.T_Kernel(checkDiff(cxt, k))
67 :     | PT.T_Field{diff, dim, shape} => Ty.T_Field{
68 :     diff = checkDiff (cxt, diff),
69 :     dim = checkDim (cxt, dim),
70 :     shape = checkShape (cxt, shape)
71 :     }
72 :     | PT.T_Tensor shape => Ty.T_Tensor(checkShape(cxt, shape))
73 :     | PT.T_Image{dim, shape} => Ty.T_Image{
74 :     dim = checkDim (cxt, dim),
75 :     shape = checkShape (cxt, shape)
76 :     }
77 :     | PT.T_Seq(ty, dim) => let
78 :     val ty = checkTy(cxt, ty)
79 :     in
80 :     if TU.isFixedSizeType ty
81 :     then Ty.T_Sequence(ty, checkSeqDim (cxt, dim))
82 :     else (err(cxt, [S "elements of sequence types must be fixed-size types"])
83 :     end
84 :     | PT.T_DynSeq ty => let
85 :     val ty = checkTy(cxt, ty)
86 :     in
87 :     if TU.isFixedSizeType ty
88 :     then Ty.T_DynSequence(ty)
89 :     else err(cxt, [S "elements of sequence types must be fixed-size types"])
90 :     end
91 :     (* end case *))
92 :    
93 :    
94 :     end

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