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

SCM Repository

[diderot] View of /branches/vis15/src/compiler/simplify/simplify.sml
ViewVC logotype

View of /branches/vis15/src/compiler/simplify/simplify.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4043 - (download) (annotate)
Sun Jun 26 14:00:38 2016 UTC (3 years, 2 months ago) by jhr
File size: 21959 byte(s)
  Working on merge: changed the way that we handle kernels in the AST and SimpleAST IRs (treat
  them like literals, instead of like variables).  Added code to rewrite Inside tests in Simple
  IR to use the image instead of the field, which fixes a problem with trying to do inside tests
  on Ein fields.  Added code to promote locals to globals as part of the simplify-vars phase.
(* simplify.sml
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2015 The University of Chicago
 * All rights reserved.
 *
 * Simplify the AST representation.  This phase involves the following transformations:
 *
 *	- types are simplified by removing meta variables (which will have been resolved)
 *
 *	- expressions are simplified to involve a single operation on variables
 *
 *	- global reductions are converted to MapReduce statements
 *
 *	- other comprehensions and reductions are converted to foreach loops
 *
 *	- unreachable code is pruned
 *
 *	- negation of literal integers and reals are constant folded
 *)

structure Simplify : sig

    val transform : Error.err_stream * AST.program -> Simple.program

  end = struct

    structure TU = TypeUtil
    structure S = Simple
    structure STy = SimpleTypes
    structure Ty = Types
    structure VMap = Var.Map

  (* convert a Types.ty to a SimpleTypes.ty *)
    fun cvtTy ty = (case ty
           of Ty.T_Var(Ty.TV{bind, ...}) => (case !bind
                 of NONE => raise Fail "unresolved type variable"
                  | SOME ty => cvtTy ty
                (* end case *))
            | Ty.T_Bool => STy.T_Bool
            | Ty.T_Int => STy.T_Int
            | Ty.T_String => STy.T_String
            | Ty.T_Sequence(ty, NONE) => STy.T_Sequence(cvtTy ty, NONE)
            | Ty.T_Sequence(ty, SOME dim) => STy.T_Sequence(cvtTy ty, SOME(TU.monoDim dim))
	    | Ty.T_Strand id => STy.T_Strand id
            | Ty.T_Kernel n => STy.T_Kernel(TU.monoDiff n)
            | Ty.T_Tensor shape => STy.T_Tensor(TU.monoShape shape)
            | Ty.T_Image{dim, shape} => STy.T_Image{
                  dim = TU.monoDim dim,
                  shape = TU.monoShape shape
                }
            | Ty.T_Field{diff, dim, shape} => STy.T_Field{
                  diff = TU.monoDiff diff,
                  dim = TU.monoDim dim,
                  shape = TU.monoShape shape
                }
            | Ty.T_Fun(tys1, ty2) => STy.T_Fun(List.map cvtTy tys1, cvtTy ty2)
	    | Ty.T_Error => raise Fail "unexpected T_Error in Simplify"
          (* end case *))

    fun apiTypeOf x = let
	  fun cvtTy STy.T_Bool = APITypes.BoolTy
	    | cvtTy STy.T_Int = APITypes.IntTy
	    | cvtTy STy.T_String = APITypes.StringTy
	    | cvtTy (STy.T_Sequence(ty, len)) = APITypes.SeqTy(cvtTy ty, len)
	    | cvtTy (STy.T_Tensor shape) = APITypes.TensorTy shape
	    | cvtTy (STy.T_Image{dim, shape}) = APITypes.ImageTy(dim, shape)
	    | cvtTy ty = raise Fail "bogus API type"
	  in
	    cvtTy (SimpleVar.typeOf x)
	  end

    fun newTemp ty = SimpleVar.new ("_t", SimpleVar.LocalVar, ty)

  (* a property to map AST variables to SimpleAST variables *)
    local
      fun cvt x = SimpleVar.new (Var.nameOf x, Var.kindOf x, cvtTy(Var.monoTypeOf x))
    in
    val {getFn = cvtVar, ...} = Var.newProp cvt
    end

    fun cvtVars xs = List.map cvtVar xs

  (* make a block out of a list of statements that are in reverse order *)
    fun mkBlock stms = S.Block{props = PropList.newHolder(), code = List.rev stms}

    fun inputImage (errStrm, nrrd, dim, shape) = (
          case ImageInfo.fromNrrd(NrrdInfo.getInfo(errStrm, nrrd), dim, shape)
           of NONE => raise Fail(concat["nrrd file \"", nrrd, "\" does not have expected type"])
            | SOME info => S.Proxy(nrrd, info)
          (* end case *))

    datatype 'a ctl_flow_info
      = EXIT                    (* stm sequence always exits; no pruning so far *)
      | PRUNE of 'a             (* stm sequence always exits at last stm in argument, which
                                 * is either a block or stm list *)
      | CONT                    (* stm sequence falls through *)
      | EDIT of 'a              (* pruned code that has non-exiting paths *)

    fun pruneUnreachableCode blk = let
          fun isExit S.S_Die = true
            | isExit S.S_Stabilize = true
            | isExit (S.S_Return _) = true
            | isExit _ = false
          fun pruneStms [] = CONT
            | pruneStms [S.S_IfThenElse(x, blk1, blk2)] = (
                case pruneIf(x, blk1, blk2)
                 of EXIT => EXIT
                  | PRUNE stm => PRUNE[stm]
                  | CONT => CONT
                  | EDIT stm => EDIT[stm]
                (* end case *))
            | pruneStms [stm] = if isExit stm then EXIT else CONT
            | pruneStms ((stm as S.S_IfThenElse(x, blk1, blk2))::stms) = (
                case pruneIf(x, blk1, blk2)
                 of EXIT => PRUNE[stm]
                  | PRUNE stm => PRUNE[stm]
                  | CONT => (case pruneStms stms
                       of PRUNE stms => PRUNE(stm::stms)
                        | EDIT stms => EDIT(stm::stms)
                        | EXIT => EXIT (* different instances of ctl_flow_info *)
                        | CONT => CONT
                      (* end case *))
                  | EDIT stm => (case pruneStms stms
                       of PRUNE stms => PRUNE(stm::stms)
                        | EDIT stms => EDIT(stm::stms)
                        | _ => EDIT(stm::stms)
                      (* end case *))
                (* end case *))
            | pruneStms (stm::stms) = if isExit stm
                then PRUNE[stm]
                else (case pruneStms stms
                   of PRUNE stms => PRUNE(stm::stms)
                    | EDIT stms => EDIT(stm::stms)
                    | info => info
                  (* end case *))
          and pruneIf (x, blk1, blk2) = (case (pruneBlk blk1, pruneBlk blk2)
                 of (EXIT,       EXIT      ) => EXIT
                  | (CONT,       CONT      ) => CONT
                  | (CONT,       EXIT      ) => CONT
                  | (EXIT,       CONT      ) => CONT
                  | (CONT,       EDIT blk2 ) => EDIT(S.S_IfThenElse(x, blk1, blk2))
                  | (EDIT blk1,  CONT      ) => EDIT(S.S_IfThenElse(x, blk1, blk2))
                  | (CONT,       PRUNE blk2) => EDIT(S.S_IfThenElse(x, blk1, blk2))
                  | (PRUNE blk1, CONT      ) => EDIT(S.S_IfThenElse(x, blk1, blk2))
                  | (EXIT,       EDIT blk2 ) => EDIT(S.S_IfThenElse(x, blk1, blk2))
                  | (EDIT blk1,  EXIT      ) => EDIT(S.S_IfThenElse(x, blk1, blk2))
                  | (EDIT blk1,  EDIT blk2 ) => EDIT(S.S_IfThenElse(x, blk1, blk2))
                  | (EDIT blk1,  PRUNE blk2) => EDIT(S.S_IfThenElse(x, blk1, blk2))
                  | (PRUNE blk1, EDIT blk2 ) => EDIT(S.S_IfThenElse(x, blk1, blk2))
                  | (EXIT,       PRUNE blk2) => PRUNE(S.S_IfThenElse(x, blk1, blk2))
                  | (PRUNE blk1, EXIT      ) => PRUNE(S.S_IfThenElse(x, blk1, blk2))
                  | (PRUNE blk1, PRUNE blk2) => PRUNE(S.S_IfThenElse(x, blk1, blk2))
                (* end case *))
          and pruneBlk (S.Block{props, code}) = (case pruneStms code
                 of PRUNE stms => PRUNE(S.Block{props=props, code=stms})
                  | EDIT stms => EDIT(S.Block{props=props, code=stms})
                  | EXIT => EXIT (* different instances of ctl_flow_info *)
                  | CONT => CONT
                (* end case *))
          in
            case pruneBlk blk
             of PRUNE blk => blk
              | EDIT blk => blk
              | _=> blk
            (* end case *)
          end

  (* simplify a statement into a single statement (i.e., a block if it expands
   * into more than one new statement).
   *)
    fun simplifyBlock errStrm stm = mkBlock (simplifyStmt (errStrm, stm, []))

  (* simplify the statement stm where stms is a reverse-order list of preceeding simplified
   * statements.  This function returns a reverse-order list of simplified statements.
   * Note that error reporting is done in the typechecker, but it does not prune unreachable
   * code.
   *)
    and simplifyStmt (errStrm, stm, stms) : S.stmt list = (case stm
           of AST.S_Block body => let
                fun simplify ([], stms) = stms
                  | simplify (stm::r, stms) = simplify (r, simplifyStmt (errStrm, stm, stms))
                in
                  simplify (body, stms)
                end
            | AST.S_Decl(x, NONE) => let
                val x' = cvtVar x
                in
                  S.S_Var(x', NONE) :: stms
                end
            | AST.S_Decl(x, SOME e) => let
                val (stms, e') = simplifyExp (errStrm, e, stms)
                val x' = cvtVar x
                in
                  S.S_Var(x', SOME e') :: stms
                end
            | AST.S_IfThenElse(e, s1, s2) => let
                val (stms, x) = simplifyExpToVar (errStrm, e, stms)
                val s1 = simplifyBlock errStrm s1
                val s2 = simplifyBlock errStrm s2
                in
                  S.S_IfThenElse(x, s1, s2) :: stms
                end
	    | AST.S_Foreach((x, e), body) => let
		val (stms, xs') = simplifyExpToVar (errStrm, e, stms)
		val body' = simplifyBlock errStrm body
		in
		  S.S_Foreach(cvtVar x, xs', body') :: stms
		end
            | AST.S_Assign((x, _), e) => let
                val (stms, e') = simplifyExp (errStrm, e, stms)
                in
                  S.S_Assign(cvtVar x, e') :: stms
                end
            | AST.S_New(name, args) => let
                val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
                in
                  S.S_New(name, xs) :: stms
                end
            | AST.S_Continue => S.S_Continue :: stms
            | AST.S_Die => S.S_Die :: stms
            | AST.S_Stabilize => S.S_Stabilize :: stms
            | AST.S_Return e => let
                val (stms, x) = simplifyExpToVar (errStrm, e, stms)
                in
                  S.S_Return x :: stms
                end
            | AST.S_Print args => let
                val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
                in
                  S.S_Print xs :: stms
                end
          (* end case *))

    and simplifyExp (errStrm, exp, stms) = let
	  fun doPrimApply (f, tyArgs, args, ty) = let
		val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
		in
		  case Var.kindOf f
		   of Var.BasisVar => let
			fun cvtTyArg (Types.TYPE tv) = S.TY(cvtTy(TU.resolve tv))
			  | cvtTyArg (Types.DIFF dv) = S.DIFF(TU.monoDiff(TU.resolveDiff dv))
			  | cvtTyArg (Types.SHAPE sv) = S.SHAPE(TU.monoShape(TU.resolveShape sv))
			  | cvtTyArg (Types.DIM dv) = S.DIM(TU.monoDim(TU.resolveDim dv))
			val tyArgs = List.map cvtTyArg tyArgs
			in
			  (stms, S.E_Prim(f, tyArgs, xs, cvtTy ty))
			end
		    | _ => raise Fail "bogus prim application"
		  (* end case *)
		end
	  in
	    case exp
	     of AST.E_Var(x, _) => (case Var.kindOf x
		   of Var.BasisVar => let
			val ty = cvtTy(Var.monoTypeOf x)
			val x' = newTemp ty
			val stm = S.S_Var(x', SOME(S.E_Prim(x, [], [], ty)))
			in
			  (stm::stms, S.E_Var x')
			end
		    | _ => (stms, S.E_Var(cvtVar x))
		  (* end case *))
	      | AST.E_Lit lit => (stms, S.E_Lit lit)
	      | AST.E_Kernel h => (stms, S.E_Kernel h)
	      | AST.E_Select(e, (fld, _)) => let
		  val (stms, x) = simplifyExpToVar (errStrm, e, stms)
		  in
		    (stms, S.E_Select(x, cvtVar fld))
		  end
	      | AST.E_Prim(rator, tyArgs, args as [e], ty) => (case e
		   of AST.E_Lit(Literal.Int n) => if Var.same(BasisVars.neg_i, rator)
			then (stms, S.E_Lit(Literal.Int(~n))) (* constant-fold negation of integer literals *)
			else doPrimApply (rator, tyArgs, args, ty)
		    | AST.E_Lit(Literal.Real f) =>
			if Var.same(BasisVars.neg_t, rator)
			  then (stms, S.E_Lit(Literal.Real(RealLit.negate f))) (* constant-fold negation of real literals *)
			  else doPrimApply (rator, tyArgs, args, ty)
		    | AST.E_Comprehension(e', (x, e''), seqTy) => if Basis.isReductionOp rator
			then let
			  val {rator, init, mvs} = Util.reductionInfo rator
			  val (stms, xs) = simplifyExpToVar (errStrm, e'', stms)
			  val (bodyStms, bodyResult) = simplifyExpToVar (errStrm, e, [])
			  val acc = SimpleVar.new ("accum", Var.LocalVar, cvtTy ty)
			  val seqTy' as STy.T_Sequence(elemTy, NONE) = cvtTy seqTy
			  val initStm = S.S_Var(acc, SOME(S.E_Lit init))
			  val updateStm = S.S_Assign(acc,
				S.E_Prim(rator, mvs, [acc, bodyResult], seqTy'))
			  val foreachStm = S.S_Foreach(cvtVar x, xs, mkBlock(updateStm :: bodyStms))
			  in
			    (foreachStm :: initStm :: stms, S.E_Var acc)
			  end
			else doPrimApply (rator, tyArgs, args, ty)
		    | AST.E_ParallelMap(e', x, xs, _) =>
			if Basis.isReductionOp rator
			  then let
			  (* parallel map-reduce *)
			    val result = SimpleVar.new ("res", Var.LocalVar, cvtTy ty)
			    val (bodyStms, bodyResult) = simplifyExpToVar (errStrm, e', [])
			    val (func, args) = Util.makeFunction(
				  Var.nameOf rator, mkBlock(S.S_Return bodyResult :: bodyStms),
				  SimpleVar.typeOf bodyResult)
			    val mapReduceStm = S.S_MapReduce{
				    results = [result],
				    reductions = [rator],
				    body = func,
				    args = args,
				    source = xs
				  }
			    in
			      (mapReduceStm :: stms, S.E_Var result)
			    end
			  else raise Fail "unsupported operation on parallel map"
		    | _ => doPrimApply (rator, tyArgs, args, ty)
		  (* end case *))
	      | AST.E_Prim(f, tyArgs, args, ty) => doPrimApply (f, tyArgs, args, ty)
	      | AST.E_Apply((f, _), args, ty) => let
		  val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
		  in
		    case Var.kindOf f
		     of Var.FunVar => (stms, S.E_Apply(cvtVar f, xs, cvtTy ty))
		      | _ => raise Fail "bogus application"
		    (* end case *)
		  end
	      | AST.E_Comprehension(e, (x, e'), seqTy) => let
		(* convert a comprehension to a foreach loop over the sequence defined by e' *)
		  val (stms, xs) = simplifyExpToVar (errStrm, e', stms)
		  val (bodyStms, bodyResult) = simplifyExpToVar (errStrm, e, [])
		  val seqTy' as STy.T_Sequence(elemTy, NONE) = cvtTy seqTy
		  val acc = SimpleVar.new ("accum", Var.LocalVar, seqTy')
		  val initStm = S.S_Var(acc, SOME(S.E_Seq([], seqTy')))
		  val updateStm = S.S_Assign(acc,
			S.E_Prim(BasisVars.at_dT, [S.TY elemTy], [acc, bodyResult], seqTy'))
		  val foreachStm = S.S_Foreach(cvtVar x, xs, mkBlock(updateStm :: bodyStms))
		  in
		    (foreachStm :: initStm :: stms, S.E_Var acc)
		  end
	      | AST.E_ParallelMap(e, x, xs, ty) => raise Fail "FIXME: ParallelMap"
	      | AST.E_Tensor(es, ty) => let
		  val (stms, xs) = simplifyExpsToVars (errStrm, es, stms)
		  in
		    (stms, S.E_Tensor(xs, cvtTy ty))
		  end
	      | AST.E_Seq(es, ty) => let
		  val (stms, xs) = simplifyExpsToVars (errStrm, es, stms)
		  in
		    (stms, S.E_Seq(xs, cvtTy ty))
		  end
	      | AST.E_Slice(e, indices, ty) => let (* tensor slicing *)
		  val (stms, x) = simplifyExpToVar (errStrm, e, stms)
		  fun f NONE = NONE
		    | f (SOME(AST.E_Lit(Literal.Int i))) = SOME(Int.fromLarge i)
		    | f _ = raise Fail "expected integer literal in slice"
		  val indices = List.map f indices
		  in
		    (stms, S.E_Slice(x, indices, cvtTy ty))
		  end
	      | AST.E_Cond(e1, e2, e3, ty) => let
		(* a conditional expression gets turned into an if-then-else statememt *)
		  val result = newTemp(cvtTy ty)
		  val (stms, x) = simplifyExpToVar (errStrm, e1, S.S_Var(result, NONE) :: stms)
		  fun simplifyBranch e = let
			val (stms, e) = simplifyExp (errStrm, e, [])
			in
			  mkBlock (S.S_Assign(result, e)::stms)
			end
		  val s1 = simplifyBranch e2
		  val s2 = simplifyBranch e3
		  in
		    (S.S_IfThenElse(x, s1, s2) :: stms, S.E_Var result)
		  end
	      | AST.E_LoadNrrd(_, nrrd, ty) => (case cvtTy ty
		   of ty as SimpleTypes.T_Sequence(_, NONE) => (stms, S.E_LoadSeq(ty, nrrd))
		    | ty as SimpleTypes.T_Image{dim, shape} => (
			case ImageInfo.fromNrrd(NrrdInfo.getInfo(errStrm, nrrd), dim, shape)
			 of NONE => raise Fail(concat[
				"nrrd file \"", nrrd, "\" does not have expected type"
			      ])
			  | SOME info => (stms, S.E_LoadImage(ty, nrrd, info))
			(* end case *))
		    | _ => raise Fail "bogus type for E_LoadNrrd"
		  (* end case *))
	      | AST.E_Coerce{dstTy, e=AST.E_Lit(Literal.Int n), ...} => (case cvtTy dstTy
		   of SimpleTypes.T_Tensor[] => (stms, S.E_Lit(Literal.Real(RealLit.fromInt n)))
		    | _ => raise Fail "impossible: bad coercion"
		  (* end case *))
	      | AST.E_Coerce{srcTy, dstTy, e} => let
		  val (stms, x) = simplifyExpToVar (errStrm, e, stms)
		  val dstTy = cvtTy dstTy
		  val result = newTemp dstTy
		  val rhs = S.E_Coerce{srcTy = cvtTy srcTy, dstTy = dstTy, x = x}
		  in
		    (S.S_Var(result, SOME rhs)::stms, S.E_Var result)
		  end
	    (* end case *)
	  end

    and simplifyExpToVar (errStrm, exp, stms) = let
          val (stms, e) = simplifyExp (errStrm, exp, stms)
          in
            case e
             of S.E_Var x => (stms, x)
              | _ => let
                  val x = newTemp (S.typeOf e)
                  in
                    (S.S_Var(x, SOME e)::stms, x)
                  end
            (* end case *)
          end

    and simplifyExpsToVars (errStrm, exps, stms) = let
          fun f ([], xs, stms) = (stms, List.rev xs)
            | f (e::es, xs, stms) = let
                val (stms, x) = simplifyExpToVar (errStrm, e, stms)
                in
                  f (es, x::xs, stms)
                end
          in
            f (exps, [], stms)
          end

    fun simplifyStrand (errStrm, strand) = let
	  val AST.Strand{name, params, state, stateInit, initM, updateM, stabilizeM} = strand
          val params' = cvtVars params
          fun simplifyState ([], xs, stms) = (List.rev xs, mkBlock stms)
            | simplifyState ((x, optE) :: r, xs, stms) = let
                val x' = cvtVar x
		in
		  case optE
		   of NONE => simplifyState (r, x'::xs, stms)
		    | SOME e => let
			val (stms, e') = simplifyExp (errStrm, e, stms)
			in
			  simplifyState (r, x'::xs, S.S_Assign(x', e') :: stms)
			end
		  (* end case *)
		end
          val (xs, stm) = simplifyState (state, [], [])
          in
            S.Strand{
                name = name,
                params = params',
                state = xs,
		stateInit = stm,
		initM = Option.map (simplifyBlock errStrm) initM,
		updateM = simplifyBlock errStrm updateM,
		stabilizeM = Option.map (simplifyBlock errStrm) stabilizeM
              }
          end

    fun simplifyCreate (errStrm, AST.C_Grid(d, blk)) =
	  S.Create{dim = SOME d, code = simplifyBlock errStrm blk}
      | simplifyCreate (errStrm, AST.C_Collection blk) =
	  S.Create{dim = NONE, code = simplifyBlock errStrm blk}

    fun transform (errStrm, prog) = let
	  val AST.Program{
		  props, const_dcls, input_dcls, globals, globInit, strand, create, init, update
		} = prog
	  val consts' = ref[]
	  val constInit = ref[]
	  val inputs' = ref[]
	  val globals' = ref[]
	  val globalInit = ref[]
	  val funcs = ref[]
	  fun simplifyConstDcl (x, SOME e) = let
		val (stms, e') = simplifyExp (errStrm, e, [])
		val x' = cvtVar x
		in
		  consts' := x' :: !consts';
		  constInit := S.S_Assign(x', e') :: (stms @ !constInit)
		end
	  fun simplifyInputDcl ((x, NONE), desc) = let
		val x' = cvtVar x
		val init = (case SimpleVar.typeOf x'
		       of STy.T_Image{dim, shape} => let
			    val info = ImageInfo.mkInfo(dim, shape)
			    in
			      S.Image info
			    end
			| _ => S.NoDefault
		      (* end case *))
		val inp = S.INP{
			var = x',
			name = Var.nameOf x,
			ty =  apiTypeOf x',
			desc = desc,
			init = init
		      }
		in
		  inputs' := inp :: !inputs'
		end
	    | simplifyInputDcl ((x, SOME(AST.E_LoadNrrd(tvs, nrrd, ty))), desc) = let
		val x' = cvtVar x
	      (* load the nrrd proxy here *)
		val info = NrrdInfo.getInfo (errStrm, nrrd)
		val init = (case SimpleVar.typeOf x'
		       of SimpleTypes.T_Sequence(_, NONE) => S.LoadSeq nrrd
			| SimpleTypes.T_Image{dim, shape} => inputImage(errStrm, nrrd, dim, shape)
			| _ => raise Fail "impossible"
		      (* end case *))
		val inp = S.INP{
			var = x',
			name = Var.nameOf x,
			ty = apiTypeOf x',
			desc = desc,
			init = init
		      }
		in
		  inputs' := inp :: !inputs'
		end
	    | simplifyInputDcl ((x, SOME e), desc) = let
		val x' = cvtVar x
		val (stms, e') = simplifyExp (errStrm, e, [])
		val inp = S.INP{
			var = x',
			name = Var.nameOf x,
			ty = apiTypeOf x',
			desc = desc,
			init = S.ConstExpr
		      }
		in
		  inputs' := inp :: !inputs';
		  constInit := S.S_Assign(x', e') :: (stms @ !constInit)
		end
	  fun simplifyGlobalDcl (AST.D_Var(x, optE)) = let
		val x' = cvtVar x
		in
		  case optE
		    of NONE => globals' := x' :: !globals'
		     | SOME e => let
			 val (stms, e') = simplifyExp (errStrm, e, [])
			 in
			   globals' := x' :: !globals';
			   globalInit := S.S_Assign(x', e') :: (stms @ !globalInit)
			 end
		  (* end case *)
		end
	    | simplifyGlobalDcl (AST.D_Func(f, params, body)) = let
		val f' = cvtVar f
		val params' = cvtVars params
		val body' = pruneUnreachableCode (simplifyBlock errStrm body)
		in
		  funcs := S.Func{f=f', params=params', body=body'} :: !funcs
		end
	  val () = (
		List.app simplifyConstDcl const_dcls;
		List.app simplifyInputDcl input_dcls;
		List.app simplifyGlobalDcl globals)
	(* make the global-initialization block *)
	  val globInit = (case globInit
		 of SOME stm => mkBlock (simplifyStmt (errStrm, stm, !globalInit))
		  | NONE => mkBlock (!globalInit)
		(* end case *))
          in
            S.Program{
                props = props,
		consts = List.rev(!consts'),
                inputs = List.rev(!inputs'),
		constInit = mkBlock (!constInit),
                globals = List.rev(!globals'),
                globInit = globInit,
                funcs = List.rev(!funcs),
                strand = simplifyStrand (errStrm, strand),
                create = simplifyCreate (errStrm, create),
		init = Option.map (simplifyBlock errStrm) init,
		update = Option.map (simplifyBlock errStrm) update
              }
          end

  end

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