Fix #27. Also add MonadPlus

mylib/postlude/foldable.my

@@ -1,2 +1,5 @@
 def len(someFoldable):
-  return someFoldable.foldl(0, (acc, _): acc + 1)
+  return someFoldable.foldl(0, (acc, _): acc + 1)
+
+def all(foldable, predicate):
+  return foldable.foldl(True, (acc, it): acc and predicate(it))

mylib/postlude/maybe.my

@@ -40,6 +40,13 @@ instance Maybe of Monad:
   def bind(None, _):
     return None
 
+instance Maybe of MonadPlus:
+  def mplus(x, y):
+    return alt(x, y)
+
+  def mzero():
+    return None
+
 instance Maybe of Equal:
   def equals(None, None):
     return True

mylib/postlude/maybet.my

@@ -16,6 +16,18 @@ instance MaybeT of Monad:
         None:    wrap(None)
         Just(y): runMaybeT(f(y)))
 
+instance MaybeT of MonadPlus:
+  def mplus(x, y):
+    return MaybeT(unwrap:
+      v <- runMaybeT(x)
+      case v:
+        None: runMaybeT(y)
+        _:    wrap(v)
+    )
+
+  def mzero():
+    return MaybeT(wrap(None))
+
 instance MaybeT of Applicative:
   def wrap(x):
     return MaybeT(wrap(Just(x)))
@@ -32,4 +44,9 @@ instance MaybeT of Applicative:
 
 instance MaybeT of MonadTransformer:
   def lift(x):
-    return MaybeT(liftM(Just, x))
+    return MaybeT(liftM(Just, x))
+
+
+# Turns a Maybe into a MaybeT
+def hoistMaybe(m):
+  return MaybeT(wrap(m))

mylib/postlude/monadplus.my

@@ -0,0 +1,8 @@
+def mfilter(mp, predicate):
+  return unwrap:
+    a <- mp
+
+    if predicate(a):
+      wrap(a)
+    else:
+      mzero()

mylib/prelude/types.my

@@ -12,6 +12,10 @@ type Applicative:
 type Monad:
   def bind(self, function) -> self
 
+type MonadPlus:
+  def mzero() -> self
+  def mplus(self, self) -> self
+
 type Equal:
   def equals(self, self)
 

plugins/monty-mode.el

@@ -24,7 +24,7 @@
 (define-generic-mode 'monty-mode
   '("#")
   '("def" "type" "class" "if" "elif" "else" "return" "instance" "of"
-    "unwrap" "wrap" "pass")
+    "unwrap" "wrap" "pass" "case")
   '(("\\bdebug\\b" . 'font-lock-builtin-face)
     ("\\b[A-Z][a-zA-Z0-9_]*\\b" . 'font-lock-type-face)
     ("\\b[0-9]+\\b" . font-lock-constant-face)

samples/maybet.my

@@ -0,0 +1,14 @@
+# Sample of using MaybeT and MonadPlus
+
+def readInt():
+  def isNumber(s):
+    return len(s) > 0 and s.all(isDigit)
+
+  return lift(input())
+    .bind(hoistMaybe)
+    .mfilter(isNumber)
+
+__main__ = unwrap:
+  print("Enter a digit:")
+  value <- runMaybeT(mplus(readInt(), mzero()))
+  print(value.str())

src/Parser/Semantic.hs

@@ -28,23 +28,24 @@ instance Show ParseErr where
 
 type ParseExcept = Except ParseErr
 
-infixPrecedence :: [InfixOp]
-infixPrecedence = [
+-- These are listed in inverse precedence order
+infixSplitOrder :: [InfixOp]
+infixSplitOrder = [
     InfixMappend,
-    InfixAdd,
-    InfixSub,
-    InfixMul,
-    InfixDiv,
-    InfixMod,
-    InfixNe,
+    InfixLogicOr,
+    InfixLogicAnd,
+    InfixLt,
+    InfixGt,
+    InfixGe,
+    InfixLe,
     InfixEq,
     InfixEq,
-    InfixLe,
-    InfixGe,
-    InfixGt,
-    InfixLt,
-    InfixLogicAnd,
-    InfixLogicOr
+    InfixNe,
+    InfixSub,
+    InfixAdd,
+    InfixMod,
+    InfixDiv,
+    InfixMul
   ]
 
 -- What a mess
@@ -68,7 +69,7 @@ groupByPrecedence (o:os) xs = joinHeadOp subCases
 
 semanticInfixChain :: ET -> [(InfixOp, ET)] -> ET
 semanticInfixChain first rest =
-    groupByPrecedence infixPrecedence ((Nothing, first):maybeRest)
+    groupByPrecedence infixSplitOrder ((Nothing, first):maybeRest)
   where
     maybeTup :: (InfixOp, ET) -> (Maybe InfixOp, ET)
     maybeTup (op, expr) = (Just op, expr) 

src/RunnerTypes.hs

@@ -52,7 +52,7 @@ data FunctionImpl = FunctionImpl
 
 instance PrettyPrint FunctionImpl where
   prettyPrint (FunctionImpl name cases typeSig) =
-    "sig(" <> show name <> ": " <>
+    "sig[" <> show name <> "](" <>
     intercalate ", " (prettyPrint <$> typeSig) <> "):\n" <>
     (intercalate "\n" $ (\x -> "  " <> prettyPrint x) <$> cases)
 
@@ -163,4 +163,7 @@ instance PrettyPrint Value where
   prettyPrint (VInferred fname tname vals) =
     "(inferreed)" <> fname <> " " <> tname <> " " <> (show $ prettyPrint <$> vals)
 
+  prettyPrint value =
+    "<" <> show value <> ">"
+
 $(makeLenses ''Runtime)