Skip to content
Browse files

make Monad optimized by default

  • Loading branch information...
1 parent 21ad130 commit 0750ce4208c4474f4fc0b63c1276f307af7b6129 @sledorze committed Jan 2, 2012
Showing with 44 additions and 13 deletions.
  1. +44 −13 src/com/mindrocks/macros/MonadSugarMacro.hx
View
57 src/com/mindrocks/macros/MonadSugarMacro.hx
@@ -24,10 +24,49 @@ enum MonadOp {
}
class Monad {
+
+ public static function noOpt(m : MonadOp, position : Position) : MonadOp
+ return m
+ #if macro
+ public static function genOptimize(m : MonadOp, position : Position) : MonadOp {
+ function mk(e : ExprDef) return { pos : position, expr : e };
+ switch(m) {
+ case MFlatMap(e, bindName, body):
+ var body = genOptimize(body, position);
+ var e = genOptimize(e, position);
+
+ switch (e) {
+ case MCall(name, params):
+ switch (name) {
+ case "ret": return /*optimize(*/MFuncApp(bindName, body, MExp(params[0]))/*, position)*/;
+ default :
+ }
+ default:
+ switch (body) {
+ case MCall(name, params):
+ switch (name) {
+ case "ret": return /*optimize(*/MMap(e, bindName, MExp(params[0]))/*, position)*/;
+ default :
+ }
+ default:
+ }
+ }
+
+ return MFlatMap(e, bindName, body);
+
+ default:
+ return m;
+ }
+ }
+ #end
- public static function Do(monadTypeName : String, body : Expr, context : Dynamic, optimize : MonadOp -> Position -> MonadOp) {
+ public static function Do(monadTypeName : String, body : Expr, context : Dynamic, optimize : MonadOp -> Position -> MonadOp = null) {
+ #if macro
//var monadProxyName = monadTypeName + "__mnd";
//var monadRef = EConst(CIdent(monadProxyName));
+ if (optimize == null)
+ optimize = genOptimize;
+
var monadRef = EConst(CType(monadTypeName));
var position : Position = context.currentPos();
function mk(e : ExprDef) return { pos : position, expr : e };
@@ -57,10 +96,8 @@ class Monad {
function flatMapThis(e : MonadOp, name : String) {
switch (nextOpt) {
- case Some(next):
- return MFlatMap(e, name, next);
- case None :
- return e;
+ case Some(next): return MFlatMap(e, name, next);
+ case None : return e;
}
}
@@ -82,14 +119,7 @@ class Monad {
}
default:
}
- var res = {
- var e = tryPromoteExpression(e);
- switch (e) {
- case MExp(_): e;
- default: flatMapThis(e, "_");
- };
- }
- return Some(res);
+ return Some(flatMapThis(tryPromoteExpression(e), "_"));
}
function toExpr(m : MonadOp) : Expr {
@@ -134,5 +164,6 @@ class Monad {
default :
};
return body;
+ #end
}
}

0 comments on commit 0750ce4

Please sign in to comment.
Something went wrong with that request. Please try again.