@@ -18,6 +18,7 @@ import Numeric
1818import Data.List
1919import Data.Maybe
2020import Data.Word
21+import Data.Traversable
2122import System.IO
2223import System.Directory
2324
@@ -345,23 +346,41 @@ collectSplitFunctions (fun, splits) = map generateSplitFunction splits ++ [fun]
345346 JSAlloc (name ++ "$" ++ show depth) fun
346347
347348splitFunction :: JS -> RWS () [(Int,JS)] Int JS
348−splitFunction (JSAlloc name (Just (JSFunction args body))) = do
349− b <- splitSequence body
350− return $ JSAlloc name (Just (JSFunction args b))
349+splitFunction (JSAlloc name (Just (JSFunction args body@(JSSeq _)))) = do
350+ body' <- splitSequence body
351+ return $ JSAlloc name (Just (JSFunction args body'))
351352 where
353+ splitCondition :: JS -> RWS () [(Int,JS)] Int JS
354+ splitCondition js
355+ | JSCond branches <- js =
356+ JSCond <$> processBranches branches
357+ | JSSwitch cond branches def <- js =
358+ JSSwitch cond <$> (processBranches branches) <*> (traverse splitSequence def)
359+ | otherwise = return js
360+ where
361+ processBranches :: [(JS,JS)] -> RWS () [(Int,JS)] Int [(JS,JS)]
362+ processBranches =
363+ traverse (runKleisli (arr id *** (Kleisli splitSequence)))
364+
365+ splitCondition js = return js
366+
352367 splitSequence :: JS -> RWS () [(Int, JS)] Int JS
353368 splitSequence js@(JSSeq seq) = do
354369 let (pre,post) = break isCall seq in
355370 case post of
356− [] -> return js
357− [_] -> return js
371+ [] -> JSSeq <$> traverse splitCondition seq
372+ [js@(JSCond _)] -> splitCondition js
373+ [js@(JSSwitch _ _ _)] -> splitCondition js
374+ [_] -> return js
358375 (call:rest) -> do
359376 depth <- get
360377 put (depth + 1)
361378 new <- splitFunction (newFun rest)
362379 tell [(depth, new)]
363380 {-return $ JSSeq (pre ++ [newCall depth, call])-}
364− return $ JSSeq (pre ++ [call, newCall depth])
381+ return $ JSSeq (pre ++ (call : [newCall depth]))
382+
383+ splitSequence js = return js
365384
366385 isCall :: JS -> Bool
367386 isCall (JSApp (JSIdent "i$CALL") _) = True
@@ -381,6 +400,7 @@ splitFunction (JSAlloc name (Just (JSFunction args body))) = do
381400 newFun seq =
382401 JSAlloc name (Just $ JSFunction ["vm", "oldbase", "myoldbase"] (JSSeq seq))
383402
403+splitFunction js = return js
384404
385405translateDecl :: CompileInfo -> (Name, [BC]) -> [JS]
386406translateDecl info (name@(MN 0 fun), bc)