{-# LANGUAGE BangPatterns #-}-- This is a non-exposed internal module---- The code in this module has been ripped from containers-0.5.5.1:Data.Map.Base [1] almost-- verbatimely to avoid a dependency of 'template-haskell' on the containers package.---- [1] see https://hackage.haskell.org/package/containers-0.5.5.1---- The original code is BSD-licensed and copyrighted by Daan Leijen, Andriy Palamarchuk, et al.moduleLanguage.Haskell.TH.Lib.Map(Map ,empty ,insert ,Language.Haskell.TH.Lib.Map.lookup )wheredataMap k a =Bin {-# UNPACK#-}!Size !k a !(Map k a )!(Map k a )|Tip typeSize =Intempty::Map k a empty =Tip {-# INLINEempty#-}singleton::k ->a ->Map k a singleton k x =Bin 1k x Tip Tip {-# INLINEsingleton#-}size::Map k a ->Intsize Tip =0size(Bin sz ____)=sz {-# INLINEsize#-}lookup::Ordk =>k ->Map k a ->Maybea lookup =go wherego _Tip =Nothinggo!k (Bin _kx x l r )=casecomparek kx ofLT->go k l GT->go k r EQ->Justx {-# INLINABLElookup#-}insert::Ordk =>k ->a ->Map k a ->Map k a insert =go wherego::Ordk =>k ->a ->Map k a ->Map k a go !kx x Tip =singleton kx x go!kx x (Bin sz ky y l r )=casecomparekx ky ofLT->balanceL ky y (go kx x l )r GT->balanceR ky y l (go kx x r )EQ->Bin sz kx x l r {-# INLINABLEinsert#-}balanceL::k ->a ->Map k a ->Map k a ->Map k a balanceL k x l r =caser ofTip ->casel ofTip ->Bin 1k x Tip Tip (Bin ___Tip Tip )->Bin 2k x l Tip (Bin _lk lx Tip (Bin _lrk lrx __))->Bin 3lrk lrx (Bin 1lk lx Tip Tip )(Bin 1k x Tip Tip )(Bin _lk lx ll @(Bin _____)Tip )->Bin 3lk lx ll (Bin 1k x Tip Tip )(Bin ls lk lx ll @(Bin lls ____)lr @(Bin lrs lrk lrx lrl lrr ))|lrs <ratio *lls ->Bin (1+ls )lk lx ll (Bin (1+lrs )k x lr Tip )|otherwise->Bin (1+ls )lrk lrx (Bin (1+lls +size lrl )lk lx ll lrl )(Bin (1+size lrr )k x lrr Tip )(Bin rs ____)->casel ofTip ->Bin (1+rs )k x Tip r (Bin ls lk lx ll lr )|ls >delta *rs ->case(ll ,lr )of(Bin lls ____,Bin lrs lrk lrx lrl lrr )|lrs <ratio *lls ->Bin (1+ls +rs )lk lx ll (Bin (1+rs +lrs )k x lr r )|otherwise->Bin (1+ls +rs )lrk lrx (Bin (1+lls +size lrl )lk lx ll lrl )(Bin (1+rs +size lrr )k x lrr r )(_,_)->error"Failure in Data.Map.balanceL"|otherwise->Bin (1+ls +rs )k x l r {-# NOINLINEbalanceL#-}balanceR::k ->a ->Map k a ->Map k a ->Map k a balanceR k x l r =casel ofTip ->caser ofTip ->Bin 1k x Tip Tip (Bin ___Tip Tip )->Bin 2k x Tip r (Bin _rk rx Tip rr @(Bin _____))->Bin 3rk rx (Bin 1k x Tip Tip )rr (Bin _rk rx (Bin _rlk rlx __)Tip )->Bin 3rlk rlx (Bin 1k x Tip Tip )(Bin 1rk rx Tip Tip )(Bin rs rk rx rl @(Bin rls rlk rlx rll rlr )rr @(Bin rrs ____))|rls <ratio *rrs ->Bin (1+rs )rk rx (Bin (1+rls )k x Tip rl )rr |otherwise->Bin (1+rs )rlk rlx (Bin (1+size rll )k x Tip rll )(Bin (1+rrs +size rlr )rk rx rlr rr )(Bin ls ____)->caser ofTip ->Bin (1+ls )k x l Tip (Bin rs rk rx rl rr )|rs >delta *ls ->case(rl ,rr )of(Bin rls rlk rlx rll rlr ,Bin rrs ____)|rls <ratio *rrs ->Bin (1+ls +rs )rk rx (Bin (1+ls +rls )k x l rl )rr |otherwise->Bin (1+ls +rs )rlk rlx (Bin (1+ls +size rll )k x l rll )(Bin (1+rrs +size rlr )rk rx rlr rr )(_,_)->error"Failure in Data.Map.balanceR"|otherwise->Bin (1+ls +rs )k x l r {-# NOINLINEbalanceR#-}delta,ratio::Intdelta =3ratio =2