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

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

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

revision 3396, Tue Nov 10 18:45:38 2015 UTC revision 3398, Wed Nov 11 01:17:58 2015 UTC
# Line 51  Line 51 
51                                S "  true branch:  ", TY(#2 eTy1), S "\n",                                S "  true branch:  ", TY(#2 eTy1), S "\n",
52                                S "  false branch: ", TY(#2 eTy2)                                S "  false branch: ", TY(#2 eTy2)
53                              ])                              ])
54                            (* end case *))
55                      | (_, ty') => err (cxt, [S "expected bool type, but found ", TY ty'])                      | (_, ty') => err (cxt, [S "expected bool type, but found ", TY ty'])
56                    (* end case *)                    (* end case *)
57                  end                  end
58              | PT.E_Range(e1, e2) => (case (check (env, cxt, e1), check (env, cxt, e2))              | PT.E_Range(e1, e2) => (case (check (env, cxt, e1), check (env, cxt, e2))
59                   of ((e1', Ty.T_Int), (e2', Ty.T_Int)) => let                   of ((e1', Ty.T_Int), (e2', Ty.T_Int)) => let
60                        val resTy = Ty.T_DynSequence Ty.T_Int                        val resTy = Ty.T_Sequence(Ty.T_Int, NONE)
61                        in                        in
62                          (AST.E_Apply(BV.range, [], [e1', e2'], resTy), resTy)                          (AST.E_Apply(BV.range, [], [e1', e2'], resTy), resTy)
63                        end                        end
# Line 155  Line 156 
156                          | _ => raise Fail "impossible"                          | _ => raise Fail "impossible"
157                        (* end case *))                        (* end case *))
158                  end                  end
159              | PT.E_UnaryOp of var * expr                        (* <op> e *)              | PT.E_UnaryOp(rator, e) => let
160              | PT.E_Apply of expr * expr list             (* field/function/reduction application *)                  val (e', ty) = checkExpr(env, cxt, e)
161              | PT.E_Subscript of expr * expr option list  (* sequence/tensor indexing; NONE for ':' *)                  in
162              | PT.E_Select of expr * field               (* e '.' <field> *)                    case Env.findFunc (#env env, rator)
163                       of Env.PrimFun[rator] => let
164                            val (tyArgs, Ty.T_Fun([domTy], rngTy)) = U.instantiate(Var.typeOf rator)
165                            in
166                              case coerceType (domTy, ty, e')
167                               of SOME e' => (AST.E_Apply(rator, tyArgs, [e'], rngTy), rngTy)
168                                | NONE => err (cxt, [
169                                      S "type error for unary operator \"", V rator, S "\"\n",
170                                      S "  expected:  ", TY domTy, S "\n",
171                                      S "  but found: ", TY ty
172                                    ])
173                              (* end case *)
174                            end
175                        | Env.PrimFun ovldList => resolveOverload (cxt, rator, [ty], [e'], ovldList)
176                        | _ => raise Fail "impossible"
177                      (* end case *)
178                    end
179                | PT.E_Apply(e, args) => raise Fail "FIXME"
180                | PT.E_Subscript(e, indices) => (case (check(env, cxt, e), indices)
181                     of ((e', Ty.T_Sequence(elemTy, _)), [SOME e2]) => raise Fail "FIXME"
182                      | ((e', Ty.T_Tensor shape), _) => raise Fail "FIXME"
183                      | ((_, ty), _) => err(cxt, [
184                            S "expected sequence or tensor type for object of subscripting, but found",
185                            TY ty
186                          ])
187                    (* end case *))
188                | PT.E_Select(e, field) => (case check(env, cxt, e)
189                     of (e', Ty.T_Strand strand) => (case Env.findStrand(#env env, strand)
190                           of SOME(AST.Strand{name, state, ...}) => let
191                                fun isField (AST.VD_Decl(AST.V{name, ...}, _)) = Atom.same(name, field)
192                                in
193                                  case List.find isField state
194                                   of SOME(AST.VD_Decl(x', _)) => let
195                                        val ty = Var.monoTypeOf x'
196                                        in
197                                          (AST.E_Selector(e', field, ty), ty)
198                                        end
199                                    | NONE => err(cxt, [
200                                          S "strand ", A name,
201                                          S " does not have state variable ", A field
202                                        ])
203                                  (* end case *)
204                                end
205                            | NONE => err(cxt, [S "unknown strand ", A strand])
206                          (* end case *))
207                      | (_, ty) => err (cxt, [
208                            S "expected strand type, but found ", TY ty,
209                            S " in selection of ", A field
210                          ])
211                    (* end case *))
212              | PT.E_Real e => (case check (env, cxt, e)              | PT.E_Real e => (case check (env, cxt, e)
213                   of (e', Ty.T_Int) =>                   of (e', Ty.T_Int) =>
214                        (AST.E_Apply(BV.i2r, [], [e'], Ty.realTy), Ty.realTy)                        (AST.E_Apply(BV.i2r, [], [e'], Ty.realTy), Ty.realTy)
# Line 177  Line 227 
227                  in                  in
228                    (AST.E_LoadNrrd(tyArgs, nrrd, rngTy), rngTy)                    (AST.E_LoadNrrd(tyArgs, nrrd, rngTy), rngTy)
229                  end                  end
230              | PT.E_Var (case E.findVar (#env env, x)              | PT.E_Var x => (case E.findVar (#env env, x)
231                   of SOME x' => (                   of SOME x' => (
232                        markUsed (x', true);                        markUsed (x', true);
233                        (AST.E_Var x', Var.monoTypeOf x'))                        (AST.E_Var x', Var.monoTypeOf x'))
234                    | NONE => err(cxt, [S "undeclared variable ", A x])                    | NONE => err(cxt, [S "undeclared variable ", A x])
235                  (* end case *))                  (* end case *))
236              | PT.E_Kernel of var * dim                  (* kernel '#' dim *)              | PT.E_Kernel(kern, dim) => raise Fail "FIXME"
237              | PT.E_Lit lit => checkLit lit              | PT.E_Lit lit => checkLit lit
238              | PT.E_Id d => let              | PT.E_Id d => let
239                  val (tyArgs, Ty.T_Fun(_, rngTy)) =                  val (tyArgs, Ty.T_Fun(_, rngTy)) =
# Line 209  Line 259 
259                      then (AST.E_Apply(BV.nan, tyArgs, [], rngTy), rngTy)                      then (AST.E_Apply(BV.nan, tyArgs, [], rngTy), rngTy)
260                      else raise Fail "impossible"                      else raise Fail "impossible"
261                  end                  end
262              | PT.E_Sequence of expr list                 (* sequence construction *)              | PT.E_Sequence exps => raise Fail "FIXME"
263              | PT.E_SeqComp of comprehension             (* sequence comprehension *)              | PT.E_SeqComp comp => raise Fail "FIXME"
264              | PT.E_Cons args => let              | PT.E_Cons args => let
265                (* Note that we are guaranteed that args is non-empty *)                (* Note that we are guaranteed that args is non-empty *)
266                  val (args, tys) = checkList (env, cxt, args)                  val (args, tys) = checkList (env, cxt, args)

Legend:
Removed from v.3396  
changed lines
  Added in v.3398

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