Permalink
Browse files

Testing callback in progress

  • Loading branch information...
1 parent 61be0c8 commit e42334c22f113eeefd1bf811a296de0f569a02d4 @norm2782 norm2782 committed Nov 8, 2011
View
@@ -7,20 +7,10 @@ endif
default: $(PROJECT).js
-%.js: %.hs
- $(UHC) $< $(FLAGS)
+$(PROJECT).js: $(PROJECT).hs
+ $(UHC) $(PROJECT).hs $(FLAGS)
clean:
- rm $(PROJECT).core* $(PROJECT).full.core $(PROJECT).hi $(PROJECT).js $(PROJECT).html $(PROJECT).mjs
+ rm *.core* *.full.core *.hi $(PROJECT).js $(PROJECT).html *.mjs
-strip:
- find . -iname "*.core*" | xargs gsed -i 's/$$UHC$$\.Base$$\.//g';
- find . -iname "*.core*" | xargs gsed -i 's/UHC\.Base\.//g';
- find . -iname "*.core*" | xargs gsed -i 's/$$UHC$$\.Run$$\.//g';
- find . -iname "*.core*" | xargs gsed -i 's/$$UHC$$\.OldIO$$\.//g';
- perl -pi -w -e 's/(_\d+)*_\$@\d[A-Z]+_\$@(\d+(_\d+)*)//g;' *.core*
-
-.PHONY : clean strip tst
-
-tst:
- echo $(patsubst %.hs, %, $(PROJECTh
+.PHONY : clean strip
@@ -2,22 +2,21 @@ import Language.UHC.JScript.ECMA.String
import Language.UHC.JScript.Assorted
import Language.UHC.JScript.Primitives
import Language.UHC.JScript.JQuery.JQuery
-import UHC.Ptr
foreign import jscript "some_function(%*)"
- someFun :: Int -> Int -> FunPtr (Int -> IO ()) -> IO ()
+ someFun :: Int -> Int -> JSFunPtr (Int -> IO ()) -> IO ()
foreign import jscript "wrapper"
- wrap :: (Int -> IO ()) -> IO (FunPtr (Int -> IO ()))
+ wrap :: (Int -> IO ()) -> IO (JSFunPtr (Int -> IO ()))
-myCB :: Int -> IO ()
-myCB n = alert (show n)
+myCB :: Int -> Int -> IO ()
+myCB n m = alert (show $ m + n)
main :: IO ()
main =
putStrLn "data_export_wrapper"
- >>= \_ -> wrap myCB
+ >>= \_ -> wrap (myCB 2)
>>= \sf -> someFun 2 3 sf
{- main = do-}
{- putStrLn "data_export_wrapper"-}
@@ -26,6 +25,14 @@ main =
{-
+
+In this particular case, alert is actually the culprit. It requires two
+arguments, because it is in IO. The current hardcoding is correct in the sense
+that we're passing the right argument (the monad), but obviously we can't rely
+on hardcoding (it won't work with pure functions, for example).
+
+
+
We now require all functions in an exported constructor to be wrapped in an
IO JSFunPtr construction. To enforce this, we need to modify the type-checker.
We then also need to implement wrapper support in the FFI and do lambda lifting
@@ -1,10 +1,33 @@
import Language.UHC.JScript.ECMA.String
import Language.UHC.JScript.Primitives
+import Language.UHC.JScript.Assorted
+
+{-
+
+So this would be somewhat of a decent idea. The thing is, though, that we'd
+still be doing runtime conversion. If we're going to be stuck with that anyway,
+we might just as well just have a primitive JS function to do this for us. We'd
+still need to wrap the functions in an object, though. Would we need some
+facility to turn the datatype into an object first? I don't think so; we'd just
+have to evaluate the datatype and then call primToPlainObj on it. In fact, we
+might as well embed the evaluation in primToPlainObj and do the evaluation
+inside. We would then import it with type `a -> JSPtr b`.
+
+So, in short: the original object export approach won't be good enough. In
+common usecases, one stores callbacks in an object. These callbacks need to
+be of type JSFunPtr (...). The only way to obtain something of that type is
+to wrap a function using a wrapper, which is a dynamic process. Converting a
+Haskell datatype is therefor also defered to runtime. In fact, the entire
+process is very similar to a function wrapper. One could call it an object
+wrapper.
+-}
main = do
putStrLn "data_export"
- let ptr = myBookPtr
- putStrLn $ show $ getCount ptr
+ add' <- mkMath add
+ bptr <- mkBook (myBook add')
+ print $ getCount bptr
+ myFun bptr
getCount :: JSBook -> Int
getCount = getAttr "count"
@@ -17,23 +40,51 @@ data Book
{ title :: JSString
, author :: JSString
, count :: Int
- , makeTitle :: JSString -> JSString -> JSString
- , stuff :: String
+ , stuff :: String
+ , doMath :: JSFunPtr (Int -> Int -> IO ())
}
- {- deriving Show-}
-add :: Int -> Int -> Int
-add x y = y + x
+add :: Int -> Int -> IO ()
+add x y = alert . show $ y + x
-foreign export jscript "addFoo" add :: Int -> Int -> Int
+-- TODO
+-- The current problem is that we need to do something like this:
+--
+-- main = do
+-- add' <- mkMath add
+-- let b = myBook add'
+-- ...
+-- where myBook add' = Book "" "" 1 "" add'
+--
+-- but the current object export cannot deal with exporting functions. How
+-- do we fix this?
+--
+-- Perhaps we need a mechanism similar to wrapper and dynamic, which
+-- dynamically creates a plain object from a datatype:
+--
+-- foreign import jscript "{}" mkJSObj :: a -> JSPtr b
+--
+-- where `a` must be a data value. If so, we should remove it from the FEL
+-- and parse it as a token instead. Though, that would require modifying
+-- _every_ FFI backend. Lets leave it in the FEL anyway.
+--
+myBook f = Book (stringToJSString "story") (stringToJSString "me") 123 "foo" f
-myBook = Book (stringToJSString "story") (stringToJSString "me") 123 (\x y -> y) "foo"
{- foreign export jscript "myBook" myBook :: Book-}
-foreign export jscript "{myBook}" myBook :: Book
+{- foreign export jscript "{myBook}" myBook :: Book-}
{- foreign import jscript "myBook()" myBookPtr :: JSBook-}
-foreign import jscript "{myBook}" myBookPtr :: JSBook
+{- foreign import jscript "{myBook}" myBookPtr :: JSBook-}
+
+mkBook :: Book -> IO JSBook
+mkBook = mkObj
+
+foreign import jscript "myFun(%1)"
+ myFun :: JSBook -> IO ()
+
+foreign import jscript "{}"
+ mkObj :: a -> IO (JSPtr b)
-foreign import jscript "%1.makeTitle(%1)"
- jsMkTitle :: JSBook -> JSString -> JSString
+foreign import jscript "wrapper"
+ mkMath :: (Int -> Int -> IO ()) -> IO (JSFunPtr (Int -> Int -> IO ()))
@@ -1,4 +1,3 @@
-function myFun() {
- var book = myBook();
- return book;
+function myFun(book) {
+ book.doMath(2,3);
}
@@ -1,13 +1,13 @@
main :: IO ()
main = do
- let answ = fldToN (f 3) 10
+ answ <- fldToN (f 3) 10
putStrLn $ show answ
f :: Int -> Int -> Int -> Int
f n x xs = n + x + xs
-fldToN :: (Int -> Int -> Int) -> Int -> Int
-fldToN f n = foldr f 0 [1..n]
+fldToN :: (Int -> Int -> Int) -> Int -> IO Int
+fldToN f n = return $ foldr f 0 [1..n]
foreign export jscript "fldToN"
- fldToN :: (Int -> Int -> Int) -> Int -> Int
+ fldToN :: (Int -> Int -> Int) -> Int -> IO Int

0 comments on commit e42334c

Please sign in to comment.