| Line 1... |
Line 1... |
(* $Id: actiontrans.sml 34 2008-03-31 10:48:56Z tbourke $ *)
|
(* $Id: actiontrans.sml 35 2008-04-01 02:55:38Z tbourke $ *)
|
|
|
structure ActionTrans :> ACTION_TRANS = let
|
structure ActionTrans :> ACTION_TRANS = let
|
structure E = Expression
|
structure E = Expression
|
and ECVT = ExpressionCvt
|
and ECVT = ExpressionCvt
|
and Env = Environment
|
and Env = Environment
|
| Line 26... |
Line 26... |
names: symbolset}
|
names: symbolset}
|
|
|
(* utility functions for processing names *)
|
(* utility functions for processing names *)
|
fun toBoundId (s, ty) = E.BoundId (s, ty, E.nopos)
|
fun toBoundId (s, ty) = E.BoundId (s, ty, E.nopos)
|
|
|
val addBoundIds = let
|
|
fun add (E.BoundId (n, _, _), s) = s <+ n
|
|
in foldl add emptyset end
|
|
|
|
fun fromBoundId (E.BoundId (n, ty, _)) = (n, ty)
|
fun fromBoundId (E.BoundId (n, ty, _)) = (n, ty)
|
|
|
fun addNameTypes xs = let
|
fun addNameTypes xs = let
|
fun add ((n, _), s) = s <+ n
|
fun add ((n, _), s) = s <+ n
|
in foldl add emptyset xs end
|
in foldl add emptyset xs end
|
| Line 159... |
Line 155... |
|
|
fun addPartialConstraint (NONE, g) = g
|
fun addPartialConstraint (NONE, g) = g
|
| addPartialConstraint (SOME c, g) = E.BinBoolExpr {pos=E.nopos,
|
| addPartialConstraint (SOME c, g) = E.BinBoolExpr {pos=E.nopos,
|
left=c, bop=E.AndOp, right=g}
|
left=c, bop=E.AndOp, right=g}
|
|
|
val usednames =addBoundIds selectids ++ E.getFreeNames guard
|
val usednames =E.getBoundNames selectids ++ E.getFreeNames guard
|
++ foldl (fn (e, s)=>E.getFreeNames e ++ s)
|
++ foldl (fn (e, s)=>E.getFreeNames e ++ s)
|
emptyset actionsubs
|
emptyset actionsubs
|
val (gCons, asubs, newbindings) = listTripleUnzip
|
val (gCons, asubs, newbindings) = listTripleUnzip
|
(checksubs (subtypes, actionsubs, [], usednames))
|
(checksubs (subtypes, actionsubs, [], usednames))
|
(*}}}1*)
|
(*}}}1*)
|
(*}}}1*)
|
(*}}}1*)
|