on master help sign in
Fix deintercalate, sepBy etc.
82843a9Harendra Kumar
core/src/Streamly/Internal/Data/Parser/ParserD.hs+45−60
@@ -2522,6 +2522,7 @@ lookAhead (Parser step1 initial1 _) = Parser step initial extract
2522-- all the three parsers. One parser can count the line numbers to provide the
2522-- all the three parsers. One parser can count the line numbers to provide the
2523-- line number info.
2523-- line number info.
2524
2524
2525+{-# ANN type DeintercalateAllState Fuse #-}
2525data DeintercalateAllState fs sp ss =
2526data DeintercalateAllState fs sp ss =
2526 DeintercalateAllInitL !fs
2527 DeintercalateAllInitL !fs
2527 | DeintercalateAllL !fs !sp
2528 | DeintercalateAllL !fs !sp
@@ -2570,7 +2571,7 @@ deintercalateAll
2570 initial = do
2571 initial = do
2571 res <- finitial
2572 res <- finitial
2572 case res of
2573 case res of
2573− FL.Partial fs -> return $ IPartial $ (DeintercalateAllInitL fs)
2574+ FL.Partial fs -> return $ IPartial $ DeintercalateAllInitL fs
2574 FL.Done c -> return $ IDone c
2575 FL.Done c -> return $ IDone c
2575
2576
2576 {-# INLINE processL #-}
2577 {-# INLINE processL #-}
@@ -2644,6 +2645,7 @@ deintercalateAll
2644 extract (DeintercalateAllR _ _) =
2645 extract (DeintercalateAllR _ _) =
2645 return $ Error "deintercalateAll: input ended at 'Right' value"
2646 return $ Error "deintercalateAll: input ended at 'Right' value"
2646
2647
2648+{-# ANN type DeintercalateState Fuse #-}
2647data DeintercalateState b fs sp ss =
2649data DeintercalateState b fs sp ss =
2648 DeintercalateInitL !fs
2650 DeintercalateInitL !fs
2649 | DeintercalateL !Int !fs !sp
2651 | DeintercalateL !Int !fs !sp
@@ -2651,6 +2653,10 @@ data DeintercalateState b fs sp ss =
2651 | DeintercalateR !Int !fs !ss
2653 | DeintercalateR !Int !fs !ss
2652 | DeintercalateRL !Int !b !fs !sp
2654 | DeintercalateRL !Int !b !fs !sp
2653
2655
2656+-- XXX Add tests that the next character that we take after running a parser is
2657+-- correct. Especially for the parsers that maintain a count. In the stream
2658+-- finished case (extract) as well as not finished case.
2659+
2654-- | Apply two parsers alternately to an input stream. The input stream is
2660-- | Apply two parsers alternately to an input stream. The input stream is
2655-- considered an interleaving of two patterns. The two parsers represent the
2661-- considered an interleaving of two patterns. The two parsers represent the
2656-- two patterns. Parsing starts at the first parser and stops at the first
2662-- two patterns. Parsing starts at the first parser and stops at the first
@@ -2689,7 +2695,7 @@ deintercalate
2689 initial = do
2695 initial = do
2690 res <- finitial
2696 res <- finitial
2691 case res of
2697 case res of
2692− FL.Partial fs -> return $ IPartial $ (DeintercalateInitL fs)
2698+ FL.Partial fs -> return $ IPartial $ DeintercalateInitL fs
2693 FL.Done c -> return $ IDone c
2699 FL.Done c -> return $ IDone c
2694
2700
2695 {-# INLINE processL #-}
2701 {-# INLINE processL #-}
@@ -2704,8 +2710,8 @@ deintercalate
2704 let cnt1 = cnt + 1
2710 let cnt1 = cnt + 1
2705 r <- stepL sL a
2711 r <- stepL sL a
2706 case r of
2712 case r of
2707− Partial n s -> return $ Continue n (DeintercalateL cnt1 fs s)
2713+ Partial n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)
2708− Continue n s -> return $ Continue n (DeintercalateL cnt1 fs s)
2714+ Continue n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)
2709 Done n b ->
2715 Done n b ->
2710 processL (fstep fs (Left b)) n DeintercalateInitR
2716 processL (fstep fs (Left b)) n DeintercalateInitR
2711 Error _ -> do
2717 Error _ -> do
@@ -2725,9 +2731,9 @@ deintercalate
2725 let cnt1 = cnt + 1
2731 let cnt1 = cnt + 1
2726 r <- stepR sR a
2732 r <- stepR sR a
2727 case r of
2733 case r of
2728− Partial n s -> return $ Continue n (DeintercalateR cnt1 fs s)
2734+ Partial n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)
2729− Continue n s -> return $ Continue n (DeintercalateR cnt1 fs s)
2735+ Continue n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)
2730− Done n b -> processR cnt1 b fs n
2736+ Done n b -> processR (cnt1 - n) b fs n
2731 Error _ -> do
2737 Error _ -> do
2732 xs <- fextract fs
2738 xs <- fextract fs
2733 return $ Done cnt1 xs
2739 return $ Done cnt1 xs
@@ -2750,8 +2756,8 @@ deintercalate
2750 let cnt1 = cnt + 1
2756 let cnt1 = cnt + 1
2751 r <- stepL sL a
2757 r <- stepL sL a
2752 case r of
2758 case r of
2753− Partial n s -> return $ Continue n (DeintercalateRL cnt1 bR fs s)
2759+ Partial n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)
2754− Continue n s -> return $ Continue n (DeintercalateRL cnt1 bR fs s)
2760+ Continue n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)
2755 Done n bL -> do
2761 Done n bL -> do
2756 res <- fstep fs (Right bR)
2762 res <- fstep fs (Right bR)
2757 case res of
2763 case res of
@@ -2779,7 +2785,7 @@ deintercalate
2779 r <- extractL sL
2785 r <- extractL sL
2780 case r of
2786 case r of
2781 Done n b -> extractResult n fs (Left b)
2787 Done n b -> extractResult n fs (Left b)
2782− Continue n s -> return $ Continue n (DeintercalateL cnt fs s)
2788+ Continue n s -> return $ Continue n (DeintercalateL (cnt - n) fs s)
2783 Partial _ _ -> error "Partial in extract"
2789 Partial _ _ -> error "Partial in extract"
2784 Error _ -> do
2790 Error _ -> do
2785 xs <- fextract fs
2791 xs <- fextract fs
@@ -2794,15 +2800,15 @@ deintercalate
2794 case res of
2800 case res of
2795 FL.Partial fs1 -> extractResult n fs1 (Left bL)
2801 FL.Partial fs1 -> extractResult n fs1 (Left bL)
2796 FL.Done _ -> error "Fold terminated consuming partial input"
2802 FL.Done _ -> error "Fold terminated consuming partial input"
2797− Continue n s -> return $ Continue n (DeintercalateRL cnt bR fs s)
2803+ Continue n s -> return $ Continue n (DeintercalateRL (cnt - n) bR fs s)
2798 Partial _ _ -> error "Partial in extract"
2804 Partial _ _ -> error "Partial in extract"
2799 Error _ -> do
2805 Error _ -> do
2800 xs <- fextract fs
2806 xs <- fextract fs
2801 return $ Done cnt xs
2807 return $ Done cnt xs
2802
2808
2809+{-# ANN type Deintercalate1State Fuse #-}
2803data Deintercalate1State b fs sp ss =
2810data Deintercalate1State b fs sp ss =
2804 Deintercalate1InitL !Int !fs !sp
2811 Deintercalate1InitL !Int !fs !sp
2805− | Deintercalate1L !Int !fs !sp
2806 | Deintercalate1InitR !fs
2812 | Deintercalate1InitR !fs
2807 | Deintercalate1R !Int !fs !ss
2813 | Deintercalate1R !Int !fs !ss
2808 | Deintercalate1RL !Int !b !fs !sp
2814 | Deintercalate1RL !Int !b !fs !sp
@@ -2848,7 +2854,7 @@ deintercalate1
2848 FL.Partial fs -> do
2854 FL.Partial fs -> do
2849 pres <- initialL
2855 pres <- initialL
2850 case pres of
2856 case pres of
2851− IPartial s -> return $ IPartial $ (Deintercalate1InitL 0 fs s)
2857+ IPartial s -> return $ IPartial $ Deintercalate1InitL 0 fs s
2852 IDone _ -> errMsg "left" "succeed"
2858 IDone _ -> errMsg "left" "succeed"
2853 IError _ -> errMsg "left" "fail"
2859 IError _ -> errMsg "left" "fail"
2854 FL.Done c -> return $ IDone c
2860 FL.Done c -> return $ IDone c
@@ -2865,25 +2871,12 @@ deintercalate1
2865 let cnt1 = cnt + 1
2871 let cnt1 = cnt + 1
2866 r <- stepL sL a
2872 r <- stepL sL a
2867 case r of
2873 case r of
2868− Partial n s -> return $ Continue n (Deintercalate1InitL cnt1 fs s)
2874+ Partial n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)
2869− Continue n s -> return $ Continue n (Deintercalate1InitL cnt1 fs s)
2875+ Continue n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)
2870 Done n b ->
2876 Done n b ->
2871 processL (fstep fs (Left b)) n Deintercalate1InitR
2877 processL (fstep fs (Left b)) n Deintercalate1InitR
2872 Error err -> return $ Error err
2878 Error err -> return $ Error err
2873
2879
2874− {-# INLINE runStepL #-}
2875− runStepL cnt fs sL a = do
2876− let cnt1 = cnt + 1
2877− r <- stepL sL a
2878− case r of
2879− Partial n s -> return $ Continue n (Deintercalate1L cnt1 fs s)
2880− Continue n s -> return $ Continue n (Deintercalate1L cnt1 fs s)
2881− Done n b ->
2882− processL (fstep fs (Left b)) n Deintercalate1InitR
2883− Error _ -> do
2884− xs <- fextract fs
2885− return $ Done cnt1 xs
2886−
2887 {-# INLINE processR #-}
2880 {-# INLINE processR #-}
2888 processR cnt b fs n = do
2881 processR cnt b fs n = do
2889 res <- initialL
2882 res <- initialL
@@ -2897,15 +2890,14 @@ deintercalate1
2897 let cnt1 = cnt + 1
2890 let cnt1 = cnt + 1
2898 r <- stepR sR a
2891 r <- stepR sR a
2899 case r of
2892 case r of
2900− Partial n s -> return $ Continue n (Deintercalate1R cnt1 fs s)
2893+ Partial n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)
2901− Continue n s -> return $ Continue n (Deintercalate1R cnt1 fs s)
2894+ Continue n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)
2902− Done n b -> processR cnt1 b fs n
2895+ Done n b -> processR (cnt1 - n) b fs n
2903 Error _ -> do
2896 Error _ -> do
2904 xs <- fextract fs
2897 xs <- fextract fs
2905 return $ Done cnt1 xs
2898 return $ Done cnt1 xs
2906
2899
2907 step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a
2900 step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a
2908− step (Deintercalate1L cnt fs sL) a = runStepL cnt fs sL a
2909 step (Deintercalate1InitR fs) a = do
2901 step (Deintercalate1InitR fs) a = do
2910 res <- initialR
2902 res <- initialR
2911 case res of
2903 case res of
@@ -2917,8 +2909,8 @@ deintercalate1
2917 let cnt1 = cnt + 1
2909 let cnt1 = cnt + 1
2918 r <- stepL sL a
2910 r <- stepL sL a
2919 case r of
2911 case r of
2920− Partial n s -> return $ Continue n (Deintercalate1RL cnt1 bR fs s)
2912+ Partial n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)
2921− Continue n s -> return $ Continue n (Deintercalate1RL cnt1 bR fs s)
2913+ Continue n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)
2922 Done n bL -> do
2914 Done n bL -> do
2923 res <- fstep fs (Right bR)
2915 res <- fstep fs (Right bR)
2924 case res of
2916 case res of
@@ -2945,18 +2937,9 @@ deintercalate1
2945 r <- extractL sL
2937 r <- extractL sL
2946 case r of
2938 case r of
2947 Done n b -> extractResult n fs (Left b)
2939 Done n b -> extractResult n fs (Left b)
2948− Continue n s -> return $ Continue n (Deintercalate1InitL cnt fs s)
2940+ Continue n s -> return $ Continue n (Deintercalate1InitL (cnt - n) fs s)
2949 Partial _ _ -> error "Partial in extract"
2941 Partial _ _ -> error "Partial in extract"
2950 Error err -> return $ Error err
2942 Error err -> return $ Error err
2951− extract (Deintercalate1L cnt fs sL) = do
2952− r <- extractL sL
2953− case r of
2954− Done n b -> extractResult n fs (Left b)
2955− Continue n s -> return $ Continue n (Deintercalate1L cnt fs s)
2956− Partial _ _ -> error "Partial in extract"
2957− Error _ -> do
2958− xs <- fextract fs
2959− return $ Done cnt xs
2960 extract (Deintercalate1InitR fs) = fmap (Done 0) $ fextract fs
2943 extract (Deintercalate1InitR fs) = fmap (Done 0) $ fextract fs
2961 extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ fextract fs
2944 extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ fextract fs
2962 extract (Deintercalate1RL cnt bR fs sL) = do
2945 extract (Deintercalate1RL cnt bR fs sL) = do
@@ -2967,12 +2950,13 @@ deintercalate1
2967 case res of
2950 case res of
2968 FL.Partial fs1 -> extractResult n fs1 (Left bL)
2951 FL.Partial fs1 -> extractResult n fs1 (Left bL)
2969 FL.Done _ -> error "Fold terminated consuming partial input"
2952 FL.Done _ -> error "Fold terminated consuming partial input"
2970− Continue n s -> return $ Continue n (Deintercalate1RL cnt bR fs s)
2953+ Continue n s -> return $ Continue n (Deintercalate1RL (cnt - n) bR fs s)
2971 Partial _ _ -> error "Partial in extract"
2954 Partial _ _ -> error "Partial in extract"
2972 Error _ -> do
2955 Error _ -> do
2973 xs <- fextract fs
2956 xs <- fextract fs
2974 return $ Done cnt xs
2957 return $ Done cnt xs
2975
2958
2959+{-# ANN type SepByState Fuse #-}
2976data SepByState fs sp ss =
2960data SepByState fs sp ss =
2977 SepByInitL !fs
2961 SepByInitL !fs
2978 | SepByL !Int !fs !sp
2962 | SepByL !Int !fs !sp
@@ -3036,8 +3020,8 @@ sepBy
3036 let cnt1 = cnt + 1
3020 let cnt1 = cnt + 1
3037 r <- stepL sL a
3021 r <- stepL sL a
3038 case r of
3022 case r of
3039− Partial n s -> return $ Continue n (SepByL cnt1 fs s)
3023+ Partial n s -> return $ Continue n (SepByL (cnt1 - n) fs s)
3040− Continue n s -> return $ Continue n (SepByL cnt1 fs s)
3024+ Continue n s -> return $ Continue n (SepByL (cnt1 - n) fs s)
3041 Done n b ->
3025 Done n b ->
3042 processL (fstep fs b) n SepByInitR
3026 processL (fstep fs b) n SepByInitR
3043 Error _ -> do
3027 Error _ -> do
@@ -3057,9 +3041,9 @@ sepBy
3057 let cnt1 = cnt + 1
3041 let cnt1 = cnt + 1
3058 r <- stepR sR a
3042 r <- stepR sR a
3059 case r of
3043 case r of
3060− Partial n s -> return $ Continue n (SepByR cnt1 fs s)
3044+ Partial n s -> return $ Continue n (SepByR (cnt1 - n) fs s)
3061− Continue n s -> return $ Continue n (SepByR cnt1 fs s)
3045+ Continue n s -> return $ Continue n (SepByR (cnt1 - n) fs s)
3062− Done n _ -> processR cnt1 fs n
3046+ Done n _ -> processR (cnt1 - n) fs n
3063 Error _ -> do
3047 Error _ -> do
3064 xs <- fextract fs
3048 xs <- fextract fs
3065 return $ Done cnt1 xs
3049 return $ Done cnt1 xs
@@ -3091,7 +3075,7 @@ sepBy
3091 r <- extractL sL
3075 r <- extractL sL
3092 case r of
3076 case r of
3093 Done n b -> extractResult n fs b
3077 Done n b -> extractResult n fs b
3094− Continue n s -> return $ Continue n (SepByL cnt fs s)
3078+ Continue n s -> return $ Continue n (SepByL (cnt - n) fs s)
3095 Partial _ _ -> error "Partial in extract"
3079 Partial _ _ -> error "Partial in extract"
3096 Error _ -> do
3080 Error _ -> do
3097 xs <- fextract fs
3081 xs <- fextract fs
@@ -3102,6 +3086,7 @@ sepBy
3102-- XXX This can be implemented using refold, parse one and then continue
3086-- XXX This can be implemented using refold, parse one and then continue
3103-- collecting the rest in that.
3087-- collecting the rest in that.
3104
3088
3089+{-# ANN type SepBy1State Fuse #-}
3105data SepBy1State fs sp ss =
3090data SepBy1State fs sp ss =
3106 SepBy1InitL !Int !fs sp
3091 SepBy1InitL !Int !fs sp
3107 | SepBy1L !Int !fs !sp
3092 | SepBy1L !Int !fs !sp
@@ -3172,8 +3157,8 @@ sepBy1
3172 let cnt1 = cnt + 1
3157 let cnt1 = cnt + 1
3173 r <- stepL sL a
3158 r <- stepL sL a
3174 case r of
3159 case r of
3175− Partial n s -> return $ Continue n (SepBy1InitL cnt1 fs s)
3160+ Partial n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)
3176− Continue n s -> return $ Continue n (SepBy1InitL cnt1 fs s)
3161+ Continue n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)
3177 Done n b ->
3162 Done n b ->
3178 processL (fstep fs b) n SepBy1InitR
3163 processL (fstep fs b) n SepBy1InitR
3179 Error err -> return $ Error err
3164 Error err -> return $ Error err
@@ -3183,8 +3168,8 @@ sepBy1
3183 let cnt1 = cnt + 1
3168 let cnt1 = cnt + 1
3184 r <- stepL sL a
3169 r <- stepL sL a
3185 case r of
3170 case r of
3186− Partial n s -> return $ Continue n (SepBy1L cnt1 fs s)
3171+ Partial n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)
3187− Continue n s -> return $ Continue n (SepBy1L cnt1 fs s)
3172+ Continue n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)
3188 Done n b ->
3173 Done n b ->
3189 processL (fstep fs b) n SepBy1InitR
3174 processL (fstep fs b) n SepBy1InitR
3190 Error _ -> do
3175 Error _ -> do
@@ -3204,9 +3189,9 @@ sepBy1
3204 let cnt1 = cnt + 1
3189 let cnt1 = cnt + 1
3205 r <- stepR sR a
3190 r <- stepR sR a
3206 case r of
3191 case r of
3207− Partial n s -> return $ Continue n (SepBy1R cnt1 fs s)
3192+ Partial n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)
3208− Continue n s -> return $ Continue n (SepBy1R cnt1 fs s)
3193+ Continue n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)
3209− Done n _ -> processR cnt1 fs n
3194+ Done n _ -> processR (cnt1 - n) fs n
3210 Error _ -> do
3195 Error _ -> do
3211 xs <- fextract fs
3196 xs <- fextract fs
3212 return $ Done cnt1 xs
3197 return $ Done cnt1 xs
@@ -3232,14 +3217,14 @@ sepBy1
3232 r <- extractL sL
3217 r <- extractL sL
3233 case r of
3218 case r of
3234 Done n b -> extractResult n fs b
3219 Done n b -> extractResult n fs b
3235− Continue n s -> return $ Continue n (SepBy1InitL cnt fs s)
3220+ Continue n s -> return $ Continue n (SepBy1InitL (cnt - n) fs s)
3236 Partial _ _ -> error "Partial in extract"
3221 Partial _ _ -> error "Partial in extract"
3237 Error err -> return $ Error err
3222 Error err -> return $ Error err
3238 extract (SepBy1L cnt fs sL) = do
3223 extract (SepBy1L cnt fs sL) = do
3239 r <- extractL sL
3224 r <- extractL sL
3240 case r of
3225 case r of
3241 Done n b -> extractResult n fs b
3226 Done n b -> extractResult n fs b
3242− Continue n s -> return $ Continue n (SepBy1L cnt fs s)
3227+ Continue n s -> return $ Continue n (SepBy1L (cnt - n) fs s)
3243 Partial _ _ -> error "Partial in extract"
3228 Partial _ _ -> error "Partial in extract"
3244 Error _ -> do
3229 Error _ -> do
3245 xs <- fextract fs
3230 xs <- fextract fs