Merge pull request #90 from kaeluka/new-ponyrt

Breathe keyword

src/back/CodeGen/Expr.hs

@@ -86,6 +86,10 @@ newtype VarLkp = VarLkp String
 instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
   -- | Translate an expression into the corresponding C code
   translate skip@(A.Skip {}) = named_tmp_var "skip" (A.getType skip) (AsExpr unit)
+  translate breathe@(A.Breathe {}) =
+    named_tmp_var "breathe"
+                  (A.getType breathe)
+                  (Call (Nam "call_respond_with_current_scheduler") ([] :: [CCode Expr]))
   translate null@(A.Null {}) = named_tmp_var "literal" (A.getType null) Null
   translate true@(A.BTrue {}) = named_tmp_var "literal"  (A.getType true) (Embed "1/*True*/"::CCode Expr)
   translate false@(A.BFalse {}) = named_tmp_var "literal" (A.getType false) (Embed "0/*False*/"::CCode Expr)

src/ir/AST/AST.hs

@@ -119,6 +119,7 @@ instance HasMeta MethodDecl where
 type Arguments = [Expr]
 
 data Expr = Skip {emeta :: Meta Expr}
+          | Breathe {emeta :: Meta Expr}
           | TypedExpr {emeta :: Meta Expr,
                        body :: Expr,
                        ty   :: Type}

src/ir/AST/PrettyPrinter.hs

@@ -21,6 +21,7 @@ import AST.AST
 
 ppClass = text "class"
 ppSkip = text "()"
+ppBreathe = text "breathe"
 ppLet = text "let"
 ppIn = text "in"
 ppIf = text "if"
@@ -128,15 +129,16 @@ ppSugared e = case getSugared e of
 
 ppExpr :: Expr -> Doc
 ppExpr Skip {} = ppSkip
-ppExpr MethodCall {target, name, args} = 
-    maybeParens target <> ppDot <> ppName name <> 
+ppExpr Breathe {} = ppBreathe
+ppExpr MethodCall {target, name, args} =
+    maybeParens target <> ppDot <> ppName name <>
       parens (commaSep (map ppExpr args))
-ppExpr MessageSend {target, name, args} = 
-    maybeParens target <> ppBang <> ppName name <> 
+ppExpr MessageSend {target, name, args} =
+    maybeParens target <> ppBang <> ppName name <>
       parens (commaSep (map ppExpr args))
-ppExpr FunctionCall {name, args} = 
+ppExpr FunctionCall {name, args} =
     ppName name <> parens (commaSep (map ppExpr args))
-ppExpr Closure {eparams, body} = 
+ppExpr Closure {eparams, body} =
     ppLambda <> parens (commaSep (map ppParamDecl eparams)) <+> ppArrow <+> ppExpr body
 ppExpr Let {decls, body} = 
     ppLet <+> vcat (map (\(Name x, e) -> text x <+> equals <+> ppExpr e) decls) $+$ ppIn $+$ 

src/parser/Parser/Parser.hs

@@ -33,13 +33,13 @@ identifier_parser = identifier
 
 -- | This creates a tokenizer that reads a language derived from
 -- the empty language definition 'emptyDef' extended as shown.
-lexer = 
-    P.makeTokenParser $ 
+lexer =
+    P.makeTokenParser $
     emptyDef { P.commentStart = "{-",
                P.commentEnd = "-}",
                P.commentLine = "--",
                P.identStart = letter,
-               P.reservedNames = ["passive", "class", "def", "stream", 
+               P.reservedNames = ["passive", "class", "def", "stream", "breathe",
                                   "let", "in", "if", "unless", "then", "else", "repeat", "while", 
                                   "get", "yield", "eos", "getNext", "new", "this", "await", "suspend",
 				  "and", "or", "not", "true", "false", "null", "embed", "body", "end", 
@@ -271,6 +271,7 @@ expression = buildExpressionParser opTable expr
 
 expr :: Parser Expr
 expr  =  unit
+     <|> breathe
      <|> try embed
      <|> try path
      <|> try functionCall
@@ -312,8 +313,11 @@ expr  =  unit
                  code <- manyTill anyChar $ try $ do {space; reserved "end"}
                  return $ Embed (meta pos) ty code
       unit = do pos <- getPosition
-                reservedOp "()" 
+                reservedOp "()"
                 return $ Skip (meta pos)
+      breathe = do pos <- getPosition
+                   reserved "breathe"
+                   return $ Breathe (meta pos)
       path = do pos <- getPosition
                 root <- parens expression <|> try functionCall <|> varAccess
                 dot

src/runtime/encore/encore.c

@@ -4,6 +4,7 @@
 #include <stdbool.h>
 #include <stdlib.h>
 #include <assert.h>
+#include "../sched/scheduler.c" // ugh! Need this to call respond
 
 extern void pool_free(size_t index, void* p);
 bool has_flag(pony_actor_t* actor, uint8_t flag);
@@ -212,3 +213,8 @@ bool encore_actor_handle_message_hook(encore_actor_t *actor, pony_msg_t* msg)
   }
   return false;
 }
+
+void call_respond_with_current_scheduler()
+{
+  respond(this_scheduler);
+}

src/runtime/encore/encore.h

@@ -87,4 +87,8 @@ bool encore_actor_run_hook(encore_actor_t *actor);
 bool encore_actor_handle_message_hook(encore_actor_t *actor, pony_msg_t* msg);
 void actor_block(encore_actor_t *actor);
 void actor_set_resume(encore_actor_t *actor);
+
+/// calls the pony's respond with the current object's scheduler
+void call_respond_with_current_scheduler();
+
 #endif /* end of include guard: ENCORE_H_6Q243YHL */

src/tests/encore/basic/breathe.enc

@@ -0,0 +1,10 @@
+class Foo
+  def foo() : void {
+    print "out of air!";
+    breathe;
+    print "that's better"
+  }
+
+class Main
+  def main() : void
+    (new Foo).foo()

src/tests/encore/basic/breathe.out

@@ -0,0 +1,2 @@
+out of air!
+that's better

src/types/Typechecker/Typechecker.hs

@@ -234,17 +234,22 @@ instance Checkable Expr where
                              do assertSubtypeOf exprType ty
                                 return eExpr
         where
-          coerceNull null ty 
-              | isNullType ty || 
+          coerceNull null ty
+              | isNullType ty ||
                 isTypeVar ty = tcError "Cannot infer type of null valued expression"
               | isRefType ty = return $ setType ty null
               | otherwise = tcError $ "Null valued expression cannot have type '" ++ show ty ++ "' (must have reference type)"
 
-    -- 
+    --
     -- ----------------
     --  E |- () : void
     typecheck skip@(Skip {}) = return $ setType voidType skip
 
+    --
+    -- ----------------
+    --  E |- breathe : void
+    typecheck breathe@(Breathe {}) = return $ setType voidType breathe
+
    ---  |- t
     --  E |- body : t
     -- ----------------------