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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.3402  
changed lines
  Added in v.3407

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