diff --git a/imaginary/fibers-dev/ChangeLog.md b/imaginary/fibers-dev/ChangeLog.md
new file mode 100644
index 0000000..c4492b7
--- /dev/null
+++ b/imaginary/fibers-dev/ChangeLog.md
@@ -0,0 +1,5 @@
+# Revision history for eta-fibers
+
+## 0.1.0.0  -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/imaginary/fibers-dev/LICENSE b/imaginary/fibers-dev/LICENSE
new file mode 100644
index 0000000..56cc0bf
--- /dev/null
+++ b/imaginary/fibers-dev/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2017, Rahul Muttineni
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Rahul Muttineni nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/imaginary/fibers-dev/Main.hs b/imaginary/fibers-dev/Main.hs
new file mode 100644
index 0000000..058b071
--- /dev/null
+++ b/imaginary/fibers-dev/Main.hs
@@ -0,0 +1,50 @@
+import Control.Monad
+import Control.Concurrent.MVar hiding (takeMVar, putMVar)
+import qualified Control.Concurrent.MVar as MVar
+import Control.Concurrent.Fiber
+import Control.Concurrent.Fiber.MVar
+import System.Environment
+import GHC.Conc.Sync hiding (yield)
+import GHC.Conc.IO
+import Java
+
+import Control.Monad.IO.Class
+
+ring = 503
+
+new l i = do
+  r   <- newEmptyMVar
+  ret <- newEmptyMVar
+  forkFiber (thread ret i l r)
+  return (r, ret)
+
+thread :: MVar Int -> Int -> MVar Int -> MVar Int -> Fiber ()
+thread ret i l r = go
+  where go = do
+          m <- takeMVar l
+          putMVar r $! m - 1
+          if (m < 1)
+          then putMVar ret m
+          else go
+
+threadring :: Int -> Int -> IO JIntArray
+threadring ring msgs = do
+  setNumCapabilities 1
+  a       <- newMVar msgs
+  ret     <- newEmptyMVar
+  (z, xs) <- foldM (\(prev, xs) i -> do
+                   (r, ret) <- new prev i
+                   return (r, ret:xs))
+               (a, []) [2..ring]
+  forkFiber (thread ret 1 z a)
+  ints <- mapM MVar.takeMVar (reverse (ret : xs))
+  return $ toJava ints
+
+foreign export java "@static eta.threadring.ThreadRing.start"
+  threadring :: Int -> Int -> IO JIntArray
+
+main :: IO ()
+main = do
+  msgs <- fmap (read . head) getArgs
+  threadring ring msgs
+  return ()
diff --git a/imaginary/fibers-dev/Setup.hs b/imaginary/fibers-dev/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/imaginary/fibers-dev/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/imaginary/fibers-dev/desktop.ini b/imaginary/fibers-dev/desktop.ini
new file mode 100644
index 0000000..f63c1a5
--- /dev/null
+++ b/imaginary/fibers-dev/desktop.ini
@@ -0,0 +1,5 @@
+[.ShellClassInfo]
+InfoTip=Esta carpeta se ha compartido online.
+IconFile=C:\Program Files (x86)\Google\Drive\googledrivesync.exe
+IconIndex=16
+    
\ No newline at end of file
diff --git a/imaginary/fibers-dev/fibers-dev.cabal b/imaginary/fibers-dev/fibers-dev.cabal
new file mode 100644
index 0000000..316dd77
--- /dev/null
+++ b/imaginary/fibers-dev/fibers-dev.cabal
@@ -0,0 +1,41 @@
+name:                fibers-dev
+version:             0.1.0.0
+-- synopsis:            
+-- description:         
+license:             BSD3
+license-file:        LICENSE
+author:              Rahul Muttineni
+maintainer:          rahulmutt@gmail.com
+-- copyright:           
+-- category:            
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Control.Concurrent.Fiber
+                       Control.Concurrent.Fiber.MVar
+                       Control.Concurrent.Fiber.Internal
+  -- other-extensions:    
+  build-depends:       base >=4.8 && <4.9
+                     , transformers
+  hs-source-dirs:      src
+  java-sources:        prim/PrimOps.java
+  default-language:    Haskell2010
+  default-extensions:  InstanceSigs
+                       ScopedTypeVariables
+                       GHCForeignImportPrim
+                       MagicHash
+                       UnboxedTuples
+                       UnliftedFFITypes
+  ghc-options:         -ddump-stg -ddump-to-file
+  
+executable  Main
+    main-is: Main.hs
+    build-depends:
+        base >=4.8 && <4.9
+      , transformers
+      , fibers-dev
+    default-language: Haskell2010
+    hs-source-dirs:  .
+    ghc-options: -threaded -rtsopts
\ No newline at end of file
diff --git a/imaginary/fibers-dev/prim/PrimOps.java b/imaginary/fibers-dev/prim/PrimOps.java
new file mode 100644
index 0000000..5b0aeb0
--- /dev/null
+++ b/imaginary/fibers-dev/prim/PrimOps.java
@@ -0,0 +1,157 @@
+package eta.fibers;
+
+import java.util.Queue;
+import java.util.Map;
+import java.util.Stack;
+import java.util.IdentityHashMap;
+import java.util.concurrent.ConcurrentHashMap;
+import java.util.concurrent.ConcurrentLinkedQueue;
+import java.util.concurrent.atomic.AtomicBoolean;
+
+import eta.runtime.stg.Capability;
+import eta.runtime.stg.Closure;
+import eta.runtime.stg.Closures;
+import eta.runtime.stg.StgContext;
+import eta.runtime.stg.TSO;
+import eta.runtime.concurrent.Concurrent;
+import eta.runtime.concurrent.Fiber;
+import eta.runtime.concurrent.MVar;
+//import eta.runtime.exception;
+
+import static ghc_prim.ghc.Types.*;
+import static eta.runtime.stg.TSO.WhatNext.*;
+import static eta.runtime.stg.Closures.*;
+
+/* TODO: Provide cleanup operations by extending the runtime with hooks. */
+
+
+public class PrimOps {
+    public static class EmptyException extends eta.runtime.exception.StgException {}
+    public static final EmptyException EMPTYEXCEPTION= new EmptyException();
+
+    public static IdentityHashMap<TSO,Closure> tsoEvent = new IdentityHashMap<TSO,Closure>();
+    public static void throwEmpty(StgContext context){
+        throw EMPTYEXCEPTION;
+    }
+    public static Closure alternativeFiber(StgContext context, Closure fa, Closure fb) {
+        TSO tso = context.currentTSO;
+        int oldTop = tso.contStackTop;
+        try {
+            return fa.applyV(context);
+        } catch (EmptyException e) {
+            tso.contStackTop = oldTop;
+               tso.currentCont= fb;
+            return fb.applyV(context);
+        }
+    }
+
+    
+
+    public static int topStackC(StgContext context){
+        return context.currentTSO.contStackTop;
+
+    }
+
+
+
+    public static Object getStackC(StgContext context){
+        Closure[] newContStack = new Closure[context.currentTSO.contStackTop];
+        System.arraycopy(context.currentTSO.contStack,0,newContStack,0, context.currentTSO.contStackTop);
+        return newContStack;
+    }
+
+
+    public static void setTopStackC(StgContext context,int top){
+        context.currentTSO.contStackTop= top;
+    }
+
+
+    public static TSO getTSOC(StgContext context) {
+        return context.currentTSO;
+    }
+
+    public static void setContStack(StgContext context, int top, Object newContStack,Closure current){ 
+        context.currentTSO.contStack= (Closure[]) newContStack;
+        context.currentTSO.contStackTop= top;
+        context.currentTSO.currentCont = current;
+
+    }
+    
+    public static Closure getEventCC(StgContext context){
+        Closure v= tsoEvent.get(context.currentTSO);
+        if (v==null)  context.I1 = 0; else context.I1 = 1;
+        return v;
+    }
+    public static void setEventC(StgContext context,Closure ev){
+        tsoEvent.put(context.currentTSO,ev);
+    }
+    
+    public static void delEventCC(StgContext context){
+        tsoEvent.remove(context.currentTSO);
+    }
+
+
+
+    public static void setCurrentC(StgContext context, Closure action) {
+        context.currentTSO.currentCont = action;
+    }
+
+    public static void pushNextC(StgContext context, Closure action) {
+        context.currentTSO.pushCont(action);
+    }
+
+    public static Closure popNextC(StgContext context) {
+        return context.currentTSO.popCont();
+    }
+
+    public static Closure getCurrentC(StgContext context) {
+        return context.currentTSO.currentCont;
+    }
+
+    public static Closure popContStack(StgContext context) {
+        TSO tso = context.currentTSO;
+        if (tso.emptyContStack()) {
+            context.I1 = 0;
+            return null;
+        } else {
+            context.I1 = 1;
+            return tso.popCont();
+        }
+    }
+
+    public static Closure resumeFiber = null;
+
+    static {
+        try {
+          resumeFiber = loadClosure("fibers_dev.control.concurrent.fiber.Internal", "resumeFiber");
+        } catch (Exception e) {
+            System.err.println("FATAL ERROR: Failed to load resumeFiber closure.");
+            e.printStackTrace();
+            System.exit(1);
+        }
+    }
+    public static void yieldFiber(StgContext context, int block) {
+        TSO tso = context.currentTSO;
+        tso.whatNext = (block == 1)? ThreadBlock : ThreadYield;
+        Closure oldClosure = tso.closure;
+        if (oldClosure instanceof EvalLazyIO) {
+            ((EvalLazyIO) oldClosure).p = resumeFiber;
+        } else {
+            oldClosure = Closures.evalLazyIO(resumeFiber);
+        }
+        throw Fiber.yieldException.get();
+    }
+
+    public static void addMVarListener(StgContext context, MVar m) {
+        m.registerListener(context.currentTSO);
+    }
+
+    public static void awakenMVarListeners(StgContext context, MVar m) {
+        for (TSO top = m.getListeners(); top != null;) {
+            Concurrent.pushToGlobalRunQueue(top);
+            TSO oldTop = top;
+            top = top.link;
+            oldTop.link = null;
+        }
+    }
+}
diff --git a/imaginary/fibers-dev/prim/desktop.ini b/imaginary/fibers-dev/prim/desktop.ini
new file mode 100644
index 0000000..f63c1a5
--- /dev/null
+++ b/imaginary/fibers-dev/prim/desktop.ini
@@ -0,0 +1,5 @@
+[.ShellClassInfo]
+InfoTip=Esta carpeta se ha compartido online.
+IconFile=C:\Program Files (x86)\Google\Drive\googledrivesync.exe
+IconIndex=16
+    
\ No newline at end of file
diff --git a/imaginary/fibers-dev/src/Control/Concurrent/Fiber.hs b/imaginary/fibers-dev/src/Control/Concurrent/Fiber.hs
new file mode 100644
index 0000000..4946586
--- /dev/null
+++ b/imaginary/fibers-dev/src/Control/Concurrent/Fiber.hs
@@ -0,0 +1,28 @@
+module Control.Concurrent.Fiber
+  (Fiber(..)
+  ,runFiber
+  ,forkFiber
+  ,yield
+  ,block
+  ,liftIO
+
+  ,MVar
+  ,newMVar
+  ,newEmptyMVar
+  ,modifyMVar
+  ,takeMVar
+  ,putMVar
+
+  ,setNumCapabilities
+  ,getNumCapabilities
+
+  ,threadDelay
+  )
+  where
+
+import Control.Concurrent.Fiber.Internal
+import Control.Concurrent.Fiber.MVar
+import Control.Monad.IO.Class
+import GHC.Conc.Sync hiding (yield)
+import GHC.Conc.IO
+import Control.Concurrent.MVar (newEmptyMVar, newMVar, modifyMVar)
diff --git a/imaginary/fibers-dev/src/Control/Concurrent/Fiber/Internal.hs b/imaginary/fibers-dev/src/Control/Concurrent/Fiber/Internal.hs
new file mode 100644
index 0000000..375c85a
--- /dev/null
+++ b/imaginary/fibers-dev/src/Control/Concurrent/Fiber/Internal.hs
@@ -0,0 +1,360 @@
+module Control.Concurrent.Fiber.Internal where
+
+import GHC.Base
+import GHC.Conc.Sync
+import Control.Monad
+import Unsafe.Coerce
+
+import Data.Typeable
+import Control.Concurrent
+import Control.Exception
+import Control.Applicative
+import Control.Monad.IO.Class
+import Data.Monoid hiding (Any)
+import Java.Core
+import Data.IORef
+-- Fiber
+import Debug.Trace 
+-- (!>) x y= trace (show y) x
+
+
+newtype Fiber a = Fiber { unFiber :: State# RealWorld -> (# State# RealWorld, a #) }
+
+instance Functor Fiber where
+  fmap f (Fiber io) = Fiber $ \s -> case io s of (# s1, a #) -> (# s1, f a #)
+
+
+data Empty= Empty  deriving  (Show)
+instance Exception Empty
+
+instance Alternative Fiber where
+  empty= Fiber $ \s -> case throwEmpty# s of s1 -> (# s1, undefined #)
+  mf <|> mg= unsafeCoerce $ Fiber $ \s ->  alternativeFiber#  (unsafeCoerce mf) (unsafeCoerce mg) s
+    --   Fiber $ \s -> case topStack#  s of
+    -- (# s1, top, current #)  -> catch# mf (mg' top current) s1
+    -- where
+    -- mg' top current Empty s = case setTopStack# top (unsafeCoerce mg) s of
+    --     s1 -> mg s1 
+catchEmpty :: Monad m => m a -> m a -> m a
+catchEmpty mf mg= unsafeCoerce $ Fiber $ \s ->  alternativeFiber#  (unsafeCoerce mf) (unsafeCoerce mg) s
+throwEmpty :: IO a
+throwEmpty =  IO $ \s -> case throwEmpty# s of s1 -> (# s1, undefined #)
+
+instance Monoid a => Monoid (Fiber a) where
+  mempty= return mempty
+  mappend x y=  (<>) <$> x <*> y 
+
+instance Applicative Fiber where
+  pure = return
+  -- (<*>) = ap
+  mf <*> mx = do 
+    r1 <- liftIO $ newIORef Nothing
+    r2 <- liftIO $ newIORef Nothing
+    fparallel r1 r2 <|>  xparallel r1 r2 
+    where
+    fparallel r1 r2= do 
+      f <- mf 
+      liftIO $ (writeIORef r1 $ Just f) 
+      mx <- liftIO (readIORef r2) 
+      case mx of 
+        Nothing -> empty 
+        Just x  -> return $ f x 
+
+    xparallel r1 r2 = do 
+      x <- mx 
+      liftIO $ (writeIORef r2 $ Just x)
+      mf <- liftIO (readIORef r1)
+      case mf of
+        Nothing -> empty 
+        Just f -> return $ f x
+
+  -- Fiber mf <*> Fiber mx = Fiber $ \s ->  
+  --   case newMutVar# Nothing s  of
+  --     (# s1, r1 #) -> case newMutVar# Nothing s1 of
+  --       (# s2, r2 #)  ->  case topStack#  s2 of
+  --         (# s3, top #)  ->  catch# (fparallel r1 r2  )     ( xparallel r1 r2 top ) s3
+  
+  --   where
+    
+  --   fparallel r1 r2 s=  case mf s of
+  --         (# s3, f #)  ->  case writeMutVar# r1 (Just f) s3  of
+  --           s4#  -> case readMutVar# r2   s4#  of
+  --             (# s5,mx #)  -> case mx of
+  --               Just x  -> (# s5, f x #)
+  --               Nothing -> raiseIO# (toException Empty) s5
+                
+    
+  --   xparallel  r1 r2 top (_ :: Empty) s=  case mx s of
+  --         (# s3, x #)  ->  case writeMutVar# r2 (Just x)  s3  of
+  --           s4#  -> case readMutVar# r1   s4#  of
+  --             (# s5,mf #)  -> case mf of
+  --               Just f  -> (# s5, f x #)
+  --               Nothing -> case setTopStack# top s5 of
+  --                 s6 -> raiseIO# (toException Empty) s6
+                
+
+
+instance Monad Fiber where
+  return :: a -> Fiber a
+  return a = Fiber $ \s -> (# s, a #)
+
+  (>>=) :: forall a b. Fiber a -> (a -> Fiber b) -> Fiber b
+  (>>=) (Fiber m) f = Fiber $ \s ->
+    case setCurrentC# (unsafeCoerce m) s of
+      s1 -> case pushNextC# (unsafeCoerce f) s1 of
+        s2 -> case m s2 of
+          (# s3, a #) -> case popNextC# s3 of
+            (# s4, _ #) ->
+              case f a of
+                fa -> case setCurrentC# (unsafeCoerce fa) s4 of
+                  s5 -> unFiber fa s5
+
+instance MonadIO Fiber where
+  liftIO :: IO a -> Fiber a
+  liftIO (IO m) = Fiber m
+
+-- Fiber Utilities
+runFiber :: forall a. Fiber a -> IO (Either (Fiber a) a)
+runFiber (Fiber m) = undefined
+  -- catch (fmap Right $ IO m) (\(Yield _ fiber) -> return $ Left (unsafeCoerce fiber))
+
+runFiberWithBlock :: forall a. Fiber a -> IO (Either (Bool, Fiber a) a)
+runFiberWithBlock (Fiber m) = undefined
+--   catch (fmap Right $ IO m) $
+--   \(Yield block fiber) -> return $ Left (block, unsafeCoerce fiber)
+
+resumeFiber :: Fiber ()
+resumeFiber = Fiber $ \s ->
+  case getCurrentC# s of
+    (# s1, fiber #) ->
+      case (unsafeCoerce fiber) s1 of
+        (# s2, a #) -> (# go a s2, () #)
+  where go :: Any -> State# s -> State# s
+        go a s =
+          case popContStack# s of
+            (# s1, 1#, cont1 #) ->
+              let fa = (unsafeCoerce cont1) a
+              in case setCurrentC# fa s1 of
+                   s2 -> case fa s2 of
+                     (# s3, a' #) -> go a' s3
+            (# s1, _, _ #) -> s1
+
+react
+    :: Typeable eventdata
+    => ((eventdata ->  IO response) -> IO ())
+    -> IO  response
+    -> Fiber eventdata
+react setHandler iob= liftIO $ do
+              mev <- getEvent
+              case mev of
+                Nothing -> do
+                    I# top <- topStack
+                    Obj stack <- getStack
+                    curr  <- getCurrent
+                    setHandler $ \dat ->do
+                                    forkCont (return dat) top stack curr  -- make sure TSO info is in 
+                                    iob
+                    throwEmpty
+      
+                Just ev -> do
+                    delEvent
+                    return $ unsafeCoerce ev
+        
+    where
+    
+
+async :: IO a -> Fiber a 
+async io= liftIO $ do 
+    mev <- getEvent 
+    case mev of
+
+      Nothing -> do 
+                forkCont' io
+                throwEmpty 
+      Just ev -> do 
+            delEvent
+            return ev
+    
+    where
+    forkCont' io= do 
+        I# top <- topStack
+        Obj stack <- getStack
+        curr  <- getCurrent
+        forkCont io top stack curr 
+
+forkCont io top stack curr= do
+        forkIO' $ do
+          setTSO  top   stack curr 
+          ev <- io
+          setEvent ev 
+          
+          unlift resumeFiber  
+          return () 
+         `catchEmpty`  return ()
+            
+        return()
+     where
+     setTSO   top stack current  = IO $ \s -> case setContStack# top stack current  s of s2 ->  (# s2, () #)
+      
+     forkIO' (IO mx)= IO $ \s -> case fork# mx s of  (# s1, tid #) -> (# s1, ThreadId tid #)
+     
+topStack= IO $ \s -> case topStack# s of (#s1, i #) -> (# s1, I# i #)  
+getStack= IO $ \s -> case getStack# s of (#s1, arr #) -> (#s1, Obj arr #) 
+getCurrent= IO $ \s -> getCurrentC# s
+
+data Obj = Obj (Object# Object)
+
+unlift (Fiber fib)= IO fib
+     
+
+-- async1 :: IO a -> Fiber a 
+-- async1 (IO io)=  Fiber $ \s -> io' s
+--     where
+--     unFiber (Fiber fib)= fib
+--     io' s =  case getEvent# s  of
+--       (# s2, 0#, _ #) -> case forkCont s2  of
+--                 (# s5, _ #) ->  raiseIO# (toException Empty) s5
+      
+--       (# s2, _, x #) -> case delEvent#  s2 of 
+--                   s3 -> (# s3, x #)
+  
+--     forkCont = \s ->   case getTSO# s of (#s2, tso #) -> fork# (execCont tso) s2
+--       where   
+--       execCont tso  =IO $ \s -> case io s of
+--         (# s1, x #) ->  case setEvent#  (unsafeCoerce  x) s1 of
+--            s2 ->  case setContStack# tso s1 of s2 -> alternativeFiber#  (unsafeCoerce resumeFiber) 
+--                                                                         (unsafeCoerce $ (return() ::IO())) s2
+
+      
+            
+
+yield :: Fiber a
+yield = yield' False
+
+block :: Fiber a
+block = yield' True
+
+yield' :: Bool -> Fiber a
+yield' block = Fiber $ \s ->
+  case popContStack# s of
+    (# s1, 1#, current #) ->
+      let fa = (unsafeCoerce current) extractYieldError
+      in case setCurrentC# (unsafeCoerce fa) s1 of
+           s2 -> (# yieldFiber# (dataToTag# block) s2
+                 ,  unreachableCodeError #)
+    (# s1, _, _ #) -> (# s1, lastYieldError #)
+  where extractYieldError =
+          error "Attempted to extract a value from a Fiber's yield or block."
+        lastYieldError =
+          error "You cannot yield or block as the last action of a Fiber."
+        unreachableCodeError =
+          error "This code should not have been reached."
+
+forkFiber x= forkFiber'  x `catchEmpty`   myThreadId
+  where
+  forkFiber' :: Fiber () -> IO ThreadId
+  forkFiber' (Fiber m)= IO $ \s ->
+    case fork# m s of (# s1, tid #) -> (# s1, ThreadId tid #)
+
+
+setEvent x= IO $ \s -> case setEvent# (unsafeCoerce  x) s of s1 -> (#s1 , () #)
+
+getEvent :: IO (Maybe a)
+getEvent = IO $ \s -> case getEvent#  s of
+      (# s1, 1# , x #) -> (#s1, Just $ unsafeCoerce x #)
+      (# s1,  _ , _ #) -> (#s1, Nothing #)
+
+delEvent= IO $ \s -> case delEvent# s of  s1->  (# s1,() #)
+
+
+catchf :: Exception e => Fiber a -> (e -> Fiber a) -> Fiber a
+catchf (Fiber exp)  exc=  
+    case IO exp `catch` (\e -> case exc e  of  Fiber r -> IO r) of
+        (IO r) -> Fiber r
+
+
+-- -- pure state
+
+-- data State= State  (State# RealWorld)
+-- getData :: Typeable a => Fiber (Maybe a)
+-- getData = resp
+--   where 
+--   -- get :: Fiber [(TypeRep,())]
+--   get= Fiber  $ \s -> (# s,  State s #) 
+    
+--   resp = do
+--           st <- get
+--           let list= unsafeCoerce st
+--           case lookup (typeOf $ typeResp resp) list of
+--             Just x  -> return . Just $ unsafeCoerce x
+--             Nothing -> return Nothing
+--   typeResp :: m (Maybe x) -> x
+--   typeResp = undefined
+-- -- Runtime primitives
+-- setData x =  do
+--     st' <- get
+--     let st= unsafeCoerce st'
+--     let nelem=  (t ,unsafeCoerce x)
+--     put $ State $ nelem : filter ((/=) t . fst) st
+--     where 
+--     t = typeOf x
+--     get= Fiber  $ \s -> (# s, State s #) 
+--     put (State x)= Fiber $ \_ -> (# x,() #)
+    
+data {-# CLASS "java.util.Stack" #-} Stack
+
+type Stack# = Object# Stack
+
+foreign import prim "eta.fibers.PrimOps.getCurrentC"
+  getCurrentC# :: State# s -> (# State# s, Any #)
+
+foreign import prim "eta.fibers.PrimOps.setCurrentC"
+  setCurrentC# :: Any -> State# s -> State# s
+
+foreign import prim "eta.fibers.PrimOps.pushNextC"
+  pushNextC# :: Any -> State# s -> State# s
+
+foreign import prim "eta.fibers.PrimOps.popNextC"
+  popNextC# :: State# s -> (# State# s, Any #)
+
+foreign import prim "eta.fibers.PrimOps.popContStack"
+  popContStack# :: State# s -> (# State# s, Int#, Any #)
+
+foreign import prim "eta.fibers.PrimOps.yieldFiber"
+  yieldFiber# :: Int# -> State# s -> State# s
+
+foreign import prim "eta.fibers.PrimOps.getEventCC"
+  getEvent# :: State# s -> (# State# s, Int#, a #)
+
+foreign import prim "eta.fibers.PrimOps.setEventC"
+  setEvent# :: Any -> State# s -> State# s
+
+foreign import prim "eta.fibers.PrimOps.delEventCC"
+  delEvent# ::  State# s -> State# s
+
+foreign import prim "eta.fibers.PrimOps.getTSOC"
+   getTSO# ::  State# s -> (# State# s, ThreadId# #)
+
+foreign import prim "eta.fibers.PrimOps.setContStack"
+   setContStack# ::  Int# -> Object# Object -> Any -> State# s  -> State# s
+
+-- foreign import prim "eta.fibers.PrimOps.traceC"
+--    trace# ::  String -> State# s  -> State# s
+
+foreign import prim "eta.fibers.PrimOps.topStackC"
+   topStack# ::  State# s  -> (#State# s, Int# #)
+
+foreign import prim "eta.fibers.PrimOps.getStackC"
+   getStack# ::  State# s  -> (#State# s,  Object# Object #)
+
+
+
+
+foreign import prim "eta.fibers.PrimOps.setTopStackC"
+   setTopStack# ::  Int# ->  State# s  -> State# s
+
+foreign import prim "eta.fibers.PrimOps.alternativeFiber"
+   alternativeFiber# ::  Any -> Any -> State# s  -> (# State# s, Any #)
+
+foreign import prim "eta.fibers.PrimOps.throwEmpty"
+   throwEmpty# ::  State# s  -> State# s
\ No newline at end of file
diff --git a/imaginary/fibers-dev/src/Control/Concurrent/Fiber/MVar.hs b/imaginary/fibers-dev/src/Control/Concurrent/Fiber/MVar.hs
new file mode 100644
index 0000000..d3f4fda
--- /dev/null
+++ b/imaginary/fibers-dev/src/Control/Concurrent/Fiber/MVar.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+module Control.Concurrent.Fiber.MVar
+  (MVar, takeMVar, putMVar)
+where
+
+import GHC.Base
+import Control.Concurrent.Fiber.Internal
+import GHC.MVar (MVar(..))
+
+takeMVar :: MVar a -> Fiber a
+takeMVar (MVar m) = go
+  where go = Fiber $ \s ->
+               case tryTakeMVar# m s of
+                 (# s', 0#, _ #) ->
+                   case addMVarListener# m s' of
+                     s'' -> unFiber (block >> go) s''
+                 (# s', _,  a #) ->
+                   case awakenMVarListeners# m s' of
+                     s'' -> (# s'', a  #)
+
+putMVar :: MVar a -> a -> Fiber ()
+putMVar (MVar m) x = go
+  where go = Fiber $ \s ->
+               case tryPutMVar# m x s of
+                 (# s', 0# #) ->
+                   case addMVarListener# m s' of
+                     s'' -> unFiber (block >> go) s''
+                 (# s', _  #) ->
+                   case awakenMVarListeners# m s' of
+                     s'' -> (# s'', () #)
+
+foreign import prim "eta.fibers.PrimOps.addMVarListener"
+  addMVarListener# :: MVar# s a -> State# s -> State# s
+
+foreign import prim "eta.fibers.PrimOps.awakenMVarListeners"
+  awakenMVarListeners# :: MVar# s a -> State# s -> State# s
diff --git a/imaginary/fibers-dev/src/Control/Concurrent/Fiber/desktop.ini b/imaginary/fibers-dev/src/Control/Concurrent/Fiber/desktop.ini
new file mode 100644
index 0000000..f63c1a5
--- /dev/null
+++ b/imaginary/fibers-dev/src/Control/Concurrent/Fiber/desktop.ini
@@ -0,0 +1,5 @@
+[.ShellClassInfo]
+InfoTip=Esta carpeta se ha compartido online.
+IconFile=C:\Program Files (x86)\Google\Drive\googledrivesync.exe
+IconIndex=16
+    
\ No newline at end of file
diff --git a/imaginary/fibers-dev/src/Control/Concurrent/desktop.ini b/imaginary/fibers-dev/src/Control/Concurrent/desktop.ini
new file mode 100644
index 0000000..f63c1a5
--- /dev/null
+++ b/imaginary/fibers-dev/src/Control/Concurrent/desktop.ini
@@ -0,0 +1,5 @@
+[.ShellClassInfo]
+InfoTip=Esta carpeta se ha compartido online.
+IconFile=C:\Program Files (x86)\Google\Drive\googledrivesync.exe
+IconIndex=16
+    
\ No newline at end of file
diff --git a/imaginary/fibers-dev/src/Control/desktop.ini b/imaginary/fibers-dev/src/Control/desktop.ini
new file mode 100644
index 0000000..f63c1a5
--- /dev/null
+++ b/imaginary/fibers-dev/src/Control/desktop.ini
@@ -0,0 +1,5 @@
+[.ShellClassInfo]
+InfoTip=Esta carpeta se ha compartido online.
+IconFile=C:\Program Files (x86)\Google\Drive\googledrivesync.exe
+IconIndex=16
+    
\ No newline at end of file
diff --git a/imaginary/fibers-new/LICENSE b/imaginary/fibers-new/LICENSE
new file mode 100644
index 0000000..fc6bf1a
--- /dev/null
+++ b/imaginary/fibers-new/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2017, 
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of  nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/imaginary/fibers-new/Main.hs b/imaginary/fibers-new/Main.hs
new file mode 100644
index 0000000..058b071
--- /dev/null
+++ b/imaginary/fibers-new/Main.hs
@@ -0,0 +1,50 @@
+import Control.Monad
+import Control.Concurrent.MVar hiding (takeMVar, putMVar)
+import qualified Control.Concurrent.MVar as MVar
+import Control.Concurrent.Fiber
+import Control.Concurrent.Fiber.MVar
+import System.Environment
+import GHC.Conc.Sync hiding (yield)
+import GHC.Conc.IO
+import Java
+
+import Control.Monad.IO.Class
+
+ring = 503
+
+new l i = do
+  r   <- newEmptyMVar
+  ret <- newEmptyMVar
+  forkFiber (thread ret i l r)
+  return (r, ret)
+
+thread :: MVar Int -> Int -> MVar Int -> MVar Int -> Fiber ()
+thread ret i l r = go
+  where go = do
+          m <- takeMVar l
+          putMVar r $! m - 1
+          if (m < 1)
+          then putMVar ret m
+          else go
+
+threadring :: Int -> Int -> IO JIntArray
+threadring ring msgs = do
+  setNumCapabilities 1
+  a       <- newMVar msgs
+  ret     <- newEmptyMVar
+  (z, xs) <- foldM (\(prev, xs) i -> do
+                   (r, ret) <- new prev i
+                   return (r, ret:xs))
+               (a, []) [2..ring]
+  forkFiber (thread ret 1 z a)
+  ints <- mapM MVar.takeMVar (reverse (ret : xs))
+  return $ toJava ints
+
+foreign export java "@static eta.threadring.ThreadRing.start"
+  threadring :: Int -> Int -> IO JIntArray
+
+main :: IO ()
+main = do
+  msgs <- fmap (read . head) getArgs
+  threadring ring msgs
+  return ()
diff --git a/imaginary/fibers-new/README b/imaginary/fibers-new/README
new file mode 100644
index 0000000..0c1d36f
--- /dev/null
+++ b/imaginary/fibers-new/README
@@ -0,0 +1 @@
+alternative Fiber monad for Eta
diff --git a/imaginary/fibers-new/Setup.hs b/imaginary/fibers-new/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/imaginary/fibers-new/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/imaginary/fibers-new/fibers-new.cabal b/imaginary/fibers-new/fibers-new.cabal
new file mode 100644
index 0000000..36201d3
--- /dev/null
+++ b/imaginary/fibers-new/fibers-new.cabal
@@ -0,0 +1,50 @@
+-- Initial fibers.cabal generated by etlas init.  For further 
+-- documentation, see http://etlas.typelead.com/users-guide
+
+name:                fibers-new
+version:             0.1.0.0
+-- synopsis:            
+-- description:         
+license:             BSD3
+license-file:        LICENSE
+-- author:              
+-- maintainer:          
+-- copyright:           
+-- category:            
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Control.Concurrent.Fiber
+                       Control.Concurrent.Fiber.MVar
+  other-modules:       
+  -- other-extensions:    
+  build-depends:       base >=4.8 && <4.9
+                     , transformers
+  hs-source-dirs:      src
+  java-sources:        prim/PrimOps.java
+  default-language:    Haskell2010
+  default-extensions:  InstanceSigs
+                       ScopedTypeVariables
+                       GHCForeignImportPrim
+                       MagicHash
+                       UnboxedTuples
+                       UnliftedFFITypes
+
+executable Main
+  default-extensions:  InstanceSigs
+                       ScopedTypeVariables
+                       GHCForeignImportPrim
+                       MagicHash
+                       UnboxedTuples
+                       UnliftedFFITypes
+  ghc-options:         -ddump-stg -ddump-to-file
+  main-is:             Main.hs
+  -- other-modules:       
+  other-extensions:    MultiParamTypeClasses, ExistentialQuantification, ScopedTypeVariables, FlexibleInstances, FlexibleContexts, UndecidableInstances
+  build-depends:       base >=4.8 && <4.9, transformers, fibers-new, timeit
+  hs-source-dirs:      .
+  java-sources:        prim/PrimOps.java
+
+  default-language:    Haskell2010
diff --git a/imaginary/fibers-new/prim/PrimOps.java b/imaginary/fibers-new/prim/PrimOps.java
new file mode 100644
index 0000000..bba83c6
--- /dev/null
+++ b/imaginary/fibers-new/prim/PrimOps.java
@@ -0,0 +1,42 @@
+package eta.fibers;
+
+import eta.runtime.stg.Capability;
+import eta.runtime.stg.Closure;
+import eta.runtime.stg.Closures;
+import eta.runtime.stg.StgContext;
+import eta.runtime.stg.TSO;
+import eta.runtime.concurrent.Concurrent;
+import eta.runtime.concurrent.Fiber;
+import eta.runtime.concurrent.MVar;
+//import eta.runtime.exception;
+
+import static ghc_prim.ghc.Types.*;
+import static eta.runtime.stg.TSO.WhatNext.*;
+import static eta.runtime.stg.Closures.*;
+
+public class PrimOps  {
+    public static void yieldFiber(StgContext context, int block, Closure cont) {
+        TSO tso = context.currentTSO;
+        tso.whatNext = (block == 1)? ThreadBlock : ThreadYield;
+        Closure oldClosure = tso.closure;
+        if (oldClosure instanceof EvalLazyIO) {
+            ((EvalLazyIO) oldClosure).p = cont;
+        } else {
+            tso.closure = Closures.evalLazyIO(cont);
+        }
+        throw Fiber.yieldException.get();
+    }
+
+    public static void addMVarListener(StgContext context, MVar m) {
+        m.registerListener(context.currentTSO);
+    }
+
+    public static void awakenMVarListeners(StgContext context, MVar m) {
+        for (TSO top = m.getListeners(); top != null;) {
+            Concurrent.pushToGlobalRunQueue(top);
+            TSO oldTop = top;
+            top = top.link;
+            oldTop.link = null;
+        }
+    }
+}
\ No newline at end of file
diff --git a/imaginary/fibers-new/prim/desktop.ini b/imaginary/fibers-new/prim/desktop.ini
new file mode 100644
index 0000000..f63c1a5
--- /dev/null
+++ b/imaginary/fibers-new/prim/desktop.ini
@@ -0,0 +1,5 @@
+[.ShellClassInfo]
+InfoTip=Esta carpeta se ha compartido online.
+IconFile=C:\Program Files (x86)\Google\Drive\googledrivesync.exe
+IconIndex=16
+    
\ No newline at end of file
diff --git a/imaginary/fibers-new/src/Control/Concurrent/Fiber.hs b/imaginary/fibers-new/src/Control/Concurrent/Fiber.hs
new file mode 100644
index 0000000..e852861
--- /dev/null
+++ b/imaginary/fibers-new/src/Control/Concurrent/Fiber.hs
@@ -0,0 +1,679 @@
+{-# LANGUAGE CPP, GHCForeignImportPrim, MagicHash, UnboxedTuples,UnliftedFFITypes, MultiParamTypeClasses, ExistentialQuantification, ScopedTypeVariables, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
+module Control.Concurrent.Fiber where
+
+import Control.Applicative
+import Control.Monad.IO.Class
+
+import GHC.Base
+import GHC.Conc.Sync hiding (yield)
+import Data.Function
+
+import System.IO.Unsafe
+import Data.IORef
+import Control.Concurrent(threadDelay)
+import Control.Concurrent.MVar
+-- import qualified Data.Map as M 
+import Data.Typeable
+-- import qualified Data.ByteString.Char8 as BS
+import Data.Monoid hiding (Any)
+import Unsafe.Coerce
+import Control.Exception hiding (onException)
+
+
+import Data.IORef
+import Debug.Trace
+x !> y=  trace (show y) x
+infixr 0 !>
+
+#ifdef ETA_VERSION
+
+
+foreign import prim "eta.fibers.PrimOps.yieldFiber"
+   yieldFiber# :: Int# -> Any -> State# s -> State# s
+
+yield= callCC $ \k ->  liftIO $ yieldFiber (runFiber $ k ())
+    where 
+    yieldFiber k= IO $ \s -> case yieldFiber# 0# (unsafeCoerce# k) s of s' -> (# s', () #)
+
+block=  callCC $ \k -> liftIO $ blockFiber (runFiber $ k ()) 
+     where
+     blockFiber k= IO $ \s -> case yieldFiber# 1# (unsafeCoerce# k) s of s' -> (# s', () #)
+
+data FiberId= FiberId ThreadId# 
+
+forkFiber :: MonadIO m => Fiber () -> m FiberId
+forkFiber f = liftIO $ IO $ \s -> case fork# (runFiber f) s of (# s', tid #) -> (# s', FiberId tid #)
+
+
+trampolineIO :: IO a -> IO a
+trampolineIO (IO m) = IO $ \s -> case trampoline# (unsafeCoerce# (m s)) of (# a #) -> (# freshStateToken# a, unsafeCoerce# a #)
+
+foreign import prim "eta.runtime.stg.Stg.trampoline"
+    trampoline# :: Any -> (# Any #)
+
+#else
+forkFiber f = liftIO  $ forkIO $ runFiber f `catch` \Empty -> return ()
+yield= return()
+trampolineIO= id
+#endif
+
+-- Type coercion is necessary because continuations can only be modeled fully within Indexed monads. 
+-- See paper P. Wadler "Monads and composable continuations" 
+-- The symtom of that problem in the typical continuation monad is an extra parameter r that complicates reasoning
+-- This monad eliminates the extra parameter by coercing types since, by construction, the contination parameter is of the
+--  type of the result of the first term of the bind.
+ety :: a -> b 
+ety=   dontWorryEverithingisOk
+tdyn :: a -> Dyn
+tdyn=  dontWorryEverithingisOk
+fdyn :: Dyn -> a
+fdyn = dontWorryEverithingisOk
+
+dontWorryEverithingisOk= unsafeCoerce
+
+type Dyn= ()
+
+data Fiber  a = Fiber { runFiberC :: (Dyn -> IO a) -> IO a }
+
+unFiber= unIO . runFiber
+ where unIO (IO x)= x
+
+
+instance   Monad Fiber  where
+    return  = pure
+    m >>= k  = Fiber $ \c -> ety $ runFiberC m (\x -> ety $ runFiberC ( k $ fdyn x) c)
+
+
+-- instance MonadState  EventF Fiber where
+--     get= lift get
+--     put= lift . put
+
+-- instance MonadTrans (Fiber ) where
+--      lift m = Fiber ((unsafeCoerce m) >>=)
+
+instance MonadIO Fiber  where
+    liftIO x= Fiber  (ety x >>=)
+
+callCC :: ((a -> Fiber b) -> Fiber a) -> Fiber a
+callCC f = Fiber $ \ c -> runFiberC (f (\ x -> Fiber $ \ _ -> ety $ c $ tdyn x)) c
+
+instance Functor Fiber where
+    fmap f m = Fiber $ \c -> ety $ runFiberC m $ \ x->   ety c $ f $ fdyn x
+                 
+instance Monoid a => Monoid (Fiber a) where
+    mappend x y = mappend <$> x <*> y
+    mempty      = return mempty
+
+instance Applicative Fiber  where
+    pure a  = Fiber ($  tdyn a)
+    --f <*> v = ety $ Fiber $ \ k -> ety $ runFiberC f $ \ g -> ety $ runFiberC v $ \t -> k $ (ety g) t
+    f <*> v =   do
+          r1 <- liftIO $ newIORef Nothing
+          r2 <- liftIO $ newIORef Nothing
+          (fparallel r1 r2)  <|> (vparallel  r1 r2)
+      where
+
+      fparallel :: IORef (Maybe(a -> b)) -> IORef (Maybe a) -> Fiber b 
+      fparallel r1 r2= ety $ Fiber $ \k  -> 
+          runFiberC f $ \g -> do
+                (liftIO $ writeIORef r1  $ Just (fdyn  g)) !> "f write r1"
+                mt <- liftIO $ readIORef r2  !> "f read r2"
+                case mt of 
+                  Just t -> k $ (fdyn g) t
+                  Nothing -> liftIO $ throw  Empty  !> "throwempty"
+                  
+      vparallel :: IORef (Maybe(a -> b)) -> IORef (Maybe a) -> Fiber b
+      vparallel  r1 r2=  ety $ Fiber $ \k  ->  
+          runFiberC v $ \t ->  do
+                 (liftIO $ writeIORef r2 $ Just (fdyn t)) !> "v write r2"
+                 mg <- liftIO $ readIORef r1 !> "v read r1"
+                 case mg of 
+                   Nothing -> liftIO $ throw  Empty   !> "throwempty"
+                   Just g -> ( k $ (ety g) t)  !> "JUST"
+
+data Empty= Empty  deriving Typeable
+instance Show Empty where show _= "Empty"
+instance Exception Empty
+
+instance Alternative Fiber where
+    empty= liftIO $ throw  Empty 
+    f <|>  g= callCC $ \k -> do -- liftIO  $ runFiber  (f >>=k)  `catch` \Empty -> runFiber  (g >>=k) 
+            
+          
+            r <- liftIO $ newIORef False
+            let io  f cont= runFiber  (f >>= cont' ) 
+                    where cont' x= do liftIO $ (writeIORef r True) !> "write" ; cont x
+            liftIO $ do
+                 io f k `catch` \(Empty) -> do
+                    c <- liftIO $ readIORef r 
+                    when c $ throw Empty 
+                    io g k      
+            
+            
+
+    -- f <|>  g = callCC $ \k -> do 
+    --     x <-  liftIO $ runFiber f `catch` (\Empty -> (runFiber g) !> "RUNFIBERG" )
+    --     k x !> "continuation"
+              
+
+runFiber :: Fiber a -> IO a 
+runFiber x= trampolineIO $ runFiberC x (return . ety id )
+
+inputLoop= getLine >>= \l -> atomically (writeTVar mvline l)  >> inputLoop
+
+no = unsafePerformIO newEmptyMVar
+
+mvline= unsafePerformIO $  newTVarIO ""
+
+-- option :: String -> Fiber  String
+-- --option :: [Char] -> Fiber r (StateT t IO) [Char]
+-- option s = waitEvents . atomically $ do
+--               x <- readTVar mvline
+--               if  x== s then  writeTVar mvline "" >> return s else retry               
+
+-- callCC :: ((a -> Fiber r StateIO b) -> Fiber r m a) -> Fiber r m a
+
+async :: IO a -> Fiber a 
+async io= callCC $ \ret -> do
+            forkFiber $  ( liftIO io >>= ret ) >> return () 
+            empty   !> "async empty"
+
+waitEvents :: IO a -> Fiber a
+waitEvents io= callCC $ \ret -> do
+    loop ret  
+    where
+    loop ret =  do
+            forkFiber $ do 
+                      (liftIO io >>=  ret  >> loop ret)
+                      return () 
+            empty
+
+
+
+testReact = do
+  -- forkIO' inputLoop
+   forkFiber $ liftIO reactLoop
+   r <-  (reactOption "hello")  <>  (reactOption "world")
+   liftIO $ print r 
+        
+   liftIO $ takeMVar no
+
+
+   
+   
+class AdditionalOperators m where
+
+  -- | Run @m a@ discarding its result before running @m b@.
+  (**>)  :: m a -> m b -> m b
+
+  -- | Run @m b@ discarding its result, after the whole task set @m a@ is
+  -- done.
+  (<**)  :: m a -> m b -> m a
+
+  atEnd' :: m a -> m b -> m a
+  atEnd' = (<**)
+
+  -- | Run @m b@ discarding its result, once after each task in @m a@, and
+  -- every time that an event happens in @m a@
+  (<***) :: m a -> m b -> m a
+
+  atEnd  :: m a -> m b -> m a
+  atEnd  = (<***)
+
+instance AdditionalOperators Fiber  where
+
+  -- (**>) :: Fiber a -> Fiber b -> Fiber b
+  (**>) f g =  Fiber $ \c -> ety $ runFiberC f (\_ -> ety $ runFiberC  g c)
+      
+
+  -- (<***) :: Fiber a -> Fiber b -> Fiber a
+  (<***) f g = 
+      ety $ Fiber $ \k -> ety $ runFiberC f $ \x ->  ety $ runFiberC g  (\_ -> k x)   
+      where 
+      f' = callCC $ \c -> g >> c ()
+
+  -- (<**) :: Fiber a -> Fiber b -> Fiber a
+  (<**) f g = ety $ Fiber $ \k -> ety $ runFiberC f $ \x ->  ety $ runFiberC g  (\_ -> k x)  
+--f >>= g   = Fiber $ \k ->  runFiberC f $ \x -> ety $ runFiberC ( g $ unsafeCoerce x) k
+  
+
+infixr 1 <***, <**, **>   
+
+
+react 
+  :: ((eventdata ->  IO response) -> IO ())
+  -> IO  response
+  -> Fiber eventdata
+react setHandler iob= callCC $ \ret -> do
+            liftIO $ setHandler $  \x ->  (runFiber $ ret x) >> iob
+            empty
+
+reactOption :: String -> Fiber String
+reactOption s = do 
+         x <- react setCallback (return ())
+         if  x /= s then empty else do 
+            --   liftIO $ atomically $ writeTVar mvline ""
+               return s
+  
+
+reactLoop =  do
+          x   <- getLine -- atomically $ readTVar mvline
+          mbs <- readIORef rcb
+          Prelude.mapM (\cb -> cb x)  mbs
+          reactLoop
+
+rcb= unsafePerformIO $ newIORef [] 
+
+setCallback :: (String ->  IO ()) -> IO ()
+setCallback cb= atomicModifyIORef rcb $ \cbs ->  (reverse $ cb : cbs,())
+
+
+
+
+   
+
+test2= runFiber $ do
+  r  <- return 2
+--   r' <- liftIO $ return $ r +5
+--   r2 <- callCC $ \ret -> do 
+--      ret  100
+--      liftIO  $ print "HELLO"
+--      return 1
+  liftIO $ print $ r
+--   liftIO $ print $ "world3"
+
+test1=  do 
+  setNumCapabilities 1
+  forkFiber $ f "hello"
+  forkFiber $ f "world"
+  forkFiber $ f "world2"
+  
+  takeMVar mexit     
+
+  where
+  f str= do 
+     liftIO $ print str
+     yield
+     f str
+
+test3 = keep $ do
+    r<-  ( async $ return "hello " )   <>   
+            (async $ return "world" )
+    -- r <-  async ( return "hello ") <|> return "world"
+    -- r2 <-  async ( return "hello2 ") <|> return "world2"
+    
+    -- r <- Fiber $ \c -> runFiberC  (return "hello") c
+    
+    liftIO $ print  r
+
+test= runFiber $ do
+   r <- liftIO $ newIORef 0
+   sum  r 1000000
+ where
+ sum r 0= do r <- liftIO $ readIORef r; liftIO $ print r
+ sum r x= do
+    liftIO $ modifyIORef r $ \v -> v + x 
+    sum r $x -1 
+
+mexit= unsafePerformIO $ newEmptyMVar  
+
+keep :: Fiber () -> IO ()
+keep mx=   do
+    forkFiber $ liftIO $ (runFiber  mx)  `catch` \Empty -> return ()
+    takeMVar mexit     
+
+
+
+
+{-- ---------------------------------backtracking ------------------------
+
+
+data Backtrack b= forall a r c. Backtrack{backtracking :: Maybe b
+                                     ,backStack :: [(b ->Fiber  c,c -> Fiber  a)] }
+                                     deriving Typeable
+
+
+
+-- | Delete all the undo actions registered till now for the given track id.
+-- backCut :: (Typeable b, Show b) => b -> Fiber ()
+backCut reason=
+     delData $ Backtrack (Just reason)  [] 
+
+-- | 'backCut' for the default track; equivalent to @backCut ()@.
+undoCut ::  Fiber ()
+undoCut = backCut ()
+
+-- | Run the action in the first parameter and register the second parameter as
+-- the undo action. On undo ('back') the second parameter is called with the
+-- undo track id as argument.
+--
+onBack :: (Typeable b, Show b) => Fiber a -> ( b -> Fiber a) -> Fiber a
+onBack ac back =  do
+     -- Backtrack mreason _  <- getData `onNothing` backStateOf (typeof bac) !> "HANDLER1"
+    -- r <-ac
+    --  case mreason  !> ("mreason",mreason) of
+    --               Nothing     -> ac
+    --               Just reason -> bac reason
+     registerBack  ac back
+  
+   where
+         
+   typeof :: (b -> Fiber a) -> b
+   typeof = undefined
+
+-- | 'onBack' for the default track; equivalent to @onBack ()@.
+onUndo ::  Fiber a -> Fiber a -> Fiber a
+onUndo x y= onBack x (\() -> y)
+
+
+
+-- | Register an undo action to be executed when backtracking. The first
+-- parameter is a "witness" whose data type is used to uniquely identify this
+-- backtracking action. The value of the witness parameter is not used.
+--
+-- registerBack :: (Typeable a, Show a) => (a -> Fiber a) -> a -> Fiber a
+registerBack  ac back = callCC $ \k -> do
+   md <- getData `asTypeOf` (Just <$> (backStateOf $ typeof back))  !> "HANDLER"
+   case md of
+        Just (bss@(Backtrack b (bs@((back',_):_)))) ->
+          --  when (isNothing b) $ do
+          --      addrx  <- addr back'
+          --      addrx' <- addr back        -- to avoid duplicate backtracking points
+          --      when (addrx /= addrx') $ do return () !> "ADD"; setData $ Backtrack mwit  ( (back,  k):   unsafeCoerce bs)
+           setData $  Backtrack b  ( (back,  k):   unsafeCoerce bs)
+        Just (Backtrack b []) -> setData $ Backtrack b  [(back , k)]
+        Nothing ->  do
+           setData $ Backtrack mwit  [  (back , k)] !> "NOTHING"
+   ac
+  
+   where
+
+
+   typeof :: (b -> Fiber a) -> b
+   typeof = undefined
+   mwit= Nothing `asTypeOf` (Just $ typeof back)
+   addr x = liftIO $ return . hashStableName =<< (makeStableName $! x)
+
+
+-- registerUndo :: Fiber a -> Fiber a
+-- registerUndo f= registerBack ()  f
+
+-- XXX Should we enforce retry of the same track which is being undone? If the
+-- user specifies a different track would it make sense?
+--
+-- | For a given undo track id, stop executing more backtracking actions and
+-- resume normal execution in the forward direction. Used inside an undo
+-- action.
+--
+forward :: (Typeable b, Show b) => b -> Fiber ()
+forward reason=  do
+    Backtrack _ stack <- getData `onNothing`  (backStateOf reason)
+    setData $ Backtrack(Nothing `asTypeOf` Just reason)  stack
+
+
+
+
+
+
+-- | Start the undo process for the given undo track id. Performs all the undo
+-- actions registered till now in reverse order. An undo action can use
+-- 'forward' to stop the undo process and resume forward execution. If there
+-- are no more undo actions registered execution stops and a 'stop' action is
+-- returned.
+--
+back :: (Typeable b, Show b) => b -> Fiber a
+back reason = do
+  Backtrack _ cs <- getData  `onNothing`  backStateOf  reason
+  let  bs= Backtrack (Just reason) cs
+  setData bs
+  goBackt bs           
+                                                    !>"GOBACK"
+
+  where
+
+  goBackt (Backtrack _ [] )= empty                       !> "END"
+  goBackt (Backtrack Nothing _ )= error "goback: no reason"
+
+  goBackt (Backtrack (Just reason) ((handler,cont) : bs))= do
+        
+        -- setData $ Backtrack (Just reason) $ tail stack
+        -- unsafeCoerce $ first reason !>  "GOBACK2"
+        x <- unsafeCoerce handler reason                                        -- !> ("RUNCLOSURE",length stack)
+
+        Backtrack mreason _ <- getData `onNothing`  backStateOf  reason
+        -- setData $ Backtrack mreason bs
+        --                                                          -- !> "END RUNCLOSURE"
+
+        -- case mr of
+        --    Nothing -> return empty                                     --  !> "END EXECUTION"
+        case mreason of
+                  Nothing    -> do 
+                         --setData $ Backtrack Nothing bs
+                         unsafeCoerce $ cont x                          !> "FORWARD EXEC"
+                  justreason -> do
+                        setData $ Backtrack justreason bs
+                        goBackt $ Backtrack justreason bs              !> ("BACK AGAIN")
+                        empty
+
+backStateOf :: (Monad m, Show a, Typeable a) => a -> m (Backtrack a)
+backStateOf reason= return $ Backtrack (Nothing `asTypeOf` (Just reason)) []
+
+
+
+------ exceptions ---
+--
+-- | Install an exception handler. Handlers are executed in reverse (i.e. last in, first out) order when such exception happens in the
+-- continuation. Note that multiple handlers can be installed for the same exception type.
+--
+-- The semantic is thus very different than the one of `Control.Exception.Base.onException`
+onException :: Exception e => (e -> Fiber  ()) -> Fiber ()
+onException exc= return () `onException'` exc
+
+
+onException' :: Exception e => Fiber a -> (e -> Fiber a) -> Fiber a
+onException' mx f= onAnyException mx $ \e ->
+    case fromException e of
+       Nothing -> return $ error "do nothing,this should not be evaluated"
+       Just e'  -> f e'
+  where
+  --onAnyException :: Fiber a -> (SomeException ->Fiber a) -> Fiber a
+  onAnyException mx f= ioexp `onBack` f
+    where 
+    ioexp = callCC $ \cont -> do
+       st <- get
+       ioexp' $ runTransState st (mx >>=cont ) `catch` exceptBack st
+    
+    ioexp' mx= do
+      (mx,st') <- liftIO  mx
+      put st'
+      case mx of
+        Nothing -> empty 
+        Just x  -> return x
+  
+exceptBack st = \(e ::SomeException) -> do  -- recursive catch itself
+                      return () !> "CATCHHHHHHHHHHHHH" 
+                      runTransState st  (back e ) 
+                `catch` exceptBack st
+
+
+  
+
+-- | Delete all the exception handlers registered till now.
+cutExceptions :: Fiber ()
+cutExceptions= backCut  (undefined :: SomeException)
+
+-- | Use it inside an exception handler. it stop executing any further exception
+-- handlers and resume normal execution from this point on.
+continue :: Fiber ()
+continue = forward (undefined :: SomeException) !> "CONTINUE"
+
+-- | catch an exception in a Fiber block
+--
+-- The semantic is the same than `catch` but the computation and the exception handler can be multirhreaded
+-- catcht1 mx exc= mx' `onBack` exc
+--  where
+--  mx'= Fiber $ const $do
+--   st <- get
+--   (mx, st) <- liftIO $ runTransState st mx `catch` exceptBack st
+--   put st 
+--   return mx
+
+
+catcht :: Exception e => Fiber a -> (e -> Fiber a) -> Fiber a
+catcht mx exc= do
+      rpassed <- liftIO $ newIORef False
+      sandbox  $ do
+         delData $ Backtrack (Just (undefined :: SomeException))  [] 
+
+         r <- onException'  mx $ \e -> do
+                  passed <- liftIO $ readIORef rpassed
+                  if not passed then unsafeCoerce continue >> exc e  else empty
+         liftIO $ writeIORef rpassed True
+         return r
+         
+   where
+   sandbox :: Fiber a -> Fiber a
+   sandbox  mx= do
+     exState <- getData `onNothing` backStateOf (undefined :: SomeException)
+     mx   <*** setState exState 
+
+-- | throw an exception in the Fiber monad
+throwt :: Exception e => e -> Fiber a
+throwt= back . toException
+
+
+-- * Extensible State: Session Data Management
+
+-- | Same as 'getSData' but with a more general type. If the data is found, a
+-- 'Just' value is returned. Otherwise, a 'Nothing' value is returned.
+getData :: (MonadState EventF m, Typeable a) => m (Maybe a)
+getData = resp
+  where resp = do
+          list <- gets mfData
+          case M.lookup (typeOf $ typeResp resp) list of
+            Just x  -> return . Just $ unsafeCoerce x
+            Nothing -> return Nothing
+        typeResp :: m (Maybe x) -> x
+        typeResp = undefined
+
+-- | Retrieve a previously stored data item of the given data type from the
+-- monad state. The data type to retrieve is implicitly determined from the
+-- requested type context.
+-- If the data item is not found, an 'empty' value (a void event) is returned.
+-- Remember that an empty value stops the monad computation. If you want to
+-- print an error message or a default value in that case, you can use an
+-- 'Alternative' composition. For example:
+--
+-- > getSData <|> error "no data"
+-- > getInt = getSData <|> return (0 :: Int)
+getSData :: Typeable a => Fiber a
+getSData =   Fiber $ const  $ do
+        mx <- getData
+        case mx of
+          Nothing -> empty
+          Just x  -> return x
+
+-- | Same as `getSData`
+getState :: Typeable a => Fiber a
+getState = getSData
+
+-- | 'setData' stores a data item in the monad state which can be retrieved
+-- later using 'getData' or 'getSData'. Stored data items are keyed by their
+-- data type, and therefore only one item of a given type can be stored. A
+-- newtype wrapper can be used to distinguish two data items of the same type.
+--
+-- @
+-- import Control.Monad.IO.Class (liftIO)
+-- import Fiber.Base
+-- import Data.Typeable
+--
+-- data Person = Person
+--    { name :: String
+--    , age :: Int
+--    } deriving Typeable
+--
+-- test = keep $ do
+--      setData $ Person "Alberto"  55
+--      Person name age <- getSData
+--      liftIO $ print (name, age)
+-- @
+setData :: (MonadState EventF m, Typeable a) => a -> m ()
+setData x = modify $ \st -> st { mfData = M.insert t (unsafeCoerce x) (mfData st) }
+  where t = typeOf x
+
+-- | Accepts a function that takes the current value of the stored data type
+-- and returns the modified value. If the function returns 'Nothing' the value
+-- is deleted otherwise updated.
+modifyData :: (MonadState EventF m, Typeable a) => (Maybe a -> Maybe a) -> m ()
+modifyData f = modify $ \st -> st { mfData = M.alter alterf t (mfData st) }
+  where typeResp :: (Maybe a -> b) -> a
+        typeResp   = undefined
+        t          = typeOf (typeResp f)
+        alterf mx  = unsafeCoerce $ f x'
+          where x' = case mx of
+                       Just x  -> Just $ unsafeCoerce x
+                       Nothing -> Nothing
+
+-- | Same as modifyData
+modifyState :: (MonadState EventF m, Typeable a) => (Maybe a -> Maybe a) -> m ()
+modifyState = modifyData
+
+-- | Same as 'setData'
+setState :: (MonadState EventF m, Typeable a) => a -> m ()
+setState = setData
+
+-- | Delete the data item of the given type from the monad state.
+delData :: (MonadState EventF m, Typeable a) => a -> m ()
+delData x = modify $ \st -> st { mfData = M.delete (typeOf x) (mfData st) }
+
+-- | Same as 'delData'
+delState :: (MonadState EventF m, Typeable a) => a -> m ()
+delState = delData
+
+
+-- STRefs for the Fiber monad
+-}
+
+-- | If the first parameter is 'Nothing' return the second parameter otherwise
+-- return the first parameter..
+onNothing :: Monad m => m (Maybe b) -> m b -> m b
+onNothing iox iox'= do
+       mx <- iox
+       case mx of
+           Just x -> return x
+           Nothing -> iox'
+
+
+-- testBack = do
+
+--    runFiber $ do
+--         return () !> "before"
+--         r <-  async (print "hello")  `onBack` \s ->  liftIO $ print $ "received: 111"++ s 
+--         r <-  async (print "world")  `onBack` \s ->  liftIO $ print $ "received: 222"++ s 
+
+--         back "exception"
+--         empty
+--    takeMVar no
+
+
+-- test1= do
+--    runFiber $ do
+--         return () !> "before"
+--         onException $ \(s :: SomeException) -> liftIO $  print $ "received: 111"++ show s 
+--         async $ print "$$$$$$$$$$$$"
+--         -- r <-  async (print "hello")  `onException'` \(s :: SomeException) -> liftIO $  print $ "received: 111"++ show s 
+--         -- r <-  async (print "world")  `onException'` \(s :: SomeException) -> liftIO $  print $ "received: 222"++ show s 
+--         liftIO $ print "AFTER"
+--         liftIO $ myThreadId >>= print
+
+--         error "exception"
+--    takeMVar no
+
+-- testCatch= do
+--    runFiber $ do
+--         async $ print "hello"
+--         error "error" 
+--         return ()
+--       `catcht` (\(e :: SomeException) -> liftIO $ print $ "RECEIVED " ++ show e)
+      
+--    takeMVar no
\ No newline at end of file
diff --git a/imaginary/fibers-new/src/Control/Concurrent/Fiber.o b/imaginary/fibers-new/src/Control/Concurrent/Fiber.o
new file mode 100644
index 0000000..12c405c
Binary files /dev/null and b/imaginary/fibers-new/src/Control/Concurrent/Fiber.o differ
diff --git a/imaginary/fibers-new/src/Control/Concurrent/Fiber/MVar.hs b/imaginary/fibers-new/src/Control/Concurrent/Fiber/MVar.hs
new file mode 100644
index 0000000..1e5485b
--- /dev/null
+++ b/imaginary/fibers-new/src/Control/Concurrent/Fiber/MVar.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE UnboxedTuples, MagicHash #-}
+module Control.Concurrent.Fiber.MVar
+  (MVar, takeMVar, putMVar)
+where
+
+import GHC.Base
+import Control.Concurrent.Fiber
+import Control.Monad.IO.Class
+import GHC.MVar (MVar(..))
+
+takeMVar :: MVar a -> Fiber a
+takeMVar (MVar m) = callCC go
+  where go k = do
+          mResult <- liftIO $ tryTake
+          case mResult of
+            Just a  -> k a
+            Nothing -> block >> go k
+
+        tryTake = IO $ \s ->
+          case tryTakeMVar# m s of
+            (# s', 0#, _ #) ->
+              case addMVarListener# m s' of
+                s'' -> (# s'', Nothing #)
+            (# s', _,  a #) ->
+              case awakenMVarListeners# m s' of
+                s'' -> (# s'', Just a #)
+
+putMVar :: MVar a -> a -> Fiber ()
+putMVar (MVar m) x = callCC go
+  where go k = do
+          success <- liftIO $ tryPut
+          if success
+          then k ()
+          else block >> go k
+
+        tryPut = IO $ \s ->
+          case tryPutMVar# m x s of
+            (# s', 0# #) ->
+              case addMVarListener# m s' of
+                s'' -> (# s'', False #)
+            (# s', _  #) ->
+              case awakenMVarListeners# m s' of
+                s'' -> (# s'', True #)
+
+ 
+
+foreign import prim "eta.fibers.PrimOps.addMVarListener"
+  addMVarListener# :: MVar# s a -> State# s -> State# s
+
+foreign import prim "eta.fibers.PrimOps.awakenMVarListeners"
+  awakenMVarListeners# :: MVar# s a -> State# s -> State# s
diff --git a/imaginary/fibers-new/src/Control/Concurrent/Fiber/desktop.ini b/imaginary/fibers-new/src/Control/Concurrent/Fiber/desktop.ini
new file mode 100644
index 0000000..f63c1a5
--- /dev/null
+++ b/imaginary/fibers-new/src/Control/Concurrent/Fiber/desktop.ini
@@ -0,0 +1,5 @@
+[.ShellClassInfo]
+InfoTip=Esta carpeta se ha compartido online.
+IconFile=C:\Program Files (x86)\Google\Drive\googledrivesync.exe
+IconIndex=16
+    
\ No newline at end of file
diff --git a/imaginary/fibers-new/src/Control/Concurrent/Fiber2.hs b/imaginary/fibers-new/src/Control/Concurrent/Fiber2.hs
new file mode 100644
index 0000000..02d5b73
--- /dev/null
+++ b/imaginary/fibers-new/src/Control/Concurrent/Fiber2.hs
@@ -0,0 +1,708 @@
+{-# LANGUAGE MultiParamTypeClasses, ExistentialQuantification, ScopedTypeVariables, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
+module Control.Concurrent.Fiber where
+import Control.Applicative
+import Control.Monad.IO.Class
+import Control.Monad.Trans
+import GHC.Conc
+import System.IO.Unsafe
+import Data.IORef
+import Control.Concurrent.MVar
+import qualified Data.Map as M 
+import Data.Typeable
+import qualified Data.ByteString.Char8 as BS
+import Control.Monad.State 
+import Data.Monoid
+import Unsafe.Coerce
+import System.Mem.StableName
+import Control.Exception hiding (onException)
+
+import Debug.Trace
+x !> y=  trace (show y) x
+infixr 0 !>
+
+
+type SData= ()
+
+data LifeCycle = Alive | Parent | Listener | Dead
+  deriving (Eq, Show)
+
+-- | EventF describes the context of a TransientIO computation:
+data EventF = EventF
+  { mfData      :: M.Map TypeRep SData
+    -- ^ State data accessed with get or put operations
+  , mfSequence  :: Int
+  , threadId    :: ThreadId
+  , freeTh      :: Bool
+    -- ^ When 'True', threads are not killed using kill primitives
+
+  , parent      :: Maybe EventF
+    -- ^ The parent of this thread
+
+  , children    :: MVar [EventF]
+    -- ^ Forked child threads, used only when 'freeTh' is 'False'
+
+  , maxThread   :: Maybe (IORef Int)
+    -- ^ Maximum number of threads that are allowed to be created
+
+  , labelth     :: IORef (LifeCycle, BS.ByteString)
+    -- ^ Label the thread with its lifecycle state and a label string
+  , emptyOut    :: Bool
+  } deriving Typeable
+
+-- Type coercion is necessary because continuations can only be modeled fully within Indexed monads. 
+-- See paper P. Wadler "Monads and composable continuations" 
+-- The symtom of that problem in the typical continaution monad is an extra parameter r that complicates reasoning
+-- This monad eliminates the extra parameter by coercing types since, by construction, the contination parameter is of the
+--  type of the result of the first term of the bind.
+ety :: a -> b 
+ety=   dontWorryEverithingisOk
+tdyn :: a -> Dyn
+tdyn=  dontWorryEverithingisOk
+fdyn :: Dyn -> a
+fdyn = dontWorryEverithingisOk
+
+dontWorryEverithingisOk= unsafeCoerce
+
+type Dyn= ()
+
+data Cont m a = Cont { runCont :: (Dyn -> m a) -> m a }
+
+    
+
+
+
+type StateIO = StateT EventF IO
+
+type Fiber  = Cont  StateIO 
+
+instance   Monad Fiber  where
+    return  = pure
+    m >>= k  = Cont $ \c -> ety $ runCont m (\x -> ety $ runCont ( k $ fdyn x) c)
+
+
+instance MonadState  EventF Fiber where
+    get= lift get
+    put= lift . put
+
+instance MonadTrans Cont where
+    lift m = Cont ((unsafeCoerce m) >>=)
+
+instance MonadIO Fiber  where
+    liftIO = lift . liftIO
+
+callCC :: ((a -> Cont  m b) -> Cont  m a) -> Cont  m a
+callCC f = Cont $ \ c -> runCont (f (\ x -> Cont $ \ _ ->  ety $ c $ tdyn x)) c
+
+
+
+instance Functor (Cont  m) where
+    fmap f m = Cont $ \c -> ety $ runCont m $ \ x->   ety c $ f $ fdyn x
+                 
+instance Monoid a => Monoid (Fiber a) where
+    mappend x y = mappend <$> x <*> y
+    mempty      = return mempty
+
+instance Applicative Fiber  where
+    pure a  = Cont ($  tdyn a)
+    --f <*> v = ety $ Cont $ \ k -> ety $ runCont f $ \ g -> ety $ runCont v $ \t -> k $ (ety g) t
+    f <*> v =   do
+          r1 <- liftIO $ newIORef Nothing
+          r2 <- liftIO $ newIORef Nothing
+          (fparallel r1 r2)  <|> (vparallel  r1 r2)
+      where
+
+      fparallel :: IORef (Maybe(a -> b)) -> IORef (Maybe a) -> Fiber b 
+      fparallel r1 r2= ety $ Cont $ \k  -> 
+          runCont f $ \g -> do
+                (liftIO $ writeIORef r1  $ Just (fdyn  g)) !> "f write r1"
+                mt <- liftIO $ readIORef r2  !> "f read r2"
+                case mt of 
+                  Just t -> k $ (fdyn g) t
+                  Nothing -> get >>= liftIO . throw . Empty 
+                  
+      vparallel :: IORef (Maybe(a -> b)) -> IORef (Maybe a) -> Fiber b
+      vparallel  r1 r2=  ety $ Cont $ \k  ->  
+          runCont v $ \t ->  do
+                 (liftIO $ writeIORef r2 $ Just (fdyn t)) !> "v write r2"
+                 mg <- liftIO $ readIORef r1 !> "v read r1"
+                 case mg of 
+                   Nothing -> get >>= liftIO . throw . Empty  
+                   Just g ->  k $ (ety g) t 
+
+
+
+newtype Empty= Empty EventF deriving Typeable
+instance Show Empty where show _= "Empty"
+instance Exception Empty
+
+instance  Alternative Fiber where
+
+    empty= get >>= liftIO . throw . Empty 
+    f <|> g= callCC $ \k -> do
+        --  st <- get
+        --  (x,st') <-  liftIO (runFiberState st f `catch` (\(Empty st) -> runFiberState st (g >>= k) ))   
+        --  -- liftIO $ io st f k  `catch` (\(Empty st') -> io st' g k)
+        --  put st'
+        --  k x
+
+         st <- get
+         let io st f cont= runFiberState st  (f >>= cont' ) 
+                 where cont' x= do modify $ \st ->st{emptyOut=True} ; cont x
+         (x,st') <- liftIO $ io st f k `catch` \(Empty st') -> do
+                      let c =  emptyOut  st'
+                      when c $ throw (Empty st'{emptyOut=False}) 
+                      io st' g k
+         put st' 
+         k x   
+
+
+
+
+emptyEventF :: ThreadId -> IORef (LifeCycle, BS.ByteString) -> MVar [EventF] -> EventF
+emptyEventF th label childs =
+  EventF { mfData     = mempty
+         , mfSequence = 0
+         , threadId   = th
+         , freeTh     = False
+         , parent     = Nothing
+         , children   = childs
+         , maxThread  = Nothing
+         , labelth    = label
+         , emptyOut   = False }
+
+
+-- | Run a transient computation with a default initial state
+runFiber :: Fiber a -> IO ( a, EventF)
+-- runFiber :: Cont r (StateT EventF IO) r -> IO (Maybe r, EventF)
+runFiber t = do
+    th     <- myThreadId
+    label  <- newIORef $ (Alive, BS.pack "top")
+    childs <- newMVar []
+    runFiberState (emptyEventF th label childs) t
+
+runFiberState :: EventF -> Fiber  a ->  IO ( a, EventF)
+runFiberState st t= runStateT  (runTrans t) st 
+  where  
+  runTrans :: Fiber a -> StateIO  a
+  runTrans t=   runCont  t  (return . ety id )
+  
+inputLoop= getLine >>= \l -> atomically (writeTVar mvline l)  >> inputLoop
+
+no = unsafePerformIO newEmptyMVar
+
+mvline= unsafePerformIO $  newTVarIO ""
+
+option :: String -> Fiber  String
+--option :: [Char] -> Cont r (StateT t IO) [Char]
+option s = waitEvents . atomically $ do
+              x <- readTVar mvline
+              if  x== s then  writeTVar mvline "" >> return s else GHC.Conc.retry               
+
+-- callCC :: ((a -> Cont r StateIO b) -> Cont r m a) -> Cont r m a
+
+async :: IO a -> Fiber a 
+async io= callCC $ \ret -> do
+            st <-  get
+            liftIO $ forkIO $ runFiberState st ( liftIO io >>= ret ) >> return () 
+            empty 
+
+waitEvents :: IO a -> Fiber a
+--waitEvents :: IO a -> Cont a (StateIO) a
+waitEvents io= callCC $ \ret -> do
+    st <- get 
+    loop ret st 
+    where
+    loop ret st=  do
+            liftIO $ forkIO $ do 
+                      runFiberState st  (liftIO io >>=  ret  >> loop ret st)
+                      return () 
+            empty
+
+
+
+ 
+        
+        
+
+
+   
+   
+class AdditionalOperators m where
+
+  -- | Run @m a@ discarding its result before running @m b@.
+  (**>)  :: m a -> m b -> m b
+
+  -- | Run @m b@ discarding its result, after the whole task set @m a@ is
+  -- done.
+  (<**)  :: m a -> m b -> m a
+
+  atEnd' :: m a -> m b -> m a
+  atEnd' = (<**)
+
+  -- | Run @m b@ discarding its result, once after each task in @m a@, and
+  -- every time that an event happens in @m a@
+  (<***) :: m a -> m b -> m a
+
+  atEnd  :: m a -> m b -> m a
+  atEnd  = (<***)
+
+instance AdditionalOperators (Cont StateIO)  where
+
+  -- (**>) :: Fiber a -> Fiber b -> Fiber b
+  (**>) f g =  Cont $ \c -> ety $ runCont f (\x -> ety $ runCont  g c)
+      
+
+  -- (<***) :: Fiber a -> Fiber b -> Fiber a
+  (<***) f g = 
+      ety $ Cont $ \k -> ety $ runCont f $ \x ->  ety $ runCont g  (\_ -> k x)   
+      where 
+      f' = callCC $ \c -> g >> c ()
+
+  -- (<**) :: Fiber a -> Fiber b -> Fiber a
+  (<**) f g = ety $ Cont $ \k -> ety $ runCont f $ \x ->  ety $ runCont g  (\_ -> k x)  
+--f >>= g   = Cont $ \k ->  runCont f $ \x -> ety $ runCont ( g $ unsafeCoerce x) k
+  
+
+infixr 1 <***, <**, **>   
+
+
+react 
+  :: ((eventdata ->  IO response) -> IO ())
+  -> IO  response
+  -> Fiber eventdata
+react setHandler iob= callCC $ \ret -> do
+            st <- get
+            liftIO $ setHandler $  \x ->  (runFiberState st $ ret x) >> iob
+            empty
+
+reactOption :: String -> Fiber String
+reactOption s = do 
+         x <- react (setCallback s) (return ())
+         if  x /= s then empty else do 
+               return s
+  
+
+reactLoop =  do
+          x   <- getLine -- atomically $ readTVar mvline
+          mbs <- readIORef rcb
+          --foldr (<|>) empty $ map (\cb -> cb x) mbs
+          mapM (\(n,cb) -> cb x `catch` \(Empty _) -> return())  mbs
+          reactLoop
+
+rcb= unsafePerformIO $ newIORef [] 
+
+setCallback :: String -> (String ->  IO ()) -> IO ()
+setCallback name cb= atomicModifyIORef rcb $ \cbs ->  (reverse $ (name,cb) : cbs,())
+
+delCallback name= atomicModifyIORef rcb $ \cbs -> (filter ((/=) name . fst ) cbs,())
+
+
+----------------------------------backtracking ------------------------
+
+
+data Backtrack b= forall a r c. Backtrack{backtracking :: Maybe b
+                                     ,backStack :: [(b ->Fiber  c,c -> Fiber  a)] }
+                                     deriving Typeable
+
+
+
+-- | Delete all the undo actions registered till now for the given track id.
+-- backCut :: (Typeable b, Show b) => b -> Fiber ()
+backCut reason=
+     delData $ Backtrack (Just reason)  [] 
+
+-- | 'backCut' for the default track; equivalent to @backCut ()@.
+undoCut ::  Fiber ()
+undoCut = backCut ()
+
+-- | Run the action in the first parameter and register the second parameter as
+-- the undo action. On undo ('back') the second parameter is called with the
+-- undo track id as argument.
+--
+{-# NOINLINE onBack #-}
+onBack :: (Typeable b, Show b) => Fiber a -> ( b -> Fiber a) -> Fiber a
+onBack ac back =  do
+     -- Backtrack mreason _  <- getData `onNothing` backStateOf (typeof bac) !> "HANDLER1"
+    -- r <-ac
+    --  case mreason  !> ("mreason",mreason) of
+    --               Nothing     -> ac
+    --               Just reason -> bac reason
+     registerBack  ac back
+  
+   where
+         
+   typeof :: (b -> Fiber a) -> b
+   typeof = undefined
+
+-- | 'onBack' for the default track; equivalent to @onBack ()@.
+onUndo ::  Fiber a -> Fiber a -> Fiber a
+onUndo x y= onBack x (\() -> y)
+
+
+
+-- | Register an undo action to be executed when backtracking. The first
+-- parameter is a "witness" whose data type is used to uniquely identify this
+-- backtracking action. The value of the witness parameter is not used.
+--
+--{-# NOINLINE registerUndo #-}
+-- registerBack :: (Typeable a, Show a) => (a -> Fiber a) -> a -> Fiber a
+registerBack  ac back = callCC $ \k -> do
+   md <- getData `asTypeOf` (Just <$> (backStateOf $ typeof back))  !> "HANDLER"
+   case md of
+        Just (bss@(Backtrack b (bs@((back',_):_)))) ->
+          --  when (isNothing b) $ do
+          --      addrx  <- addr back'
+          --      addrx' <- addr back        -- to avoid duplicate backtracking points
+          --      when (addrx /= addrx') $ do return () !> "ADD"; setData $ Backtrack mwit  ( (back,  k):   unsafeCoerce bs)
+           setData $  Backtrack b  ( (back,  k):   unsafeCoerce bs)
+        Just (Backtrack b []) -> setData $ Backtrack b  [(back , k)]
+        Nothing ->  do
+           setData $ Backtrack mwit  [  (back , k)] !> "NOTHING"
+   ac
+  
+   where
+
+
+   typeof :: (b -> Fiber a) -> b
+   typeof = undefined
+   mwit= Nothing `asTypeOf` (Just $ typeof back)
+   addr x = liftIO $ return . hashStableName =<< (makeStableName $! x)
+
+
+-- registerUndo :: Fiber a -> Fiber a
+-- registerUndo f= registerBack ()  f
+
+-- XXX Should we enforce retry of the same track which is being undone? If the
+-- user specifies a different track would it make sense?
+--
+-- | For a given undo track id, stop executing more backtracking actions and
+-- resume normal execution in the forward direction. Used inside an undo
+-- action.
+--
+forward :: (Typeable b, Show b) => b -> Fiber ()
+forward reason=  do
+    Backtrack _ stack <- getData `onNothing`  (backStateOf reason)
+    setData $ Backtrack(Nothing `asTypeOf` Just reason)  stack
+
+
+
+
+
+
+-- | Start the undo process for the given undo track id. Performs all the undo
+-- actions registered till now in reverse order. An undo action can use
+-- 'forward' to stop the undo process and resume forward execution. If there
+-- are no more undo actions registered execution stops and a 'stop' action is
+-- returned.
+--
+back :: (Typeable b, Show b) => b -> Fiber a
+back reason = do
+  Backtrack _ cs <- getData  `onNothing`  backStateOf  reason
+  let  bs= Backtrack (Just reason) cs
+  setData bs
+  goBackt bs           
+                                                    !>"GOBACK"
+
+  where
+
+  goBackt (Backtrack _ [] )= empty                       !> "END"
+  goBackt (Backtrack Nothing _ )= error "goback: no reason"
+
+  goBackt (Backtrack (Just reason) ((handler,cont) : bs))= do
+        
+        -- setData $ Backtrack (Just reason) $ tail stack
+        -- unsafeCoerce $ first reason !>  "GOBACK2"
+        x <- unsafeCoerce handler reason                                        -- !> ("RUNCLOSURE",length stack)
+
+        Backtrack mreason _ <- getData `onNothing`  backStateOf  reason
+        -- setData $ Backtrack mreason bs
+        --                                                          -- !> "END RUNCLOSURE"
+
+        -- case mr of
+        --    Nothing -> return empty                                     --  !> "END EXECUTION"
+        case mreason of
+                  Nothing    -> do 
+                         --setData $ Backtrack Nothing bs
+                         unsafeCoerce $ cont x                          !> "FORWARD EXEC"
+                  justreason -> do
+                        setData $ Backtrack justreason bs
+                        goBackt $ Backtrack justreason bs              !> ("BACK AGAIN")
+                        empty
+
+backStateOf :: (Monad m, Show a, Typeable a) => a -> m (Backtrack a)
+backStateOf reason= return $ Backtrack (Nothing `asTypeOf` (Just reason)) []
+
+
+
+------ exceptions ---
+--
+-- | Install an exception handler. Handlers are executed in reverse (i.e. last in, first out) order when such exception happens in the
+-- continuation. Note that multiple handlers can be installed for the same exception type.
+--
+-- The semantic is thus very different than the one of `Control.Exception.Base.onException`
+onException :: Exception e => (e -> Fiber  ()) -> Fiber ()
+onException exc= return () `onException'` exc
+
+
+onException' :: Exception e => Fiber a -> (e -> Fiber a) -> Fiber a
+onException' mx f= onAnyException mx $ \e ->
+    case fromException e of
+       Nothing -> return $ error "do nothing,this should not be evaluated"
+       Just e'  -> f e'
+  where
+  --onAnyException :: Fiber a -> (SomeException ->Fiber a) -> Fiber a
+  onAnyException mx f= ioexp `onBack` f
+    where 
+    ioexp = callCC $ \cont -> do
+       st <- get
+       ioexp' $ runFiberState st (mx >>=cont ) `catch` exceptBack st
+    
+    ioexp' mx= do
+      (mx,st') <- liftIO  mx
+      put st'
+      case mx of
+        Nothing -> empty 
+        Just x  -> return x
+  
+exceptBack st = \(e ::SomeException) ->   -- recursive catch itself
+                      runFiberState st  (back e ) 
+                `catch` exceptBack st
+
+
+  
+
+-- | Delete all the exception handlers registered till now.
+cutExceptions :: Fiber ()
+cutExceptions= backCut  (undefined :: SomeException)
+
+-- | Use it inside an exception handler. it stop executing any further exception
+-- handlers and resume normal execution from this point on.
+continue :: Fiber ()
+continue = forward (undefined :: SomeException) !> "CONTINUE"
+
+-- | catch an exception in a Cont block
+--
+-- The semantic is the same than `catch` but the computation and the exception handler can be multirhreaded
+-- catcht1 mx exc= mx' `onBack` exc
+--  where
+--  mx'= Cont $ const $do
+--   st <- get
+--   (mx, st) <- liftIO $ runFiberState st mx `catch` exceptBack st
+--   put st 
+--   return mx
+
+
+catcht :: Exception e => Fiber a -> (e -> Fiber a) -> Fiber a
+catcht mx exc= do
+      rpassed <- liftIO $ newIORef False
+      sandbox  $ do
+         delData $ Backtrack (Just (undefined :: SomeException))  [] 
+
+         r <- onException'  mx $ \e -> do
+                  passed <- liftIO $ readIORef rpassed
+                  if not passed then unsafeCoerce continue >> exc e  else empty
+         liftIO $ writeIORef rpassed True
+         return r
+         
+   where
+   sandbox :: Fiber a -> Fiber a
+   sandbox  mx= do
+     exState <- getData `onNothing` backStateOf (undefined :: SomeException)
+     mx   <*** setState exState 
+
+-- | throw an exception in the Cont monad
+throwt :: Exception e => e -> Fiber a
+throwt= back . toException
+
+
+-- * Extensible State: Session Data Management
+
+-- | Same as 'getSData' but with a more general type. If the data is found, a
+-- 'Just' value is returned. Otherwise, a 'Nothing' value is returned.
+getData :: (MonadState EventF m, Typeable a) => m (Maybe a)
+getData = resp
+  where resp = do
+          list <- gets mfData
+          case M.lookup (typeOf $ typeResp resp) list of
+            Just x  -> return . Just $ unsafeCoerce x
+            Nothing -> return Nothing
+        typeResp :: m (Maybe x) -> x
+        typeResp = undefined
+
+-- | Retrieve a previously stored data item of the given data type from the
+-- monad state. The data type to retrieve is implicitly determined from the
+-- requested type context.
+-- If the data item is not found, an 'empty' value (a void event) is returned.
+-- Remember that an empty value stops the monad computation. If you want to
+-- print an error message or a default value in that case, you can use an
+-- 'Alternative' composition. For example:
+--
+-- > getSData <|> error "no data"
+-- > getInt = getSData <|> return (0 :: Int)
+getSData :: Typeable a => Fiber a
+getSData =   Cont $ const  $ do
+        mx <- getData
+        case mx of
+          Nothing -> empty
+          Just x  -> return x
+
+-- | Same as `getSData`
+getState :: Typeable a => Fiber a
+getState = getSData
+
+-- | 'setData' stores a data item in the monad state which can be retrieved
+-- later using 'getData' or 'getSData'. Stored data items are keyed by their
+-- data type, and therefore only one item of a given type can be stored. A
+-- newtype wrapper can be used to distinguish two data items of the same type.
+--
+-- @
+-- import Control.Monad.IO.Class (liftIO)
+-- import Cont.Base
+-- import Data.Typeable
+--
+-- data Person = Person
+--    { name :: String
+--    , age :: Int
+--    } deriving Typeable
+--
+-- main = keep $ do
+--      setData $ Person "Alberto"  55
+--      Person name age <- getSData
+--      liftIO $ print (name, age)
+-- @
+setData :: (MonadState EventF m, Typeable a) => a -> m ()
+setData x = modify $ \st -> st { mfData = M.insert t (unsafeCoerce x) (mfData st) }
+  where t = typeOf x
+
+-- | Accepts a function that takes the current value of the stored data type
+-- and returns the modified value. If the function returns 'Nothing' the value
+-- is deleted otherwise updated.
+modifyData :: (MonadState EventF m, Typeable a) => (Maybe a -> Maybe a) -> m ()
+modifyData f = modify $ \st -> st { mfData = M.alter alterf t (mfData st) }
+  where typeResp :: (Maybe a -> b) -> a
+        typeResp   = undefined
+        t          = typeOf (typeResp f)
+        alterf mx  = unsafeCoerce $ f x'
+          where x' = case mx of
+                       Just x  -> Just $ unsafeCoerce x
+                       Nothing -> Nothing
+
+-- | Same as modifyData
+modifyState :: (MonadState EventF m, Typeable a) => (Maybe a -> Maybe a) -> m ()
+modifyState = modifyData
+
+-- | Same as 'setData'
+setState :: (MonadState EventF m, Typeable a) => a -> m ()
+setState = setData
+
+-- | Delete the data item of the given type from the monad state.
+delData :: (MonadState EventF m, Typeable a) => a -> m ()
+delData x = modify $ \st -> st { mfData = M.delete (typeOf x) (mfData st) }
+
+-- | Same as 'delData'
+delState :: (MonadState EventF m, Typeable a) => a -> m ()
+delState = delData
+
+
+-- STRefs for the Cont monad
+
+
+-- | If the first parameter is 'Nothing' return the second parameter otherwise
+-- return the first parameter..
+onNothing :: Monad m => m (Maybe b) -> m b -> m b
+onNothing iox iox'= do
+       mx <- iox
+       case mx of
+           Just x -> return x
+           Nothing -> iox'
+
+
+testBack = do
+
+   runFiber $ do
+        return () !> "before"
+        r <-  async (print "hello")  `onBack` \s ->  liftIO $ print $ "received: 111"++ s 
+        r <-  async (print "world")  `onBack` \s ->  liftIO $ print $ "received: 222"++ s 
+
+        back "exception"
+        empty
+   takeMVar no
+
+
+testException= do
+   runFiber $ do
+        return () !> "before"
+        onException $ \(s :: SomeException) -> liftIO $  print $ "received: 111"++ show s 
+        async $ print "$$$$$$$$$$$$"
+        -- r <-  async (print "hello")  `onException'` \(s :: SomeException) -> liftIO $  print $ "received: 111"++ show s 
+        -- r <-  async (print "world")  `onException'` \(s :: SomeException) -> liftIO $  print $ "received: 222"++ show s 
+        liftIO $ print "AFTER"
+        liftIO $ myThreadId >>= print
+
+        error "exception"
+   takeMVar no
+
+mainCatch= do
+   runFiber $ do
+        async $ print "hello"
+        error "error" 
+        return ()
+      `catcht` (\(e :: SomeException) -> liftIO $ print $ "RECEIVED " ++ show e)
+      
+   takeMVar no
+
+
+   
+
+callCCTest= runFiber $ do
+  r  <- return 2
+  r' <- liftIO $ return $ r +5
+  r2 <- callCC $ \ret -> do 
+     ret  100
+     liftIO  $ print "HELLO"
+     return 1
+  liftIO $ print $ r2
+  liftIO $ print $ "world3"
+
+
+testAlternative= keep $ do 
+     r <- async (return "hello") <|> async (return "world") <|> async (return "world2")
+     liftIO $ print r
+
+mainReact =  do
+      -- forkIO inputLoop
+       forkIO reactLoop
+       keep $ do
+            r <-  (reactOption "hello")  <|>  (reactOption "world")
+            liftIO $ print r
+
+main3= keep $ do
+    -- r<- async ( return "hello") <***  liftIO (print "world")
+    r <-  ( async (threadDelay 10000 >> return "hello ")  <>  return "world"     )  <|> return "world2"
+    -- r <- Cont $ \c -> runCont  (return "hello") c
+    liftIO $ putStrLn  r
+
+mexit= unsafePerformIO $ newEmptyMVar  
+keep mx= do
+   forkIO $( runFiber mx  >> return ()) `catch` \(Empty _) -> return ()
+   takeMVar mexit   
+   
+options=do
+   forkIO $ inputLoop
+   keep $ do 
+    r <- option "hello"  <|> option "world" 
+    liftIO $ print r 
+
+main= testAlternative 
+
+looptest= runFiber $ do
+    setState "hello"
+    r <- liftIO $ newIORef 0
+    sum  r 1000000
+    s <-   getState 
+    liftIO $ putStrLn s
+  where
+  sum r 0= do r <- liftIO $ readIORef r; liftIO $ print r
+  sum r x= do
+     liftIO $ modifyIORef r $ \v -> v + x 
+     sum r $x -1 
\ No newline at end of file
diff --git a/imaginary/fibers-new/src/Control/Concurrent/desktop.ini b/imaginary/fibers-new/src/Control/Concurrent/desktop.ini
new file mode 100644
index 0000000..f63c1a5
--- /dev/null
+++ b/imaginary/fibers-new/src/Control/Concurrent/desktop.ini
@@ -0,0 +1,5 @@
+[.ShellClassInfo]
+InfoTip=Esta carpeta se ha compartido online.
+IconFile=C:\Program Files (x86)\Google\Drive\googledrivesync.exe
+IconIndex=16
+    
\ No newline at end of file
diff --git a/imaginary/fibers-new/src/Control/desktop.ini b/imaginary/fibers-new/src/Control/desktop.ini
new file mode 100644
index 0000000..f63c1a5
--- /dev/null
+++ b/imaginary/fibers-new/src/Control/desktop.ini
@@ -0,0 +1,5 @@
+[.ShellClassInfo]
+InfoTip=Esta carpeta se ha compartido online.
+IconFile=C:\Program Files (x86)\Google\Drive\googledrivesync.exe
+IconIndex=16
+    
\ No newline at end of file
diff --git a/imaginary/fibers-new/src/desktop.ini b/imaginary/fibers-new/src/desktop.ini
new file mode 100644
index 0000000..f63c1a5
--- /dev/null
+++ b/imaginary/fibers-new/src/desktop.ini
@@ -0,0 +1,5 @@
+[.ShellClassInfo]
+InfoTip=Esta carpeta se ha compartido online.
+IconFile=C:\Program Files (x86)\Google\Drive\googledrivesync.exe
+IconIndex=16
+    
\ No newline at end of file