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 3407, Wed Nov 11 18:53:18 2015 UTC revision 3431, Sat Nov 14 14:03:58 2015 UTC
# Line 13  Line 13 
13    (* type check an expression *)    (* type check an expression *)
14      val check : Env.t * Env.context * ParseTree.expr -> (AST.expr * Types.ty)      val check : Env.t * Env.context * ParseTree.expr -> (AST.expr * Types.ty)
15    
16      (* type check a list of expressions *)
17        val checkList : Env.t * Env.context * ParseTree.expr list -> (AST.expr list * Types.ty list)
18    
19      (* type check an iteration expression (i.e., "x 'in' expr"), returning the iterator
20       * and the environment extended with a binding for x.
21       *)
22        val checkIter : Env.t * Env.context * ParseTree.iterator -> ((AST.var * AST.expr) * Env.t)
23    
24      (* type check a dimension that is given by a constant expression *)
25        val checkDim : Env.t * Env.context * ParseTree.expr -> IntLit.t option
26    
27      (* type check a tensor shape, where the dimensions are given by constant expressions *)
28        val checkShape : Env.t * Env.context * ParseTree.expr list -> Types.shape
29    
30    (* `resolveOverload (cxt, rator, tys, args, candidates)` resolves the application of    (* `resolveOverload (cxt, rator, tys, args, candidates)` resolves the application of
31     * the overloaded operator `rator` to `args`, where `tys` are the types of the arguments     * the overloaded operator `rator` to `args`, where `tys` are the types of the arguments
32     * and `candidates` is the list of candidate definitions.     * and `candidates` is the list of candidate definitions.
# Line 20  Line 34 
34      val resolveOverload : Env.context * Atom.atom * Types.ty list * AST.expr list * Var.t list      val resolveOverload : Env.context * Atom.atom * Types.ty list * AST.expr list * Var.t list
35            -> (AST.expr * Types.ty)            -> (AST.expr * Types.ty)
36    
   (* check a dimension that is given by a constant expression *)  
     val checkDim : Env.t * Env.context * ParseTree.expr -> IntLit.t option  
   
   (* check a tensor shape, where the dimensions are given by constant expressions *)  
     val checkShape : Env.t * Env.context * ParseTree.expr list -> Types.shape  
   
37    end = struct    end = struct
38    
39      structure PT = ParseTree      structure PT = ParseTree
# Line 45  Line 53 
53      datatype token = datatype TypeError.token      datatype token = datatype TypeError.token
54    
55    (* mark a variable use with its location *)    (* mark a variable use with its location *)
56      fun useVar (cxt, x) = (x, Error.location cxt)      fun useVar (cxt : Env.context, x) = (x, #2 cxt)
57    
58      (* strip any marks that enclose an expression and return the span and the expression *)
59        fun stripMark (_, PT.E_Mark{span, tree}) = stripMark(span, tree)
60          | stripMark (span, e) = (span, e)
61    
62    (* resolve overloading: we use a simple scheme that selects the first operator in the    (* resolve overloading: we use a simple scheme that selects the first operator in the
63     * list that matches the argument types.     * list that matches the argument types.
# Line 264  Line 276 
276                  val eTy1 = check (env, cxt, e1)                  val eTy1 = check (env, cxt, e1)
277                  val eTy2 = check (env, cxt, e2)                  val eTy2 = check (env, cxt, e2)
278                  in                  in
279                    case check(env, cxt, cond)                    case checkAndPrune(env, cxt, cond)
280                     of (cond', Ty.T_Bool) => (case Util.coerceType2(eTy1, eTy2)                     of (cond', Ty.T_Bool) => (case Util.coerceType2(eTy1, eTy2)
281                           of SOME(e1', e2', ty) => (AST.E_Cond(cond', e1', e2', ty), ty)                           of SOME(e1', e2', ty) => (AST.E_Cond(cond', e1', e2', ty), ty)
282                            | NONE => err (cxt, [                            | NONE => err (cxt, [
# Line 273  Line 285 
285                                S "  false branch: ", TY(#2 eTy2)                                S "  false branch: ", TY(#2 eTy2)
286                              ])                              ])
287                          (* end case *))                          (* end case *))
288                        | (_, Ty.T_Error) => bogusExpTy
289                      | (_, ty') => err (cxt, [S "expected bool type, but found ", TY ty'])                      | (_, ty') => err (cxt, [S "expected bool type, but found ", TY ty'])
290                    (* end case *)                    (* end case *)
291                  end                  end
# Line 312  Line 325 
325                                case Unify.matchArgs(domTy, [e1', e2'], [ty1, ty2])                                case Unify.matchArgs(domTy, [e1', e2'], [ty1, ty2])
326                                 of SOME args => (AST.E_Prim(rator, tyArgs, args, rngTy), rngTy)                                 of SOME args => (AST.E_Prim(rator, tyArgs, args, rngTy), rngTy)
327                                  | NONE => err (cxt, [                                  | NONE => err (cxt, [
328                                        S "type error for binary operator '", V rator, S "'\n",                                        S "type error for binary operator ", V rator, S "\n",
329                                        S "  expected:  ", TYS domTy, S "\n",                                        S "  expected:  ", TYS domTy, S "\n",
330                                        S "  but found: ", TYS[ty1, ty2]                                        S "  but found: ", TYS[ty1, ty2]
331                                      ])                                      ])
# Line 331  Line 344 
344                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = TU.instantiate(Var.typeOf rator)                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = TU.instantiate(Var.typeOf rator)
345                          in                          in
346                            case Util.coerceType (domTy, eTy)                            case Util.coerceType (domTy, eTy)
347                             of SOME(e', ty) => (AST.E_Prim(rator, tyArgs, [e'], rngTy), rngTy)                             of SOME e' => (AST.E_Prim(rator, tyArgs, [e'], rngTy), rngTy)
348                              | NONE => err (cxt, [                              | NONE => err (cxt, [
349                                    S "type error for unary operator \"", V rator, S "\"\n",                                    S "type error for unary operator ", V rator, S "\n",
350                                    S "  expected:  ", TY domTy, S "\n",                                    S "  expected:  ", TY domTy, S "\n",
351                                    S "  but found: ", TY (#2 eTy)                                    S "  but found: ", TY (#2 eTy)
352                                  ])                                  ])
# Line 344  Line 357 
357                    (* end case *)                    (* end case *)
358                  end                  end
359              | PT.E_Apply(e, args) => let              | PT.E_Apply(e, args) => let
                 fun stripMark (_, PT.E_Mark{span, tree}) = stripMark(span, tree)  
                   | stripMark (span, e) = (span, e)  
360                  val (args, tys) = checkList (env, cxt, args)                  val (args, tys) = checkList (env, cxt, args)
361                  fun appTyError (f, paramTys, argTys) = err(cxt, [                  fun appTyError (f, paramTys, argTys) = err(cxt, [
362                          S "type error in application of ", V f, S "\n",                          S "type error in application of ", V f, S "\n",
# Line 385  Line 396 
396                              in                              in
397                                if Unify.equalType(fldTy, ty1)                                if Unify.equalType(fldTy, ty1)
398                                  then (case Util.coerceType(domTy, (e2', ty2))                                  then (case Util.coerceType(domTy, (e2', ty2))
399                                     of SOME(e2', _) => (AST.E_Prim(BV.op_probe, tyArgs, [e1', e2'], rngTy), rngTy)                                     of SOME e2' => (AST.E_Prim(BV.op_probe, tyArgs, [e1', e2'], rngTy), rngTy)
400                                      | NONE => tyError()                                      | NONE => tyError()
401                                    (* end case *))                                    (* end case *))
402                                  else tyError()                                  else tyError()
# Line 409  Line 420 
420                      | _ => checkFieldApp (check (env, cxt, e))                      | _ => checkFieldApp (check (env, cxt, e))
421                    (* end case *)                    (* end case *)
422                  end                  end
423              | PT.E_Subscript(e, indices) => (case (check(env, cxt, e), indices)              | PT.E_Subscript(e, indices) => let
424                   of ((e', Ty.T_Sequence(elemTy, _)), [SOME e2]) => raise Fail "FIXME"                  fun expectedTensor ty = err(cxt, [
425                    | ((e', Ty.T_Tensor shape), _) => raise Fail "FIXME"                          S "expected tensor type for slicing, but found ", TY ty
426                    | ((_, ty), _) => err(cxt, [                        ])
427                          S "expected sequence or tensor type for object of subscripting, but found",                  fun chkIndex e = let
428                          TY ty                        val eTy as (_, ty) = check(env, cxt, e)
429                          in
430                            if Unify.equalType(ty, Ty.T_Int)
431                              then eTy
432                              else err (cxt, [
433                                  S "expected type 'int' for index, but found ", TY ty
434                        ])                        ])
435                  (* end case *))                        end
             | PT.E_Select(e, field) => (case check(env, cxt, e)  
                  of (e', Ty.T_Named strand) => (case Env.findStrand(env, strand)  
                        of SOME sEnv => (case StrandEnv.findStateVar(sEnv, field)  
                              of SOME x' => let  
                                   val ty = Var.monoTypeOf x'  
436                                    in                                    in
437                                      (AST.E_Select(e', useVar(cxt, x')), ty)                    case (check(env, cxt, e), indices)
438                       of ((e', Ty.T_Error), _) => (
439                            List.app (ignore o Option.map chkIndex) indices;
440                            bogusExpTy)
441                        | ((e1', ty1 as Ty.T_Sequence(elemTy, optDim)), [SOME e2]) => let
442                            val (e2', ty2) = chkIndex e2
443                            val rator = if isSome optDim
444                                  then BV.subscript
445                                  else BV.dynSubscript
446                            val (tyArgs, Ty.T_Fun(domTy, rngTy)) = TU.instantiate(Var.typeOf rator)
447                            in
448                              if Unify.equalTypes(domTy, [ty1, ty2])
449                                then let
450                                  val exp = AST.E_Prim(rator, tyArgs, [e1', e2'], rngTy)
451                                  in
452                                    (exp, rngTy)
453                                    end                                    end
454                                | NONE => err(cxt, [                              else raise Fail "unexpected unification failure"
455                                      S "strand '", A strand,                          end
456                                      S "' does not have state variable '", A field, S "'"                      | ((e', ty as Ty.T_Sequence _), [NONE]) => expectedTensor ty
457                        | ((e', ty as Ty.T_Sequence _), _) => expectedTensor ty
458                        | ((e', ty as Ty.T_Tensor shape), _) => let
459                            val indices' = List.map (Option.map (#1 o chkIndex)) indices
460                            val order = List.length indices'
461                            val expectedTy = TU.mkTensorTy order
462                            val resultTy = TU.slice(expectedTy, List.map Option.isSome indices')
463                            in
464                              if Unify.equalType(ty, expectedTy)
465                                then (AST.E_Slice(e', indices', resultTy), resultTy)
466                                else err (cxt, [
467                                    S "type error in slice operation\n",
468                                    S "  expected:  ", S(Int.toString order), S "-order tensor\n",
469                                    S "  but found: ", TY ty
470                                  ])
471                            end
472                        | ((_, ty), _) => expectedTensor ty
473                      (* end case *)
474                    end
475                | PT.E_Select(e, field) => (case stripMark(#2 cxt, e)
476                     of (_, PT.E_Var x) => (case E.findStrand (env, x)
477                           of SOME _ => if E.inGlobalUpdate env
478                                then (case E.findSetFn (env, field)
479                                   of SOME setFn => let
480                                        val (mvs, ty) = TU.instantiate (Var.typeOf setFn)
481                                        val resTy = Ty.T_Sequence(Ty.T_Named x, NONE)
482                                        in
483                                          E.recordProp (env, Properties.StrandSets);
484                                          if Unify.equalType(ty, Ty.T_Fun([], resTy))
485                                            then (AST.E_Prim(setFn, mvs, [], resTy), resTy)
486                                            else raise Fail "impossible"
487                                        end
488                                    | _ => err (cxt, [
489                                          S "unknown strand-set specifier ", A field
490                                    ])                                    ])
491                              (* end case *))                              (* end case *))
492                          | NONE => err(cxt, [S "unknown strand '", A strand, S "'"])                              else err (cxt, [
493                        (* end case *))                                  S "illegal strand set specification in ",
494                    | (_, ty) => err (cxt, [                                  S(E.scopeToString(E.currentScope env))
                         S "expected strand type, but found ", TY ty,  
                         S " in selection of '", A field, S "'"  
495                        ])                        ])
496                            | _ => checkSelect (env, cxt, e, field)
497                          (* end case *))
498                      | _ => checkSelect (env, cxt, e, field)
499                  (* end case *))                  (* end case *))
500              | PT.E_Real e => (case check (env, cxt, e)              | PT.E_Real e => (case checkAndPrune (env, cxt, e)
501                   of (e', Ty.T_Int) =>                   of (e', Ty.T_Int) =>
502                        (AST.E_Prim(BV.i2r, [], [e'], Ty.realTy), Ty.realTy)                        (AST.E_Prim(BV.i2r, [], [e'], Ty.realTy), Ty.realTy)
503                      | (e', Ty.T_Error) => bogusExpTy
504                    | (_, ty) => err(cxt, [                    | (_, ty) => err(cxt, [
505                          S "argument of 'real' must have type 'int', but found ",                          S "argument of 'real' must have type 'int', but found ",
506                          TY ty                          TY ty
507                        ])                        ])
508                  (* end case *))                  (* end case *))
509              | PT.E_Load nrrd => let              | PT.E_Load nrrd => let
510                  val (tyArgs, Ty.T_Fun(_, rngTy)) = TU.instantiate(Var.typeOf(BV.fn_image))                  val (tyArgs, Ty.T_Fun(_, rngTy)) = TU.instantiate(Var.typeOf(BV.fn_load))
511                  in                  in
512                    case chkStringConstExpr (env, cxt, nrrd)                    case chkStringConstExpr (env, cxt, nrrd)
513                     of SOME nrrd => (AST.E_LoadNrrd(tyArgs, nrrd, rngTy), rngTy)                     of SOME nrrd => (AST.E_LoadNrrd(tyArgs, nrrd, rngTy), rngTy)
# Line 454  Line 515 
515                    (* end case *)                    (* end case *)
516                  end                  end
517              | PT.E_Image nrrd => let              | PT.E_Image nrrd => let
518                  val (tyArgs, Ty.T_Fun(_, rngTy)) = TU.instantiate(Var.typeOf(BV.fn_load))                  val (tyArgs, Ty.T_Fun(_, rngTy)) = TU.instantiate(Var.typeOf(BV.fn_image))
519                  in                  in
520                    case chkStringConstExpr (env, cxt, nrrd)                    case chkStringConstExpr (env, cxt, nrrd)
521                     of SOME nrrd => (AST.E_LoadNrrd(tyArgs, nrrd, rngTy), rngTy)                     of SOME nrrd => (AST.E_LoadNrrd(tyArgs, nrrd, rngTy), rngTy)
# Line 465  Line 526 
526                   of SOME x' => (AST.E_Var(useVar(cxt, x')), Var.monoTypeOf x')                   of SOME x' => (AST.E_Var(useVar(cxt, x')), Var.monoTypeOf x')
527                    | NONE => err(cxt, [S "undeclared variable ", A x])                    | NONE => err(cxt, [S "undeclared variable ", A x])
528                  (* end case *))                  (* end case *))
529              | PT.E_Kernel(kern, dim) => raise Fail "FIXME"              | PT.E_Kernel(kern, dim) => (case E.findVar (env, kern)
530                     of SOME kern' => (case Var.monoTypeOf kern'
531                           of ty as Ty.T_Kernel(Ty.DiffConst k) => let
532                                val k' = Int.fromLarge dim handle Overflow => 1073741823
533                                val e = AST.E_Var(useVar(cxt, kern'))
534                                in
535                                  if (k = k')
536                                    then (e, ty)
537                                    else let
538                                      val ty' = Ty.T_Kernel(Ty.DiffConst k')
539                                      in
540                                        (AST.E_Coerce{srcTy = ty, dstTy = ty', e = e}, ty')
541                                      end
542                                end
543                            | _ => err(cxt, [S "expected kernel, but found ", S(Var.kindToString kern')])
544                          (* end case *))
545                      | NONE => err(cxt, [S "unknown kernel ", A kern])
546                    (* end case *))
547              | PT.E_Lit lit => checkLit lit              | PT.E_Lit lit => checkLit lit
548              | PT.E_Id d => let              | PT.E_Id d => let
549                  val (tyArgs, Ty.T_Fun(_, rngTy)) =                  val (tyArgs, Ty.T_Fun(_, rngTy)) =
# Line 491  Line 569 
569                      then (AST.E_Prim(BV.nan, tyArgs, [], rngTy), rngTy)                      then (AST.E_Prim(BV.nan, tyArgs, [], rngTy), rngTy)
570                      else raise Fail "impossible"                      else raise Fail "impossible"
571                  end                  end
572              | PT.E_Sequence exps => raise Fail "FIXME"              | PT.E_Sequence exps => (case checkList (env, cxt, exps)
573              | PT.E_SeqComp comp => raise Fail "FIXME"  (* FIXME: need kind for concrete types here! *)
574                     of ([], _) => let
575                          val ty = Ty.T_Sequence(Ty.T_Var(MetaVar.newTyVar()), SOME(Ty.DimConst 0))
576                          in
577                            (AST.E_Seq([], ty), ty)
578                          end
579                      | (args, tys) => (case Util.coerceTypes(List.map TU.pruneHead tys)
580                           of SOME ty => if TU.isValueType ty
581                                then let
582                                  fun doExp eTy = valOf(Util.coerceType (ty, eTy))
583                                  val resTy = Ty.T_Sequence(ty, SOME(Ty.DimConst(List.length args)))
584                                  val args = ListPair.map doExp (args, tys)
585                                  in
586                                    (AST.E_Seq(args, resTy), resTy)
587                                  end
588                                else err(cxt, [S "sequence expression of non-value argument type"])
589                            | NONE => err(cxt, [S "arguments of sequence expression must have same type"])
590                          (* end case *))
591                    (* end case *))
592                | PT.E_SeqComp comp => chkComprehension (env, cxt, comp)
593              | PT.E_Cons args => let              | PT.E_Cons args => let
594                (* Note that we are guaranteed that args is non-empty *)                (* Note that we are guaranteed that args is non-empty *)
595                  val (args, tys) = checkList (env, cxt, args)                  val (args, tys) = checkList (env, cxt, args)
# Line 507  Line 604 
604                        val resTy = Ty.T_Tensor(Ty.Shape(Ty.DimConst(List.length args) :: dd))                        val resTy = Ty.T_Tensor(Ty.Shape(Ty.DimConst(List.length args) :: dd))
605                        fun chkArgs (arg::args, argTy::tys, args') = (                        fun chkArgs (arg::args, argTy::tys, args') = (
606                              case Util.coerceType(ty, (arg, argTy))                              case Util.coerceType(ty, (arg, argTy))
607                               of SOME(arg', _) => chkArgs (args, tys, arg'::args')                               of SOME arg' => chkArgs (args, tys, arg'::args')
608                                | NONE => (                                | NONE => (
609                                    TypeError.error(cxt, [                                    TypeError.error(cxt, [
610                                        S "arguments of tensor construction must have same type"                                        S "arguments of tensor construction must have same type"
611                                      ]);                                      ]);
612                                    chkArgs (args, tys, bogusExp::args'))                                    chkArgs (args, tys, bogusExp::args'))
613                              (* end case *))                              (* end case *))
614                          | chkArgs ([], [], args') = (AST.E_Tensor(List.rev args', resTy), resTy)                          | chkArgs (_, _, args') = (AST.E_Tensor(List.rev args', resTy), resTy)
615                        in                        in
616                          chkArgs (args, tys, [])                          chkArgs (args, tys, [])
617                        end                        end
# Line 530  Line 627 
627                  check (env, cxt, e))                  check (env, cxt, e))
628            (* end case *))            (* end case *))
629    
630      (* typecheck and the prune the result *)
631        and checkAndPrune (env, cxt, e) = let
632              val (e, ty) = check (env, cxt, e)
633              in
634                (e, TU.prune ty)
635              end
636    
637    (* check a conditional operator (e.g., || or &&) *)    (* check a conditional operator (e.g., || or &&) *)
638      and checkCondOp (env, cxt, e1, rator, e2, mk) = (      and checkCondOp (env, cxt, e1, rator, e2, mk) = (
639            case (check(env, cxt, e1), check(env, cxt, e2))            case (check(env, cxt, e1), check(env, cxt, e2))
# Line 544  Line 648 
648                  ])                  ])
649            (* end case *))            (* end case *))
650    
651      (* check a field select that is _not_ a strand-set *)
652        and checkSelect (env, cxt, e, field) = (case checkAndPrune (env, cxt, e)
653               of (e', Ty.T_Named strand) => (case Env.findStrand(env, strand)
654                     of SOME sEnv => (case StrandEnv.findStateVar(sEnv, field)
655                           of SOME x' => let
656                                val ty = Var.monoTypeOf x'
657                                in
658                                  (AST.E_Select(e', useVar(cxt, x')), ty)
659                                end
660                            | NONE => err(cxt, [
661                                  S "strand ", A strand,
662                                  S " does not have state variable ", A field
663                                ])
664                          (* end case *))
665                      | NONE => err(cxt, [S "unknown strand ", A strand])
666                    (* end case *))
667                | (_, Ty.T_Error) => bogusExpTy
668                | (_, ty) => err (cxt, [
669                      S "expected strand type, but found ", TY ty,
670                      S " in selection of ", A field
671                    ])
672              (* end case *))
673    
674        and chkComprehension (env, cxt, PT.COMP_Mark m) =
675              chkComprehension(E.withEnvAndContext(env, cxt, m))
676          | chkComprehension (env, cxt, PT.COMP_Comprehension(e, [iter])) = let
677              val (iter', env') = checkIter (E.blockScope env, cxt, iter)
678              val (e', ty) = check (env', cxt, e)
679              val resTy = Ty.T_Sequence(ty, NONE)
680              in
681                (AST.E_Comprehension(e', iter', resTy), resTy)
682              end
683          | chkComprehension _ = raise Fail "impossible"
684    
685        and checkIter (env, cxt, PT.I_Mark m) = checkIter (E.withEnvAndContext (env, cxt, m))
686          | checkIter (env, cxt, PT.I_Iterator({span, tree=x}, e)) = (
687              case checkAndPrune (env, cxt, e)
688               of (e', ty as Ty.T_Sequence(elemTy, _)) => let
689                    val x' = Var.new(x, Error.location(#1 cxt, span), Var.LocalVar, elemTy)
690                    in
691                      ((x', e'), E.insertLocal(env, cxt, x, x'))
692                    end
693                | (e', ty) => let
694                    val x' = Var.new(x, Error.UNKNOWN, Var.IterVar, Ty.T_Error)
695                    in
696                      if TU.isErrorType ty
697                        then ()
698                        else TypeError.error (cxt, [
699                            S "expected sequence type in iteration, but found '", TY ty, S "'"
700                          ]);
701                      ((x', bogusExp), E.insertLocal(env, cxt, x, x'))
702                    end
703              (* end case *))
704    
705    (* typecheck a list of expressions returning a list of AST expressions and a list    (* typecheck a list of expressions returning a list of AST expressions and a list
706     * of the types of the expressions.     * of the types of the expressions.
707     *)     *)
708      and checkList (env, cxt, exprs) = let      and checkList (env, cxt, exprs) = let
709            fun chk (e, (es, tys)) = let            fun chk (e, (es, tys)) = let
710                  val (e, ty) = check (env, cxt, e)                  val (e, ty) = checkAndPrune (env, cxt, e)
711                  in                  in
712                    (e::es, ty::tys)                    (e::es, ty::tys)
713                  end                  end
# Line 560  Line 718 
718    (* check a string that is specified as a constant expression *)    (* check a string that is specified as a constant expression *)
719      and chkStringConstExpr (env, cxt, PT.E_Mark m) =      and chkStringConstExpr (env, cxt, PT.E_Mark m) =
720            chkStringConstExpr (E.withEnvAndContext (env, cxt, m))            chkStringConstExpr (E.withEnvAndContext (env, cxt, m))
721        | chkStringConstExpr (env, cxt, e) = (case check (env, cxt, e)        | chkStringConstExpr (env, cxt, e) = (case checkAndPrune (env, cxt, e)
722             of (e', Ty.T_String) => (case ConstExpr.eval (cxt, e')             of (e', Ty.T_String) => (case ConstExpr.eval (cxt, e')
723                   of SOME(ConstExpr.String s) => SOME s                   of SOME(ConstExpr.String s) => SOME s
724                    | SOME(ConstExpr.Expr e) => raise Fail "FIXME"                    | SOME(ConstExpr.Expr e) => raise Fail "FIXME"
725                    | NONE => NONE                    | NONE => NONE
726                    | _ => raise Fail "impossible: wrong type for constant expr"                    | _ => raise Fail "impossible: wrong type for constant expr"
727                  (* end case *))                  (* end case *))
728                | (_, Ty.T_Error) => NONE
729              | (_, ty) => (              | (_, ty) => (
730                  TypeError.error (cxt, [                  TypeError.error (cxt, [
731                      S "expected constant expression of type 'string', but found '",                      S "expected constant expression of type 'string', but found '",
# Line 576  Line 735 
735            (* end case *))            (* end case *))
736    
737    (* check a dimension that is given by a constant expression *)    (* check a dimension that is given by a constant expression *)
738      and checkDim (env, cxt, dim) = (case check (env, cxt, dim)      and checkDim (env, cxt, dim) = (case checkAndPrune (env, cxt, dim)
739             of (e', Ty.T_Int) => (case ConstExpr.eval (cxt, e')             of (e', Ty.T_Int) => (case ConstExpr.eval (cxt, e')
740                   of SOME(ConstExpr.Int d) => SOME d                   of SOME(ConstExpr.Int d) => SOME d
741                    | SOME(ConstExpr.Expr e) => (                    | SOME(ConstExpr.Expr e) => (
# Line 585  Line 744 
744                    | NONE => NONE                    | NONE => NONE
745                    | _ => raise Fail "impossible: wrong type for constant expr"                    | _ => raise Fail "impossible: wrong type for constant expr"
746                  (* end case *))                  (* end case *))
747                | (_, Ty.T_Error) => NONE
748              | (_, ty) => (              | (_, ty) => (
749                  TypeError.error (cxt, [                  TypeError.error (cxt, [
750                      S "expected constant expression of type 'int', but found '",                      S "expected constant expression of type 'int', but found '",

Legend:
Removed from v.3407  
changed lines
  Added in v.3431

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