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-const.sml
ViewVC logotype

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

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

revision 3454, Mon Nov 23 13:37:18 2015 UTC revision 3455, Mon Nov 23 13:54:15 2015 UTC
# Line 19  Line 19 
19    
20      structure L = Literal      structure L = Literal
21      structure BV = BasisVars      structure BV = BasisVars
22        structure Ty = Types
23      structure C = ConstExpr      structure C = ConstExpr
24    
25        datatype token = datatype TypeError.token
26    
27    (* an exception to raise when the arguments to an operator are not concrete values    (* an exception to raise when the arguments to an operator are not concrete values
28     * of the right type.     * of the right type.
29     *)     *)
30      exception Arg      exception Arg
31    
32      val unaryOpTbl : (const_value -> const_value) Var.Tbl.hash_table = let      val unaryOpTbl : (C.t -> C.t) Var.Tbl.hash_table = let
33            val tbl = Var.Tbl.mkTable (16, Fail "unOpTbl")            val tbl = Var.Tbl.mkTable (16, Fail "unOpTbl")
34            val ins = Var.Tbl.insert tbl            val ins = Var.Tbl.insert tbl
35            fun tensorNeg (C.Real r) = Real(RealLit.negate r)            fun tensorNeg (C.Real r) = C.Real(RealLit.negate r)
36              | tensorNeg (C.Tensor(vs, ty)) = C.Tensor(List.map tensorNeg vs, ty)              | tensorNeg (C.Tensor(vs, ty)) = C.Tensor(List.map tensorNeg vs, ty)
37              | tensorNeg (C.Expr _) = raise Arg              | tensorNeg (C.Expr _) = raise Arg
38              | tensorNeg _ = raise Fail "impossible"              | tensorNeg _ = raise Fail "impossible"
# Line 42  Line 45 
45              tbl              tbl
46            end            end
47    
48      val binOpTbl : (const_value * const_value -> const_value) Var.Tbl.hash_table = let      val binOpTbl : (C.t * C.t -> C.t) Var.Tbl.hash_table = let
49            val tbl = Var.Tbl.mkTable (64, Fail "binOpTbl")            val tbl = Var.Tbl.mkTable (64, Fail "binOpTbl")
50            val ins = Var.Tbl.insert tbl            val ins = Var.Tbl.insert tbl
51            in            in
# Line 64  Line 67 
67              tbl              tbl
68            end            end
69    
70      fun eval (cxt, true, e as AST.E_LoadNrrd _) = C.Expr e (* top-level load is okay for input *)      fun eval (cxt, true, e as AST.E_LoadNrrd _) = SOME(C.Expr e) (* top-level load is okay for input *)
71        | eval (cxt, isInput, constExp) = let        | eval (cxt, isInput, constExp) = let
72            exception EVAL            exception EVAL
73            fun err msg = (TypeError.error (cxt, msg); raise EVAL)            fun err msg = (TypeError.error (cxt, msg); raise EVAL)
74            fun mkPrim (f, mvs, args, ty) =            fun mkPrim (f, mvs, args, ty) =
75                  if Basis.allowedInConstExp f                  if Basis.allowedInConstExp f
76                    then Expr(AST.E_Prim(f, mvs, List.map valueToExpr args, ty))                    then C.Expr(AST.E_Prim(f, mvs, List.map C.valueToExpr args, ty))
77                    else err [S "invalid use of ", V f, S " in constant expression"]                    else err [S "invalid use of ", V f, S " in constant expression"]
78            val findBinOp = Var.Tbl.find binOpTbl            val findBinOp = Var.Tbl.find binOpTbl
79            val findUnaryOp = Var.Tbl.find unaryOpTbl            val findUnaryOp = Var.Tbl.find unaryOpTbl
80            fun eval' e = (case e            fun eval' e = (case e
81                   of AST.E_Var(x, span) => (case valueOf x                   of AST.E_Var(x, span) => (case C.valueOf x
82                         of SOME v => v                         of SOME v => v
83                          | NONE => err [                          | NONE => err [
84                                S "reference to non-constant variable ", V x,                                S "reference to non-constant variable ", V x,
# Line 113  Line 116 
116                    | AST.E_Slice(e, indices, _) => (case (eval' e, indices)                    | AST.E_Slice(e, indices, _) => (case (eval' e, indices)
117                         of (C.Tensor(vs, _), _) => raise Fail "FIXME"                         of (C.Tensor(vs, _), _) => raise Fail "FIXME"
118                          | (C.Seq(vs, _), [SOME idx]) => (case eval' idx                          | (C.Seq(vs, _), [SOME idx]) => (case eval' idx
119                               of Int i => (List.nth(vs, Int.fromLarge i)                               of C.Int i => (List.nth(vs, Int.fromLarge i)
120                                    handle _ => err [S "out-of-bounds sequence access in constant expression"])                                    handle _ => err [S "out-of-bounds sequence access in constant expression"])
121                                | C.Expr _ => C.Expr e                                | C.Expr _ => C.Expr e
122                                | _ => raise Fail "impossible"                                | _ => raise Fail "impossible"
# Line 126  Line 129 
129                        else err [S "invalid constant expression"]                        else err [S "invalid constant expression"]
130                    | AST.E_Coerce{srcTy=Ty.T_Int, dstTy as Ty.T_Tensor(Ty.Shape[]), e} => (                    | AST.E_Coerce{srcTy=Ty.T_Int, dstTy as Ty.T_Tensor(Ty.Shape[]), e} => (
131                        case eval' e                        case eval' e
132                         of C.Int i => Real(RealLit.fromInt i)                         of C.Int i => C.Real(RealLit.fromInt i)
133                          | C.Expr e' =>                          | C.Expr e' =>
134                              C.Expr(AST.E_Coerce{srcTy=Ty.T_Int, dstTy=dstTy, e=e'})                              C.Expr(AST.E_Coerce{srcTy=Ty.T_Int, dstTy=dstTy, e=e'})
135                          | _ => raise Fail "impossible"                          | _ => raise Fail "impossible"

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

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