-splice_head head g =
- check_single_exit g $
- let eid = head_id head
- splice_one_block tail' =
- case ht_to_last head tail' of
- (head, LastExit) -> (LGraph eid emptyBlockEnv, head)
- _ -> panic "spliced LGraph without exit"
- splice_many_blocks entry exit others =
- (LGraph eid (insertBlock (zipht head entry) others), exit)
- in prepare_for_splicing g splice_one_block splice_many_blocks
+prepare_for_splicing' ::
+ Graph m l -> (ZTail m l -> a) -> (ZTail m l -> ZHead m -> BlockEnv (Block m l) -> a)
+ -> a
+prepare_for_splicing' (Graph etail gblocks) single multi =
+ if isNullUFM gblocks then
+ case lastTail etail of
+ LastExit -> single etail
+ _ -> panic "bad single block"
+ else
+ case splitp_blocks is_exit gblocks of
+ Nothing -> panic "Can't find an exit block"
+ Just (gexit, gblocks) ->
+ let (gh, gl) = goto_end $ unzip gexit in
+ case gl of LastExit -> multi etail gh gblocks
+ _ -> panic "exit is not exit?!"
+
+is_exit :: Block m l -> Bool
+is_exit b = case last (unzip b) of { LastExit -> True; _ -> False }
+
+splice_head head g =
+ ASSERT (single_exit g) prepare_for_splicing g splice_one_block splice_many_blocks
+ where eid = head_id head
+ splice_one_block tail' =
+ case ht_to_last head tail' of
+ (head, LastExit) -> (LGraph eid emptyBlockEnv, head)
+ _ -> panic "spliced LGraph without exit"
+ splice_many_blocks entry exit others =
+ (LGraph eid (insertBlock (zipht head entry) others), exit)
+
+splice_head' head g =
+ ASSERT (single_exitg g) prepare_for_splicing' g splice_one_block splice_many_blocks
+ where splice_one_block tail' =
+ case ht_to_last head tail' of
+ (head, LastExit) -> (emptyBlockEnv, head)
+ _ -> panic "spliced LGraph without exit"
+ splice_many_blocks entry exit others =
+ (insertBlock (zipht head entry) others, exit)
+
+-- splice_tail :: Graph m l -> ZTail m l -> Graph m l
+splice_tail g tail =
+ ASSERT (single_exitg g) prepare_for_splicing' g splice_one_block splice_many_blocks
+ where splice_one_block tail' = Graph (tail' `append_tails` tail) emptyBlockEnv
+ append_tails (ZLast LastExit) tail = tail
+ append_tails (ZLast _) _ = panic "spliced single block without LastExit"
+ append_tails (ZTail m t) tail = ZTail m (append_tails t tail)
+ splice_many_blocks entry exit others =
+ Graph entry (insertBlock (zipht exit tail) others)