Permalink
Browse files

Add experimental `sync' prim-op. See examples/sync.hs.

  • Loading branch information...
1 parent 85e5a43 commit 5367354fbd363a5231019c2b07f479dcebfdab5a @chrisdone chrisdone committed Oct 31, 2012
Showing with 55 additions and 11 deletions.
  1. +26 −0 examples/sync.hs
  2. +23 −11 js/runtime.js
  3. +5 −0 src/Language/Fay/Prelude.hs
  4. +1 −0 src/Language/Fay/Types.hs
View
@@ -0,0 +1,26 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Console where
+
+import Language.Fay.FFI
+import Language.Fay.Prelude
+
+main = do
+ print "What's"
+ msg <- sync $ timeoutPass "It's peanut butter jelly time!"
+ print $ "the message? " ++ msg
+
+ print "Hello"
+ sync $ setTimeout 500
+ print "friends!"
+
+setTimeout :: Double -> (() -> Fay ()) -> Fay ()
+setTimeout = ffi "setTimeout(%2,%1)"
+
+-- | Time out and finally pass a value back to the function.
+timeoutPass :: String -> (String -> Fay ()) -> Fay ()
+timeoutPass = ffi "setTimeout(function(){ %2(%1); },500)"
+
+-- | Print using console.log.
+print :: String -> Fay ()
+print = ffi "console.log(%1)"
View
@@ -45,33 +45,45 @@ function Fay$$Monad(value){
this.value = value;
}
-// >>
// This is used directly from Fay, but can be rebound or shadowed. See primOps in Types.hs.
+// >>
function Fay$$then(a){
return function(b){
- return new $(function(){
- _(a,true);
- return b;
- });
+ return Fay$$bind(a)(function(_){
+ return b;
+ });
};
}
// >>=
// This is used directly from Fay, but can be rebound or shadowed. See primOps in Types.hs.
function Fay$$bind(m){
- return function(f){
- return new $(function(){
- var monad = _(m,true);
- return f(monad.value);
- });
- };
+ return function(f){
+ return new $(function(){
+ var monad = _(m,true);
+ if(monad.cont) {
+ return _(monad.cont(f));
+ }
+ else {
+ return f(monad.value);
+ }
+ });
+ };
}
// This is used directly from Fay, but can be rebound or shadowed.
function Fay$$$_return(a){
return new Fay$$Monad(a);
}
+// This is used directly from Fay, but can be rebound or shadowed. See primOps in Types.hs.
+function Fay$$sync($p1){
+ return new $(function(){
+ return { cont: $p1 };
+ });
+};
+
+// Unit: ().
var Fay$$unit = null;
/*******************************************************************************
@@ -30,10 +30,12 @@ module Language.Fay.Prelude
,(&&)
,fail
,return
+ ,sync
,module Language.Fay.Stdlib)
where
import Language.Fay.Stdlib
+import Language.Fay.FFI (Foreign)
import Language.Fay.Types (Fay)
import Data.Data
import Prelude (Bool(..), Char, Double, Eq(..), Int, Integer, Maybe(..), Monad,
@@ -53,3 +55,6 @@ fail = error "Language.Fay.Prelude.fail: Used fail outside JS."
return :: a -> Fay a
return = error "Language.Fay.Prelude.return: Used return outside JS."
+
+sync :: (Foreign a) => ((a -> Fay ()) -> Fay ()) -> Fay a
+sync = error "Language.Fay.Prelude.sync: Used sync outside JS."
@@ -113,6 +113,7 @@ primOps =
[(Symbol ">>",[ScopeImported "Fay$" (Just "then")])
,(Symbol ">>=",[ScopeImported "Fay$" (Just "bind")])
,(Ident "return",[ScopeImported "Fay$" (Just "return")])
+ ,(Ident "sync",[ScopeImported "Fay$" (Just "sync")])
,(Symbol "*",[ScopeImported "Fay$" (Just "mult")])
,(Symbol "*",[ScopeImported "Fay$" (Just "mult")])
,(Symbol "+",[ScopeImported "Fay$" (Just "add")])

5 comments on commit 5367354

@cdsmith

Sadly, this violates the monad laws. For example:

main = do
  log "Hello"
  sync $ const (return ()) :: Fay ()
  log "Wonderful"
  log "World"

prints "Hello" and terminates, but

main = do
  log "Hello"
  do sync $ const (return ()) :: Fay ()
     log "Wonderful"
  log "World"

prints "Hello\nWorld", skipping only the "Wonderful"

@chrisdone
Member

Does the same happen if you just use >>?

@chrisdone
Member

Hmm, regardless, associativity is broken so there's a bug, yeah.

@cdsmith

Yes. This prints just "B":

bork :: Fay ()
bork = sync $ const (return ())

test1 :: Fay ()
test1 = bork >> (return () >> log "A")

test2 :: Fay ()
test2 = (bork >> return ()) >> log "B"

main :: Fay ()
main = test1 >> test2

thus demonstrating that associativity fails in a very straight-forward way. As a side comment, you can get a runtime crash by changing bork to:

bork :: Fay ()
bork = sync $ const $ return ()

TypeError: Property 'cont' of object #<Object> is not a function\

which should be the same thing. But that's likely an unrelated issue.

@chrisdone
Member

Yup. I'll fiddle with it tomorrow, just implemented it on a whim from a reddit comment. Cheers for fiddling.

Please sign in to comment.