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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3402 - (download) (annotate)
Wed Nov 11 02:54:23 2015 UTC (4 years, 10 months ago) by jhr
File size: 3279 byte(s)
working on merge
(* check-type.sml
 *
 * The typechecker for type expressions.
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2015 The University of Chicago
 * All rights reserved.
 *)

structure CheckType : sig

  (* check the well-formedness of a type and translate it to an AST type *)
    val checkTy : Env.env * Env.context * ParseTree.ty -> Types.ty

  end = struct

    structure PT = ParseTree
    structure Ty = Types

    val err = TypeError.error

    datatype token = datatype TypeError.token

  (* check a differentiation level, which must be >= 0 *)
    fun checkDiff (cxt, k) =
          if (k < 0)
            then err (cxt, [S "differentiation must be >= 0"])
            else Ty.DiffConst(IntInf.toInt k)

  (* check a sequence dimension, which must be > 0 *)
    fun checkSeqDim (cxt, d) =
          if (d < 0)
            then err (cxt, [S "invalid dimension; must be positive"])
            else Ty.DimConst(IntInf.toInt d)

  (* check a dimension, which must be 1, 2 or 3 *)
    fun checkDim (cxt, d) =
          if (d < 1) orelse (3 < d)
            then err (cxt, [S "invalid dimension; must be 1, 2, or 3"])
            else Ty.DimConst(IntInf.toInt d)

  (* 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"])
                  else Ty.DimConst(IntInf.toInt d)
          in
            Ty.Shape(List.map checkDim shape)
          end

  (* check the well-formedness of a type and translate it to an AST type *)
    fun checkTy (env, cxt, ty) = (case ty
           of PT.T_Mark m => checkTy (Env.withEnvAndContext(env, cxt, m))
            | PT.T_Bool => Ty.T_Bool
            | PT.T_Int => Ty.T_Int
            | PT.T_Real => Ty.realTy
            | PT.T_Strand strand => (case Env.findStrand(env, strand)
		 of SOME _ => Ty.T_Named strand
		  | NONE => (
		      err(cxt, [S "unknown type '", A strand, "'"]);
		      Ty.T_Error)
		(* end case *))
            | PT.T_String => Ty.T_String
            | PT.T_Kernel k => Ty.T_Kernel(checkDiff(cxt, k))
            | PT.T_Field{diff, dim, shape} => Ty.T_Field{
                  diff = checkDiff (cxt, diff),
                  dim = checkDim (cxt, dim),
                  shape = checkShape (cxt, shape)
                }
            | PT.T_Tensor shape => Ty.T_Tensor(checkShape(cxt, shape))
            | PT.T_Image{dim, shape} => Ty.T_Image{
                  dim = checkDim (cxt, dim),
                  shape = checkShape (cxt, shape)
                }
            | PT.T_Seq(ty, dim) => let
                val ty = checkTy(cxt, ty)
                in
                  if TU.isFixedSizeType ty
                    then Ty.T_Sequence(ty, checkSeqDim (cxt, dim))
                    else err(cxt, [S "elements of sequence types must be fixed-size types"])
                end
            | PT.T_DynSeq ty => let
                val ty = checkTy(cxt, ty)
                in
                  if TU.isFixedSizeType ty
                    then Ty.T_Sequence(ty, NONE)
                    else err(cxt, [S "elements of sequence types must be fixed-size types"])
                end
          (* end case *))

  end

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