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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4317 - (view) (download)

1 : jhr 3454 (* check-const.sml
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2015 The University of Chicago
6 :     * All rights reserved.
7 :     *)
8 :    
9 :     structure CheckConst : sig
10 :    
11 :     (* evaluate a constant expression; this returns NONE if the expression is not a valid
12 :     * constant expression and will also emit an error message into the error stream.
13 :     * The bool should be true if the constant is the default value for an input variable,
14 :     * since we then allow "load" and "image".
15 :     *)
16 :     val eval : ((Error.err_stream * Error.span) * bool * AST.expr) -> ConstExpr.t option
17 :    
18 :     end = struct
19 :    
20 :     structure L = Literal
21 :     structure BV = BasisVars
22 : jhr 3455 structure Ty = Types
23 : jhr 3454 structure C = ConstExpr
24 :    
25 : jhr 3455 datatype token = datatype TypeError.token
26 :    
27 : jhr 3454 (* an exception to raise when the arguments to an operator are not concrete values
28 :     * of the right type.
29 :     *)
30 :     exception Arg
31 :    
32 : jhr 3455 val unaryOpTbl : (C.t -> C.t) Var.Tbl.hash_table = let
33 : jhr 4317 val tbl = Var.Tbl.mkTable (16, Fail "unOpTbl")
34 :     val ins = Var.Tbl.insert tbl
35 :     fun tensorNeg (C.Real r) = C.Real(RealLit.negate r)
36 :     | tensorNeg (C.Tensor(vs, ty)) = C.Tensor(List.map tensorNeg vs, ty)
37 :     | tensorNeg (C.Expr _) = raise Arg
38 :     | tensorNeg _ = raise Fail "impossible"
39 :     in
40 :     List.app ins [
41 :     (BV.op_not, fn (C.Bool b) => C.Bool(not b) | _ => raise Arg),
42 :     (BV.neg_i, fn (C.Int a) => C.Int(IntLit.neg a) | _ => raise Arg),
43 :     (BV.neg_t, tensorNeg)
44 :     ];
45 :     tbl
46 :     end
47 : jhr 3454
48 : jhr 3455 val binOpTbl : (C.t * C.t -> C.t) Var.Tbl.hash_table = let
49 : jhr 4317 val tbl = Var.Tbl.mkTable (64, Fail "binOpTbl")
50 :     val ins = Var.Tbl.insert tbl
51 :     in
52 :     List.app ins [
53 :     (BV.equ_bb, fn (C.Bool a, C.Bool b) => C.Bool(a = b) | _ => raise Arg),
54 :     (BV.neq_bb, fn (C.Bool a, C.Bool b) => C.Bool(a <> b) | _ => raise Arg),
55 :     (BV.add_ii, fn (C.Int a, C.Int b) => C.Int(IntLit.add(a, b)) | _ => raise Arg),
56 :     (BV.sub_ii, fn (C.Int a, C.Int b) => C.Int(IntLit.sub(a, b)) | _ => raise Arg),
57 :     (BV.mul_ii, fn (C.Int a, C.Int b) => C.Int(IntLit.mul(a, b)) | _ => raise Arg),
58 :     (BV.div_ii, fn (C.Int a, C.Int b) => C.Int(IntLit.divide(a, b)) | _ => raise Arg),
59 :     (BV.op_mod, fn (C.Int a, C.Int b) => C.Int(IntLit.modulo(a, b)) | _ => raise Arg),
60 :     (BV.lt_ii, fn (C.Int a, C.Int b) => C.Bool(a < b) | _ => raise Arg),
61 :     (BV.lte_ii, fn (C.Int a, C.Int b) => C.Bool(a <= b) | _ => raise Arg),
62 :     (BV.gt_ii, fn (C.Int a, C.Int b) => C.Bool(a > b) | _ => raise Arg),
63 :     (BV.gte_ii, fn (C.Int a, C.Int b) => C.Bool(a >= b) | _ => raise Arg),
64 :     (BV.equ_ii, fn (C.Int a, C.Int b) => C.Bool(a = b) | _ => raise Arg),
65 :     (BV.neq_ii, fn (C.Int a, C.Int b) => C.Bool(a <> b) | _ => raise Arg)
66 :     ];
67 :     tbl
68 :     end
69 : jhr 3454
70 : jhr 3455 fun eval (cxt, true, e as AST.E_LoadNrrd _) = SOME(C.Expr e) (* top-level load is okay for input *)
71 : jhr 3454 | eval (cxt, isInput, constExp) = let
72 : jhr 4317 exception EVAL
73 :     fun err msg = (TypeError.error (cxt, msg); raise EVAL)
74 :     fun mkPrim (f, mvs, args, ty) =
75 :     if Basis.allowedInConstExp f
76 :     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"]
78 :     val findBinOp = Var.Tbl.find binOpTbl
79 :     val findUnaryOp = Var.Tbl.find unaryOpTbl
80 :     fun eval' e = (case e
81 :     of AST.E_Var(x, span) => (case C.valueOf x
82 :     of SOME v => v
83 :     | NONE => err [
84 :     S "reference to non-constant variable ", V x,
85 :     S " in constant expression"
86 :     ]
87 :     (* end case *))
88 :     | AST.E_Lit(L.String s) => C.String s
89 :     | AST.E_Lit(L.Bool b) => C.Bool b
90 :     | AST.E_Lit(L.Int i) => C.Int i
91 :     | AST.E_Lit(L.Real r) => C.Real r
92 :     | AST.E_Prim(f, mvs, [e], ty) => (case findUnaryOp f
93 :     of SOME rator => let
94 :     val e' = eval' e
95 :     in
96 :     rator e'
97 :     handle Arg => mkPrim (f, mvs, [e'], ty)
98 :     end
99 :     | NONE => err[S "invalid constant expression"]
100 :     (* end case *))
101 :     | AST.E_Prim(f, mvs, [e1, e2], ty) => (case findBinOp f
102 :     of SOME rator => let
103 :     val e1' = eval' e1
104 :     val e2' = eval' e2
105 :     in
106 :     rator (e1', e2')
107 :     handle Arg => mkPrim (f, mvs, [e1', e2'], ty)
108 :     end
109 :     | NONE => err[S "invalid constant expression"]
110 :     (* end case *))
111 :     | AST.E_Prim(f, mvs, args, ty) =>
112 :     mkPrim (f, mvs, List.map eval' args, ty)
113 :     | AST.E_Tensor(es, ty) => C.Tensor(List.map eval' es, ty)
114 :     | AST.E_Seq(es, ty) => C.Seq(List.map eval' es, ty)
115 :     | AST.E_Slice(e, indices, _) => (case (eval' e, indices)
116 :     of (C.Tensor(vs, _), _) => raise Fail "FIXME"
117 :     | (C.Seq(vs, _), [SOME idx]) => (case eval' idx
118 :     of C.Int i => (List.nth(vs, Int.fromLarge i)
119 :     handle _ => err [S "out-of-bounds sequence access in constant expression"])
120 :     | C.Expr _ => C.Expr e
121 :     | _ => raise Fail "impossible"
122 :     (* end case *))
123 :     | (C.Expr _, _) => C.Expr e
124 :     | _ => raise Fail "impossible"
125 :     (* end case *))
126 :     | AST.E_LoadNrrd _ => if isInput
127 :     then err [S "invalid input initialization"]
128 :     else err [S "invalid constant expression"]
129 :     | AST.E_Coerce{srcTy=Ty.T_Int, dstTy as Ty.T_Tensor(Ty.Shape[]), e} => (
130 :     case eval' e
131 :     of C.Int i => C.Real(RealLit.fromInt i)
132 :     | C.Expr e' =>
133 :     C.Expr(AST.E_Coerce{srcTy=Ty.T_Int, dstTy=dstTy, e=e'})
134 :     | _ => raise Fail "impossible"
135 :     (* end case *))
136 :     | _ => err [S "invalid constant expression"]
137 :     (* end case *))
138 :     in
139 :     SOME(eval' constExp) handle EVAL => NONE
140 :     end
141 : jhr 3454
142 :     end

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