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

SCM Repository

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

Diff of /branches/vis15/src/compiler/constants/const-expr.sml

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

branches/vis15/src/compiler/typechecker/const-expr.sml revision 3444, Fri Nov 20 01:11:12 2015 UTC branches/vis15/src/compiler/constants/const-expr.sml revision 3454, Mon Nov 23 13:37:18 2015 UTC
# Line 6  Line 6 
6   * All rights reserved.   * All rights reserved.
7   *   *
8   * TODO: add support for evaluating constants from the command-line   * TODO: add support for evaluating constants from the command-line
  * What about "image" and "load" in inputs?  
9   *)   *)
10    
11  structure ConstExpr : sig  structure ConstExpr : sig
12    
13    (* compile-time constant values *)    (* compile-time constant values *)
14      datatype const_value      datatype t
15        = String of string        = String of string
16        | Bool of bool        | Bool of bool
17        | Int of IntLit.t        | Int of IntLit.t
# Line 22  Line 21 
21        | Expr of AST.expr        (* for more complicated tensor-valued expressions *)        | Expr of AST.expr        (* for more complicated tensor-valued expressions *)
22    
23    (* a property to attach to 'const' variables to track their value *)    (* a property to attach to 'const' variables to track their value *)
24      val define : Var.t * const_value -> unit      val define : Var.t * t -> unit
25      val valueOf : Var.t -> const_value option      val valueOf : Var.t -> t option
26    
27    (* convert a constant value to an AST expression *)    (* convert a constant value to an AST expression *)
28      val valueToExpr : const_value -> AST.expr      val valueToExpr : t -> AST.expr
29    
30    (* return the type of a constant value *)    (* return the type of a constant value *)
31      val typeOfConst : const_value -> Types.ty      val typeOfConst : t -> Types.ty
32    
33    (* evaluate a constant expression; this returns NONE if the expression is not a valid    (* evaluate a constant expression; this returns NONE if the expression is not a valid
34     * constant expression and will also emit an error message into the error stream.     * constant expression and will also emit an error message into the error stream.
35     * The bool should be true if the constant is the default value for an input variable,     * The bool should be true if the constant is the default value for an input variable,
36     * since we then allow "load" and "image".     * since we then allow "load" and "image".
37     *)     *)
38      val eval : ((Error.err_stream * Error.span) * bool * AST.expr) -> const_value option      val eval : ((Error.err_stream * Error.span) * bool * AST.expr) -> t option
39    
40    end = struct    end = struct
41    
# Line 47  Line 46 
46      datatype token = datatype TypeError.token      datatype token = datatype TypeError.token
47    
48    (* compile-time constant values *)    (* compile-time constant values *)
49      datatype const_value      datatype t
50        = String of string        = String of string
51        | Bool of bool        | Bool of bool
52        | Int of IntLit.t        | Int of IntLit.t
# Line 81  Line 80 
80        | valueToExpr (Seq(vs, ty)) = AST.E_Seq(List.map valueToExpr vs, ty)        | valueToExpr (Seq(vs, ty)) = AST.E_Seq(List.map valueToExpr vs, ty)
81        | valueToExpr (Expr e) = e        | valueToExpr (Expr e) = e
82    
   (* an exception to raise when the arguments to an operator are not concrete values  
    * of the right type.  
    *)  
     exception Arg  
   
     val unaryOpTbl : (const_value -> const_value) Var.Tbl.hash_table = let  
           val tbl = Var.Tbl.mkTable (16, Fail "unOpTbl")  
           val ins = Var.Tbl.insert tbl  
           fun tensorNeg (Real r) = Real(RealLit.negate r)  
             | tensorNeg (Tensor(vs, ty)) = Tensor(List.map tensorNeg vs, ty)  
             | tensorNeg (Expr _) = raise Arg  
             | tensorNeg _ = raise Fail "impossible"  
           in  
             List.app ins [  
                 (BV.op_not, fn (Bool b) => Bool(not b) | _ => raise Arg),  
                 (BV.neg_i, fn (Int a) => Int(IntLit.neg a) | _ => raise Arg),  
                 (BV.neg_t, tensorNeg)  
               ];  
             tbl  
           end  
   
     val binOpTbl : (const_value * const_value -> const_value) Var.Tbl.hash_table = let  
           val tbl = Var.Tbl.mkTable (64, Fail "binOpTbl")  
           val ins = Var.Tbl.insert tbl  
           in  
             List.app ins [  
                 (BV.equ_bb, fn (Bool a, Bool b) => Bool(a = b) | _ => raise Arg),  
                 (BV.neq_bb, fn (Bool a, Bool b) => Bool(a <> b) | _ => raise Arg),  
                 (BV.add_ii, fn (Int a, Int b) => Int(IntLit.add(a, b)) | _ => raise Arg),  
                 (BV.sub_ii, fn (Int a, Int b) => Int(IntLit.sub(a, b)) | _ => raise Arg),  
                 (BV.mul_ii, fn (Int a, Int b) => Int(IntLit.mul(a, b)) | _ => raise Arg),  
                 (BV.div_ii, fn (Int a, Int b) => Int(IntLit.divide(a, b)) | _ => raise Arg),  
                 (BV.op_mod, fn (Int a, Int b) => Int(IntLit.modulo(a, b)) | _ => raise Arg),  
                 (BV.lt_ii, fn (Int a, Int b) => Bool(a < b) | _ => raise Arg),  
                 (BV.lte_ii, fn (Int a, Int b) => Bool(a <= b) | _ => raise Arg),  
                 (BV.gt_ii, fn (Int a, Int b) => Bool(a > b) | _ => raise Arg),  
                 (BV.gte_ii, fn (Int a, Int b) => Bool(a >= b) | _ => raise Arg),  
                 (BV.equ_ii, fn (Int a, Int b) => Bool(a = b) | _ => raise Arg),  
                 (BV.neq_ii, fn (Int a, Int b) => Bool(a <> b) | _ => raise Arg)  
               ];  
             tbl  
           end  
   
     fun eval (cxt, isInput, 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"]  
           val findBinOp = Var.Tbl.find binOpTbl  
           val findUnaryOp = Var.Tbl.find unaryOpTbl  
           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 findUnaryOp f  
                        of SOME rator => let  
                             val e' = eval' e  
                             in  
                               rator e'  
                                 handle Arg => mkPrim (f, mvs, [e'], ty)  
                             end  
                         | NONE => err[S "invalid constant expression"]  
                       (* end case *))  
                   | AST.E_Prim(f, mvs, [e1, e2], ty) => (case findBinOp f  
                        of SOME rator => let  
                             val e1' = eval' e1  
                             val e2' = eval' e2  
                             in  
                               rator (e1', e2')  
                                 handle Arg => mkPrim (f, mvs, [e1', e2'], ty)  
                             end  
                         | NONE => err[S "invalid constant expression"]  
                       (* end case *))  
                   | AST.E_Prim(f, mvs, args, ty) =>  
                       mkPrim (f, mvs, List.map eval' args, ty)  
                   | AST.E_Tensor(es, ty) => Tensor(List.map eval' es, ty)  
                   | AST.E_Seq(es, ty) => Seq(List.map eval' es, ty)  
                   | AST.E_Slice(e, indices, _) => (case (eval' e, indices)  
                        of (Tensor(vs, _), _) => raise Fail "FIXME"  
                         | (Seq(vs, _), [SOME idx]) => (case eval' idx  
                              of Int i => (List.nth(vs, Int.fromLarge i)  
                                   handle _ => err [S "out-of-bounds sequence access in constant expression"])  
                               | Expr _ => Expr e  
                               | _ => raise Fail "impossible"  
                             (* end case *))  
                         | (Expr _, _) => Expr e  
                         | _ => raise Fail "impossible"  
                       (* end case *))  
                   | AST.E_LoadNrrd _ => if isInput  
                       then Expr e  
                       else err [S "invalid constant expression"]  
                   | 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  
   
83    end    end

Legend:
Removed from v.3444  
changed lines
  Added in v.3454

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