machine: fix mayRaise analysis of catch
[haskell/symantic-parser.git] / test / Golden / Splice / G4.expected.txt
index 1efbe088fe89fabe9013688353a9be7759d8f64d..5a4c63459babcece1205cc86ea50b32a95a28334 100644 (file)
-test/Golden/Splice/G4.hs:0:0:: Splicing expression
-    P.runParser @Text Grammar.g4
-  ======>
-    \ (input :: inp)
-      -> let
-           !(# init, readMore, readNext #)
-             = let _ = "cursorOf" in
-               let
-                 next t@(Data.Text.Internal.Text arr off unconsumed)
-                   = let !(Data.Text.Unsafe.Iter c d) = (Data.Text.Unsafe.iter t) 0
-                     in
-                       (# c, ((Data.Text.Internal.Text arr) (off + d)) (unconsumed - d) #)
-                 more (Data.Text.Internal.Text _ _ unconsumed) = (unconsumed > 0)
-               in (# input, more, next #) in
-         let finalRet = \ _farInp _farExp v _inp -> Right v in
-         let
-           finalRaise :: forall b. P.Catcher inp b
-             = \ _failInp !farInp !farExp
-                 -> Left
-                      P.ParsingErrorStandard
-                        {P.parsingErrorOffset = P.offset farInp,
-                         P.parsingErrorUnexpected = if readMore farInp then
-                                                        Just (let (# c, _ #) = readNext farInp in c)
-                                                    else
-                                                        Nothing,
-                         P.parsingErrorExpecting = Data.Set.Internal.fromList farExp} in
-         let
-           name
-             = \ !ok !inp !koByLabel
-                 -> let _ = "catchException lbl=fail" in
-                    let
-                      readFail
-                        = \ !failInp !farInp !farExp
-                            -> let
-                                 (# farInp, farExp #)
-                                   = case ((compare `Data.Function.on` P.offset) farInp) inp of
-                                       LT -> (# inp, [] #)
-                                       EQ -> (# farInp, (farExp <> []) #)
-                                       GT -> (# farInp, farExp #)
-                               in
-                                 (((((Data.Map.Strict.Internal.findWithDefault finalRaise) "fail")
-                                      koByLabel)
-                                     inp)
-                                    farInp)
-                                   farExp
-                    in
-                      if readMore ((P.shiftRightText 3) inp) then
-                          let !(# c, cs #) = readNext inp
-                          in
-                            if ('a' ==) c then
-                                let readFail = readFail in
-                                let !(# c, cs #) = readNext cs
-                                in
-                                  if ('b' ==) c then
-                                      let readFail = readFail in
-                                      let !(# c, cs #) = readNext cs
-                                      in
-                                        if ('c' ==) c then
-                                            let readFail = readFail in
-                                            let !(# c, cs #) = readNext cs
-                                            in
-                                              if ('d' ==) c then
-                                                  let _ = "resume"
-                                                  in
-                                                    (((ok init) [])
-                                                       (let _ = "resume.genCode"
-                                                        in
-                                                          ((\ x -> \ x -> x x)
-                                                             (((\ x -> \ x -> x x)
-                                                                 (((\ x -> \ x -> x x)
-                                                                     (((\ x -> \ x -> x x)
-                                                                         (\ x
-                                                                            -> \ x
-                                                                                 -> \ x
-                                                                                      -> \ x
-                                                                                           -> ('a'
-                                                                                                 : ('b'
-                                                                                                      : ('c'
-                                                                                                           : ('d'
-                                                                                                                : []))))))
-                                                                        c))
-                                                                    c))
-                                                                c))
-                                                            c))
-                                                      cs
-                                              else
-                                                  let _ = "checkToken.else" in
-                                                  let
-                                                    (# farInp, farExp #)
-                                                      = case
-                                                            ((compare `Data.Function.on` P.offset)
-                                                               init)
-                                                              cs
-                                                        of
-                                                          LT -> (# cs, [P.ErrorItemToken 'd'] #)
-                                                          EQ
-                                                            -> (# init, 
-                                                                  ([] <> [P.ErrorItemToken 'd']) #)
-                                                          GT -> (# init, [] #)
-                                                  in ((readFail cs) farInp) farExp
-                                        else
-                                            let _ = "checkToken.else" in
-                                            let
-                                              (# farInp, farExp #)
-                                                = case
-                                                      ((compare `Data.Function.on` P.offset) init)
-                                                        cs
-                                                  of
-                                                    LT -> (# cs, [P.ErrorItemToken 'c'] #)
-                                                    EQ -> (# init, ([] <> [P.ErrorItemToken 'c']) #)
-                                                    GT -> (# init, [] #)
-                                            in ((readFail cs) farInp) farExp
-                                  else
-                                      let _ = "checkToken.else" in
-                                      let
-                                        (# farInp, farExp #)
-                                          = case ((compare `Data.Function.on` P.offset) init) cs of
-                                              LT -> (# cs, [P.ErrorItemToken 'b'] #)
-                                              EQ -> (# init, ([] <> [P.ErrorItemToken 'b']) #)
-                                              GT -> (# init, [] #)
-                                      in ((readFail cs) farInp) farExp
-                            else
-                                let _ = "checkToken.else" in
-                                let
-                                  (# farInp, farExp #)
-                                    = case ((compare `Data.Function.on` P.offset) init) inp of
-                                        LT -> (# inp, [P.ErrorItemToken 'a'] #)
-                                        EQ -> (# init, ([] <> [P.ErrorItemToken 'a']) #)
-                                        GT -> (# init, [] #)
-                                in ((readFail inp) farInp) farExp
-                      else
-                          let _ = "checkHorizon.else" in
-                          let
-                            (# farInp, farExp #)
-                              = case ((compare `Data.Function.on` P.offset) init) inp of
-                                  LT -> (# inp, [P.ErrorItemHorizon 4] #)
-                                  EQ -> (# init, ([] <> [P.ErrorItemHorizon 4]) #)
-                                  GT -> (# init, [] #)
-                          in ((readFail inp) farInp) farExp in
-         let
-           _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=[]"
-         in
-           ((name
-               (let
-                  _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())])]"
-                in
-                  \ farInp farExp v !inp
-                    -> let
-                         name
-                           = \ !ok !inp !koByLabel
-                               -> let _ = "catchException lbl=fail" in
-                                  let
-                                    _ = "call exceptionsByName(name_1)=["fail"] catchStackByLabel(ctx)=["fail"]"
-                                  in
-                                    ((name
-                                        (let
-                                           _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())]),(name_2,fromList [])]"
-                                         in
-                                           \ farInp farExp v !inp
-                                             -> let
-                                                  _ = "call exceptionsByName(name_2)=[] catchStackByLabel(ctx)=["fail"]"
-                                                in
-                                                  ((name
-                                                      (let
-                                                         _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())]),(name_2,fromList [])]"
-                                                       in
-                                                         \ farInp farExp v !inp
-                                                           -> let _ = "resume"
-                                                              in
-                                                                (((ok farInp) farExp)
-                                                                   (let _ = "resume.genCode"
-                                                                    in
-                                                                      ((\ x -> \ x -> x x)
-                                                                         (((\ x -> \ x -> x x)
-                                                                             (\ x
-                                                                                -> \ x
-                                                                                     -> \ x
-                                                                                          -> (x : x x)))
-                                                                            v))
-                                                                        v))
-                                                                  inp))
-                                                     inp)
-                                                    (((((Data.Map.Internal.Bin 1) "fail")
-                                                         (\ !failInp !farInp !farExp
-                                                            -> if (\ x -> x)
-                                                                    (((\ (Data.Text.Internal.Text _
-                                                                                                  i
-                                                                                                  _)
-                                                                         (Data.Text.Internal.Text _
-                                                                                                  j
-                                                                                                  _)
-                                                                         -> (i == j))
-                                                                        inp)
-                                                                       failInp) then
-                                                                   let _ = "resume"
-                                                                   in
-                                                                     (((ok farInp) farExp)
-                                                                        (let _ = "resume.genCode"
-                                                                         in \ x -> x))
-                                                                       failInp
-                                                               else
-                                                                   let
-                                                                     (# farInp, farExp #)
-                                                                       = case
-                                                                             ((compare
-                                                                                 `Data.Function.on`
-                                                                                   P.offset)
-                                                                                farInp)
-                                                                               failInp
-                                                                         of
-                                                                           LT -> (# failInp, [] #)
-                                                                           EQ
-                                                                             -> (# farInp, 
-                                                                                   (farExp <> []) #)
-                                                                           GT
-                                                                             -> (# farInp, farExp #)
-                                                                   in
-                                                                     (((((Data.Map.Strict.Internal.findWithDefault
-                                                                            finalRaise)
-                                                                           "fail")
-                                                                          koByLabel)
-                                                                         failInp)
-                                                                        farInp)
-                                                                       farExp))
-                                                        Data.Map.Internal.Tip)
-                                                       Data.Map.Internal.Tip)))
-                                       inp)
-                                      (((((Data.Map.Internal.Bin 1) "fail")
-                                           (\ !failInp !farInp !farExp
-                                              -> if (\ x -> x)
-                                                      (((\ (Data.Text.Internal.Text _ i _)
-                                                           (Data.Text.Internal.Text _ j _)
-                                                           -> (i == j))
-                                                          inp)
-                                                         failInp) then
-                                                     let _ = "resume"
-                                                     in
-                                                       (((ok farInp) farExp)
-                                                          (let _ = "resume.genCode" in \ x -> x))
-                                                         failInp
-                                                 else
-                                                     let
-                                                       (# farInp, farExp #)
-                                                         = case
-                                                               ((compare
-                                                                   `Data.Function.on` P.offset)
-                                                                  farInp)
-                                                                 failInp
-                                                           of
-                                                             LT -> (# failInp, [] #)
-                                                             EQ -> (# farInp, (farExp <> []) #)
-                                                             GT -> (# farInp, farExp #)
-                                                     in
-                                                       (((((Data.Map.Strict.Internal.findWithDefault
-                                                              finalRaise)
-                                                             "fail")
-                                                            koByLabel)
-                                                           failInp)
-                                                          farInp)
-                                                         farExp))
-                                          Data.Map.Internal.Tip)
-                                         Data.Map.Internal.Tip) in
-                       let
-                         _ = "call exceptionsByName(name_2)=["fail"] catchStackByLabel(ctx)=[]"
-                       in
-                         ((name
-                             (let
-                                _ = "suspend raiseException=fromList [(name_1,fromList [("fail",())]),(name_2,fromList [("fail",())])]"
-                              in
-                                \ farInp farExp v !inp
-                                  -> let _ = "resume"
-                                     in
-                                       (((finalRet farInp) farExp)
-                                          (let _ = "resume.genCode"
-                                           in
-                                             ((\ x -> \ x -> x x)
-                                                (((\ x -> \ x -> x x) (\ x -> \ x -> (x : x [])))
-                                                   v))
-                                               v))
-                                         inp))
-                            inp)
-                           Data.Map.Internal.Tip))
-              init)
-             Data.Map.Internal.Tip
+\(input :: inp) ->
+  let !(#
+         init,
+         readMore,
+         readNext
+         #) =
+          let _ = "cursorOf"
+           in let next
+                    ( t@( Data.Text.Internal.Text
+                            arr
+                            off
+                            unconsumed
+                          )
+                      ) =
+                      let !( Data.Text.Unsafe.Iter
+                               c
+                               d
+                             ) = Data.Text.Unsafe.iter t 0
+                       in (#
+                            c,
+                            Data.Text.Internal.Text arr (off GHC.Num.+ d) (unconsumed GHC.Num.- d)
+                          #)
+                  more
+                    ( Data.Text.Internal.Text
+                        _
+                        _
+                        unconsumed
+                      ) = unconsumed GHC.Classes.> 0
+               in (# input, more, next #)
+      finalRet = \_farInp _farExp v _inp -> Data.Either.Right v
+      finalRaise ::
+        forall b.
+        Symantic.Parser.Machine.Generate.Catcher
+          inp
+          b = \(!exn) _failInp (!farInp) (!farExp) ->
+          Data.Either.Left
+            Symantic.Parser.Machine.Generate.ParsingErrorStandard
+              { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.offset farInp,
+                Symantic.Parser.Machine.Generate.parsingErrorException = exn,
+                Symantic.Parser.Machine.Generate.parsingErrorUnexpected =
+                  if readMore farInp
+                    then
+                      GHC.Maybe.Just
+                        ( let (#
+                                c,
+                                _
+                                #) = readNext farInp
+                           in c
+                        )
+                    else GHC.Maybe.Nothing,
+                Symantic.Parser.Machine.Generate.parsingErrorExpecting = farExp
+              }
+   in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp)
+       in let name = \(!ok) (!inp) (!koByLabel) ->
+                let _ = "catch ExceptionFailure"
+                 in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) =
+                          let _ = "catch.ko ExceptionFailure"
+                           in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp
+                     in let readFail = catchHandler
+                         in if readMore (Symantic.Parser.Machine.Input.shiftRightText 3 inp)
+                              then
+                                let !(#
+                                       c,
+                                       cs
+                                       #) = readNext inp
+                                 in if ('a' GHC.Classes.==) c
+                                      then
+                                        let readFail = readFail
+                                         in let !(#
+                                                   c,
+                                                   cs
+                                                   #) = readNext cs
+                                             in if ('b' GHC.Classes.==) c
+                                                  then
+                                                    let readFail = readFail
+                                                     in let !(#
+                                                               c,
+                                                               cs
+                                                               #) = readNext cs
+                                                         in if ('c' GHC.Classes.==) c
+                                                              then
+                                                                let readFail = readFail
+                                                                 in let !(#
+                                                                           c,
+                                                                           cs
+                                                                           #) = readNext cs
+                                                                     in if ('d' GHC.Classes.==) c
+                                                                          then
+                                                                            let _ = "resume"
+                                                                             in ok
+                                                                                  init
+                                                                                  Data.Set.Internal.empty
+                                                                                  ( let _ = "resume.genCode"
+                                                                                     in 'a' GHC.Types.: ('b' GHC.Types.: ('c' GHC.Types.: ('d' GHC.Types.: GHC.Types . [])))
+                                                                                  )
+                                                                                  cs
+                                                                          else
+                                                                            let _ = "checkToken.else"
+                                                                             in let failExp =
+                                                                                      Data.Set.Internal.Bin
+                                                                                        1
+                                                                                        ( Symantic.Parser.Grammar.Combinators.SomeFailure
+                                                                                            ( case inputToken of
+                                                                                                (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'd'
+                                                                                            )
+                                                                                        )
+                                                                                        Data.Set.Internal.Tip
+                                                                                        Data.Set.Internal.Tip
+                                                                                    (#
+                                                                                      farInp,
+                                                                                      farExp
+                                                                                      #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of
+                                                                                        GHC.Types.LT ->
+                                                                                          (#
+                                                                                            cs,
+                                                                                            failExp
+                                                                                          #)
+                                                                                        GHC.Types.EQ ->
+                                                                                          (#
+                                                                                            init,
+                                                                                            failExp GHC.Base.<> Data.Set.Internal.empty
+                                                                                          #)
+                                                                                        GHC.Types.GT ->
+                                                                                          (#
+                                                                                            init,
+                                                                                            Data.Set.Internal.empty
+                                                                                          #)
+                                                                                 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp
+                                                              else
+                                                                let _ = "checkToken.else"
+                                                                 in let failExp =
+                                                                          Data.Set.Internal.Bin
+                                                                            1
+                                                                            ( Symantic.Parser.Grammar.Combinators.SomeFailure
+                                                                                ( case inputToken of
+                                                                                    (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'c'
+                                                                                )
+                                                                            )
+                                                                            Data.Set.Internal.Tip
+                                                                            Data.Set.Internal.Tip
+                                                                        (#
+                                                                          farInp,
+                                                                          farExp
+                                                                          #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of
+                                                                            GHC.Types.LT ->
+                                                                              (#
+                                                                                cs,
+                                                                                failExp
+                                                                              #)
+                                                                            GHC.Types.EQ ->
+                                                                              (#
+                                                                                init,
+                                                                                failExp GHC.Base.<> Data.Set.Internal.empty
+                                                                              #)
+                                                                            GHC.Types.GT ->
+                                                                              (#
+                                                                                init,
+                                                                                Data.Set.Internal.empty
+                                                                              #)
+                                                                     in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp
+                                                  else
+                                                    let _ = "checkToken.else"
+                                                     in let failExp =
+                                                              Data.Set.Internal.Bin
+                                                                1
+                                                                ( Symantic.Parser.Grammar.Combinators.SomeFailure
+                                                                    ( case inputToken of
+                                                                        (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'b'
+                                                                    )
+                                                                )
+                                                                Data.Set.Internal.Tip
+                                                                Data.Set.Internal.Tip
+                                                            (#
+                                                              farInp,
+                                                              farExp
+                                                              #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init cs of
+                                                                GHC.Types.LT ->
+                                                                  (#
+                                                                    cs,
+                                                                    failExp
+                                                                  #)
+                                                                GHC.Types.EQ ->
+                                                                  (#
+                                                                    init,
+                                                                    failExp GHC.Base.<> Data.Set.Internal.empty
+                                                                  #)
+                                                                GHC.Types.GT ->
+                                                                  (#
+                                                                    init,
+                                                                    Data.Set.Internal.empty
+                                                                  #)
+                                                         in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp
+                                      else
+                                        let _ = "checkToken.else"
+                                         in let failExp =
+                                                  Data.Set.Internal.Bin
+                                                    1
+                                                    ( Symantic.Parser.Grammar.Combinators.SomeFailure
+                                                        ( case inputToken of
+                                                            (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a'
+                                                        )
+                                                    )
+                                                    Data.Set.Internal.Tip
+                                                    Data.Set.Internal.Tip
+                                                (#
+                                                  farInp,
+                                                  farExp
+                                                  #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of
+                                                    GHC.Types.LT ->
+                                                      (#
+                                                        inp,
+                                                        failExp
+                                                      #)
+                                                    GHC.Types.EQ ->
+                                                      (#
+                                                        init,
+                                                        failExp GHC.Base.<> Data.Set.Internal.empty
+                                                      #)
+                                                    GHC.Types.GT ->
+                                                      (#
+                                                        init,
+                                                        Data.Set.Internal.empty
+                                                      #)
+                                             in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp
+                              else
+                                let _ = "checkHorizon.else"
+                                 in let failExp =
+                                          Data.Set.Internal.Bin
+                                            1
+                                            ( Symantic.Parser.Grammar.Combinators.SomeFailure
+                                                ( case inputToken of
+                                                    (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 4
+                                                )
+                                            )
+                                            Data.Set.Internal.Tip
+                                            Data.Set.Internal.Tip
+                                        (#
+                                          farInp,
+                                          farExp
+                                          #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of
+                                            GHC.Types.LT ->
+                                              (#
+                                                inp,
+                                                failExp
+                                              #)
+                                            GHC.Types.EQ ->
+                                              (#
+                                                init,
+                                                failExp GHC.Base.<> Data.Set.Internal.empty
+                                              #)
+                                            GHC.Types.GT ->
+                                              (#
+                                                init,
+                                                Data.Set.Internal.empty
+                                              #)
+                                     in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp
+              name = \(!ok) (!inp) (!koByLabel) ->
+                let _ = "catch ExceptionFailure"
+                 in let catchHandler (!_exn) (!failInp) (!farInp) (!farExp) =
+                          let _ = "catch.ko ExceptionFailure"
+                           in if ( \( Data.Text.Internal.Text
+                                        _
+                                        i
+                                        _
+                                      )
+                                    ( Data.Text.Internal.Text
+                                        _
+                                        j
+                                        _
+                                      ) -> i GHC.Classes.== j
+                                 )
+                                inp
+                                failInp
+                                then
+                                  let _ = "choicesBranch.then"
+                                   in let _ = "resume"
+                                       in ok
+                                            farInp
+                                            farExp
+                                            ( let _ = "resume.genCode"
+                                               in \x -> x
+                                            )
+                                            failInp
+                                else
+                                  let _ = "choicesBranch.else"
+                                   in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp
+                     in name
+                          ( let _ = "suspend"
+                             in \farInp farExp v (!inp) ->
+                                  name
+                                    ( let _ = "suspend"
+                                       in \farInp farExp v (!inp) ->
+                                            let _ = "resume"
+                                             in ok
+                                                  farInp
+                                                  farExp
+                                                  ( let _ = "resume.genCode"
+                                                     in \x -> v GHC.Types.: v x
+                                                  )
+                                                  inp
+                                    )
+                                    inp
+                                    Data.Map.Internal.Tip
+                          )
+                          inp
+                          Data.Map.Internal.Tip
+           in name
+                ( let _ = "suspend"
+                   in \farInp farExp v (!inp) ->
+                        name
+                          ( let _ = "suspend"
+                             in \farInp farExp v (!inp) ->
+                                  let _ = "resume"
+                                   in finalRet
+                                        farInp
+                                        farExp
+                                        ( let _ = "resume.genCode"
+                                           in GHC.Show.show (v GHC.Types.: v GHC.Types . [])
+                                        )
+                                        inp
+                          )
+                          inp
+                          Data.Map.Internal.Tip
+                )
+                init
+                Data.Map.Internal.Tip