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 3407 - (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 : jhr 3407 val check : Env.t * Env.context * ParseTree.ty -> Types.ty
15 : jhr 3396
16 :     end = struct
17 :    
18 :     structure PT = ParseTree
19 :     structure Ty = Types
20 : jhr 3407 structure TU = TypeUtil
21 : jhr 3396
22 : jhr 3407 fun err arg = (TypeError.error arg; Ty.T_Error)
23 : jhr 3396
24 : jhr 3402 datatype token = datatype TypeError.token
25 : jhr 3396
26 :     (* check a differentiation level, which must be >= 0 *)
27 :     fun checkDiff (cxt, k) =
28 :     if (k < 0)
29 : jhr 3407 then (TypeError.error (cxt, [S "differentiation must be >= 0"]); Ty.DiffConst 0)
30 : jhr 3396 else Ty.DiffConst(IntInf.toInt k)
31 :    
32 :     (* check a sequence dimension, which must be > 0 *)
33 : jhr 3407 fun checkSeqDim (env, cxt, dim) = (case CheckExpr.checkDim (env, cxt, dim)
34 :     of SOME d => if (d < 0)
35 :     then (
36 :     TypeError.error (cxt, [S "invalid sequence dimension; must be non-negative"]);
37 :     Ty.DimConst 0)
38 :     else Ty.DimConst(IntInf.toInt d)
39 :     | NONE => Ty.DimConst 0
40 :     (* end case *))
41 : jhr 3396
42 :     (* check a dimension, which must be 1, 2 or 3 *)
43 : jhr 3407 fun checkDim (env, cxt, dim) = (case CheckExpr.checkDim (env, cxt, dim)
44 :     of SOME d => if (d < 1) orelse (3 < d)
45 :     then (
46 :     TypeError.error (cxt, [S "invalid dimension; must be 1, 2, or 3"]);
47 :     Ty.DimConst 0)
48 :     else Ty.DimConst(IntInf.toInt d)
49 :     | NONE => Ty.DimConst 0
50 :     (* end case *))
51 : jhr 3396
52 :     (* check the well-formedness of a type and translate it to an AST type *)
53 : jhr 3407 fun check (env, cxt, ty) = (case ty
54 :     of PT.T_Mark m => check (Env.withEnvAndContext(env, cxt, m))
55 : jhr 3396 | PT.T_Bool => Ty.T_Bool
56 :     | PT.T_Int => Ty.T_Int
57 :     | PT.T_Real => Ty.realTy
58 : jhr 3407 | PT.T_Id strand => (case Env.findStrand(env, strand)
59 : jhr 3396 of SOME _ => Ty.T_Named strand
60 :     | NONE => (
61 : jhr 3407 err(cxt, [S "unknown type '", A strand, S "'"]);
62 : jhr 3396 Ty.T_Error)
63 :     (* end case *))
64 :     | PT.T_String => Ty.T_String
65 :     | PT.T_Kernel k => Ty.T_Kernel(checkDiff(cxt, k))
66 :     | PT.T_Field{diff, dim, shape} => Ty.T_Field{
67 :     diff = checkDiff (cxt, diff),
68 : jhr 3407 dim = checkDim (env, cxt, dim),
69 :     shape = CheckExpr.checkShape (env, cxt, shape)
70 : jhr 3396 }
71 : jhr 3407 | PT.T_Tensor shape => Ty.T_Tensor(CheckExpr.checkShape(env, cxt, shape))
72 : jhr 3396 | PT.T_Image{dim, shape} => Ty.T_Image{
73 : jhr 3407 dim = checkDim (env, cxt, dim),
74 :     shape = CheckExpr.checkShape (env, cxt, shape)
75 : jhr 3396 }
76 :     | PT.T_Seq(ty, dim) => let
77 : jhr 3407 val ty = check(env, cxt, ty)
78 : jhr 3396 in
79 :     if TU.isFixedSizeType ty
80 : jhr 3407 then Ty.T_Sequence(ty, SOME(checkSeqDim (env, cxt, dim)))
81 : jhr 3398 else err(cxt, [S "elements of sequence types must be fixed-size types"])
82 : jhr 3396 end
83 :     | PT.T_DynSeq ty => let
84 : jhr 3407 val ty = check(env, cxt, ty)
85 : jhr 3396 in
86 :     if TU.isFixedSizeType ty
87 : jhr 3398 then Ty.T_Sequence(ty, NONE)
88 : jhr 3396 else err(cxt, [S "elements of sequence types must be fixed-size types"])
89 :     end
90 :     (* end case *))
91 :    
92 :     end

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