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

SCM Repository

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

View of /branches/vis15/src/compiler/typechecker/const-expr.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3419 - (download) (annotate)
Fri Nov 13 01:23:11 2015 UTC (4 years ago) by jhr
File size: 4851 byte(s)
bug fixing in the merge
(* const-expr.sml
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2015 The University of Chicago
 * All rights reserved.
 *
 * TODO: add support for evaluating constants from the command-line
 * What about "image" and "load" in inputs?
 *)

structure ConstExpr : sig

  (* compile-time constant values *)
    datatype const_value
      = String of string
      | Bool of bool
      | Int of IntLit.t
      | Real of RealLit.t
      | Tensor of const_value list
      | Seq of const_value list
      | Expr of AST.expr	(* for more complicated tensor-valued expressions *)

  (* a property to attach to 'const' variables to track their value *)
    val define : Var.t * const_value -> unit
    val valueOf : Var.t -> const_value option

  (* convert a constant value to an AST expression *)
    val valueToExpr : const_value -> AST.expr

  (* evaluate a constant expression; this returns NONE if the expression is not a valid
   * constant expression and will also emit an error message into the error stream.
   *)
    val eval : ((Error.err_stream * Error.span) * AST.expr) -> const_value option

  end = struct

    structure L = Literal
    structure BV = BasisVars
    structure Ty = Types

    datatype token = datatype TypeError.token

  (* compile-time constant values *)
    datatype const_value
      = String of string
      | Bool of bool
      | Int of IntLit.t
      | Real of RealLit.t
      | Tensor of const_value list
      | Seq of const_value list
      | Expr of AST.expr	(* for more complicated tensor-valued expressions *)

  (* a property to attach to 'const' variables to track their value *)
    local
      val {peekFn : Var.t -> const_value option, setFn, ...} =
	    Var.newProp (fn x => raise Fail("undefined constant " ^ Var.uniqueNameOf x))
    in
    val define = setFn
    val valueOf = peekFn
    end (* local *)

    fun valueToExpr (String s) = AST.E_Lit(L.String s)
      | valueToExpr (Bool b) = AST.E_Lit(L.Bool b)
      | valueToExpr (Int i) = AST.E_Lit(L.Int i)
      | valueToExpr (Real r) = AST.E_Lit(L.Real r)
      | valueToExpr (Tensor vs) = raise Fail "FIXME"
      | valueToExpr (Seq vs) = raise Fail "FIXME"
      | valueToExpr (Expr e) = e

    fun eval (cxt, constExp) = let
	  exception EVAL
	  fun err msg = (TypeError.error (cxt, msg); raise EVAL)
	  fun mkPrim (f, mvs, args, ty) =
		if Basis.allowedInConstExp f
		  then Expr(AST.E_Prim(f, mvs, List.map valueToExpr args, ty))
		  else err [S "invalid use of ", V f, S " in constant expression"]
	  fun eval' e = (case e
		 of AST.E_Var(x, span) => (case valueOf x
		       of SOME v => v
			| NONE => err [
			      S "reference to non-constant variable ", V x,
			      S " in constant expression at ",
			      LN(Error.location(#1 cxt, span))
			    ]
		      (* end case *))
		  | AST.E_Lit(L.String s) => String s
		  | AST.E_Lit(L.Bool b) => Bool b
		  | AST.E_Lit(L.Int i) => Int i
		  | AST.E_Lit(L.Real r) => Real r
		  | AST.E_Prim(f, mvs, [e], ty) => (case eval' e
		       of Int i => if Var.same(BV.neg_i, f)
			    then Int(IntLit.neg i)
			    else mkPrim (f, mvs, [Int i], ty)
			| Real r => if Var.same(BV.neg_t, f)
			    then Real(RealLit.negate r)
			    else mkPrim (f, mvs, [Real r], ty)
			| Bool b => if Var.same(BV.op_not, f)
			    then Bool(not b)
			    else mkPrim (f, mvs, [Bool b], ty)
			| e' => mkPrim (f, mvs, [e'], ty)
		      (* end case *))
		  | AST.E_Prim(f, mvs, [e1, e2], ty) => (case (eval' e1, eval' e2)
		       of (Int i1, Int i2) =>
			    if Var.same(BV.add_ii, f)
			      then Int(IntLit.add(i1, i2))
			    else if Var.same(BV.sub_ii, f)
			      then Int(IntLit.sub(i1, i2))
			    else if Var.same(BV.mul_ii, f)
			      then Int(IntLit.mul(i1, i2))
			    else if Var.same(BV.div_ii, f)
			      then if (i2 = 0)
				then err[S "divide by zero in constant expression"]
				else Int(IntLit.div(i1, i2))
			    else if Var.same(BV.op_mod, f)
			      then if (i2 = 0)
				then err[S "integer mod by zero in constant expression"]
				else Int(IntLit.mod(i1, i2))
			    else mkPrim (f, mvs, [Int i1, Int i2], ty)
			| (e1', e2') => mkPrim (f, mvs, [e1', e2'], ty)
		      (* end case *))
		  | AST.E_Prim(f, mvs, args, ty) =>
		      mkPrim (f, mvs, List.map eval' args, ty)
		  | AST.E_Tensor(es, _) => raise Fail "FIXME"
		  | AST.E_Seq(es, _) => raise Fail "FIXME"
		  | AST.E_Slice(e, indices, _) => raise Fail "FIXME"
		  | AST.E_Coerce{srcTy=Ty.T_Int, dstTy as Ty.T_Tensor(Ty.Shape[]), e} => (
		      case eval' e
		       of Int i => Real(RealLit.fromInt i)
			| Expr e' =>
			    Expr(AST.E_Coerce{srcTy=Ty.T_Int, dstTy=dstTy, e=e'})
			| _ => raise Fail "impossible"
		      (* end case *))
		  | _ => err [S "invalid constant expression"]
		(* end case *))
	  in
	    SOME(eval' constExp) handle EVAL => NONE
	  end

  end

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