\(input :: inp) ->
let !(#
- init,
+ initBuffer,
+ initPos,
readMore,
- readNext
+ readNext,
+ append
#) =
- 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 -> Symantic.Parser.Machine.Generate.returnST GHC.Base.$ Data.Either.Right v
- finalRaise ::
- forall st b.
- Symantic.Parser.Machine.Generate.OnException
- st
- inp
- b = \(!exn) _failInp (!farInp) (!farExp) ->
- Symantic.Parser.Machine.Generate.returnST GHC.Base.$
- Data.Either.Left
- Symantic.Parser.Machine.Generate.ParsingError
- { 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 =
- let ( minHoriz,
- res
- ) =
- Data.Set.Internal.foldr
- ( \f
- ( minH,
- acc
- ) -> case Symantic.Parser.Grammar.Combinators.unSomeFailure f of
- GHC.Maybe.Just (Symantic.Parser.Grammar.Combinators.FailureHorizon h :: Symantic.Parser.Grammar.Combinators.Failure (Symantic.Parser.Grammar.Combinators.CombSatisfiable (Symantic.Parser.Machine.Input.InputToken inp)))
- | GHC.Maybe.Just old <- minH ->
- ( GHC.Maybe.Just (GHC.Classes.min old h),
- acc
- )
- | GHC.Base.otherwise ->
- ( GHC.Maybe.Just h,
- acc
- )
- _ ->
- ( minH,
- f GHC.Types.: acc
- )
+ let next buf pos =
+ let !( Data.Text.Unsafe.Iter
+ c
+ d
+ ) = Symantic.Parser.Machine.Input.Text.Buffer.iter buf pos
+ in (# c, pos GHC.Num.+ d #)
+ more buf pos = pos GHC.Classes.< Symantic.Parser.Machine.Input.Text.Buffer.length buf
+ append = Symantic.Parser.Machine.Input.Text.Buffer.pappend
+ in (#
+ Symantic.Parser.Machine.Input.Text.Buffer.buffer input,
+ 0,
+ more,
+ next,
+ append
+ #)
+ finalRet = \_farInp _farExp v _inp _buf _end -> Symantic.Parser.Machine.Generate.returnST GHC.Base.$ Symantic.Parser.Machine.Generate.ResultDone v
+ finalRaise :: Symantic.Parser.Machine.Generate.ForallOnException inp =
+ Symantic.Parser.Machine.Generate.ForallOnException GHC.Base.$
+ ( \(!exn) _failInp (!farInp) (!farExp) buf end ->
+ Symantic.Parser.Machine.Generate.returnST GHC.Base.$
+ Symantic.Parser.Machine.Generate.ResultError
+ Symantic.Parser.Machine.Generate.ParsingError
+ { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.position farInp,
+ Symantic.Parser.Machine.Generate.parsingErrorException = exn,
+ Symantic.Parser.Machine.Generate.parsingErrorUnexpected =
+ if readMore buf farInp
+ then
+ GHC.Maybe.Just
+ ( let (#
+ c,
+ _
+ #) = readNext buf farInp
+ in c
)
- ( GHC.Maybe.Nothing,
- GHC.Types . []
+ else GHC.Maybe.Nothing,
+ Symantic.Parser.Machine.Generate.parsingErrorExpecting =
+ let ( minHoriz,
+ res
+ ) =
+ Data.Set.Internal.foldr
+ ( \f
+ ( minH,
+ acc
+ ) -> case Symantic.Parser.Grammar.Combinators.unSomeFailure f of
+ GHC.Maybe.Just (Symantic.Parser.Grammar.Combinators.FailureHorizon h :: Symantic.Parser.Grammar.Combinators.Failure (Symantic.Parser.Grammar.Combinators.CombSatisfiable (Symantic.Parser.Machine.Input.InputToken inp)))
+ | GHC.Maybe.Just old <- minH ->
+ ( GHC.Maybe.Just (GHC.Classes.min old h),
+ acc
+ )
+ | GHC.Base.otherwise ->
+ ( GHC.Maybe.Just h,
+ acc
+ )
+ _ ->
+ ( minH,
+ f GHC.Types.: acc
+ )
+ )
+ ( GHC.Maybe.Nothing,
+ GHC.Types . []
+ )
+ farExp
+ in Data.Set.Internal.fromList GHC.Base.$
+ ( case minHoriz of
+ GHC.Maybe.Just h -> Symantic.Parser.Grammar.Combinators.SomeFailure (Symantic.Parser.Grammar.Combinators.FailureHorizon @(Symantic.Parser.Machine.Input.InputToken inp) h) GHC.Types.: res
+ GHC.Maybe.Nothing -> res
)
- farExp
- in Data.Set.Internal.fromList GHC.Base.$
- ( case minHoriz of
- GHC.Maybe.Just h -> Symantic.Parser.Grammar.Combinators.SomeFailure (Symantic.Parser.Grammar.Combinators.FailureHorizon @(Symantic.Parser.Machine.Input.InputToken inp) h) GHC.Types.: res
- GHC.Maybe.Nothing -> res
- )
- }
- in GHC.ST.runST
- ( let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp)
- in let inp = init
- in let readFail = finalRaise
- in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
- in if readMore inp
- then
- let
- in let _ = "pushValue"
- in let _ = "pushValue"
- in do
- let dupv = \x -> x
- reg <- GHC.STRef.newSTRef dupv
- let _ = "iter"
- in let onException loopInput =
- let _ = "onException"
- in \(!_exn) (!failInp) (!farInp) (!farExp) ->
- let _ = "comment: raiseAgainIfConsumed"
- in let _ = "saveInput checkedHorizon=0"
- in let _ = "lift2Value checkedHorizon=0"
- in if ( \( Data.Text.Internal.Text
- _
- i
- _
- )
- ( Data.Text.Internal.Text
- _
- j
- _
- ) -> i GHC.Classes.== j
- )
- loopInput
- failInp
- then
- let _ = "choicesBranch checkedHorizon=0"
- in do
- sr <- GHC.STRef.readSTRef reg
- let _ = "pushValue"
- in let _ = "lift2Value checkedHorizon=0"
- in let _ = "lift2Value checkedHorizon=0"
- in let _ = "comment: satisfy ((GHC.Classes.==) 'b')"
- in let inp = failInp
- in let readFail = finalRaise
+ }
+ )
+ in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp)
+ in let partialCont buf =
+ let readFail = Symantic.Parser.Machine.Generate.unForallOnException finalRaise
+ in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
+ in if readMore buf initPos
+ then
+ let
+ in let _ = "pushValue"
+ in let _ = "pushValue"
+ in do
+ let dupv = \u -> u
+ reg <- GHC.STRef.newSTRef dupv
+ let _ = "iter"
+ in let onException loopInput =
+ let _ = "onException"
+ in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
+ let _ = "comment: raiseAgainIfConsumed"
+ in let _ = "saveInput checkedHorizon=0"
+ in let _ = "lift2Value checkedHorizon=0"
+ in if (GHC.Classes.==) @GHC.Types.Int loopInput failInp
+ then
+ let _ = "choicesBranch checkedHorizon=0"
+ in do
+ sr <- GHC.STRef.readSTRef reg
+ let _ = "pushValue"
+ in let _ = "lift2Value checkedHorizon=0"
+ in let _ = "lift2Value checkedHorizon=0"
+ in let _ = "comment: satisfy ((GHC.Classes.==) 'b')"
+ in let partialCont buf =
+ let readFail = Symantic.Parser.Machine.Generate.unForallOnException finalRaise
in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
- in if readMore inp
+ in if readMore buf failInp
then
let _ = "checkToken"
in let !(#
c,
cs
- #) = readNext inp
+ #) = readNext buf failInp
in if (GHC.Classes.==) 'b' c
then
let _ = "lift2Value checkedHorizon=1"
in GHC.Show.show (sr GHC.Types . [])
)
cs
+ buf
+ end
else
let _ = "checkToken.fail"
in let failExp =
in let (#
farInp,
farExp
- #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of
+ #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
GHC.Types.LT ->
(#
- inp,
+ failInp,
failExp
#)
GHC.Types.EQ ->
farInp,
farExp
#)
- in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp
+ in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
else
let _ = "checkHorizon.newCheck.fail"
- 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' 1
- )
- )
- Data.Set.Internal.Tip
- Data.Set.Internal.Tip
- in let (#
- farInp,
- farExp
- #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) farInp inp of
- GHC.Types.LT ->
- (#
- inp,
- failExp
- #)
- GHC.Types.EQ ->
- (#
- farInp,
- failExp GHC.Base.<> farExp
- #)
- GHC.Types.GT ->
- (#
+ in let noMoreInput =
+ 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' 1
+ )
+ )
+ Data.Set.Internal.Tip
+ Data.Set.Internal.Tip
+ in let (#
farInp,
farExp
- #)
- in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp
- else
- let _ = "choicesBranch.else"
- in finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp
- loop = \_callerOnReturn callerInput callerOnExceptionStackByLabel ->
- let _ = "pushValue"
- in let _ = "comment: satisfy ((GHC.Classes.==) 'a')"
- in let inp = callerInput
- in let readFail = onException callerInput
+ #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
+ GHC.Types.LT ->
+ (#
+ failInp,
+ failExp
+ #)
+ GHC.Types.EQ ->
+ (#
+ farInp,
+ failExp GHC.Base.<> farExp
+ #)
+ GHC.Types.GT ->
+ (#
+ farInp,
+ farExp
+ #)
+ in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf GHC.Types.True
+ in if end
+ then noMoreInput
+ else
+ Symantic.Parser.Machine.Generate.returnST GHC.Base.$
+ ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
+ ( \newInput ->
+ if Symantic.Parser.Machine.Input.nullInput newInput
+ then noMoreInput
+ else partialCont (append buf newInput)
+ )
+ )
+ in partialCont buf
+ else
+ let _ = "choicesBranch.else"
+ in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
+ loop = \_callerOnReturn callerInput callerBuffer callerEnded callerOnExceptionStackByLabel ->
+ let _ = "pushValue"
+ in let _ = "comment: satisfy ((GHC.Classes.==) 'a')"
+ in let partialCont buf =
+ let readFail = onException callerInput
in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
- in if readMore inp
+ in if readMore buf callerInput
then
let _ = "checkToken"
in let !(#
c,
cs
- #) = readNext inp
+ #) = readNext buf callerInput
in if (GHC.Classes.==) 'a' c
then
let _ = "lift2Value checkedHorizon=1"
sr <- GHC.STRef.readSTRef reg
let _ = "lift2Value checkedHorizon=1"
in do
- let dupv = \x -> sr ((GHC.Types.:) 'a' x)
+ let dupv = \u -> sr ((GHC.Types.:) 'a' u)
GHC.STRef.writeSTRef reg dupv
let _ = "jump"
- in loop (GHC.Err.error "invalid onReturn") cs (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
+ in loop (GHC.Err.error "invalid onReturn") cs buf callerEnded (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
else
let _ = "checkToken.fail"
in let failExp =
in let (#
farInp,
farExp
- #) = case (GHC.Classes.compare `Data.Function.on` Symantic.Parser.Machine.Input.offset) init inp of
+ #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
GHC.Types.LT ->
(#
- inp,
+ callerInput,
failExp
#)
GHC.Types.EQ ->
(#
- init,
+ initPos,
failExp GHC.Base.<> Data.Set.Internal.empty
#)
GHC.Types.GT ->
(#
- init,
+ initPos,
Data.Set.Internal.empty
#)
- in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp
+ in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf callerEnded
else
let _ = "checkHorizon.newCheck.fail"
- 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' 1
- )
- )
- Data.Set.Internal.Tip
- Data.Set.Internal.Tip
- in let (#
- 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
- in let _ = "jump"
- in loop finalRet inp Data.Map.Internal.Tip
- else
- let _ = "checkHorizon.newCheck.fail"
- 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' 1
+ in let noMoreInput =
+ 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' 1
+ )
+ )
+ Data.Set.Internal.Tip
+ Data.Set.Internal.Tip
+ in let (#
+ farInp,
+ farExp
+ #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
+ GHC.Types.LT ->
+ (#
+ callerInput,
+ failExp
+ #)
+ GHC.Types.EQ ->
+ (#
+ initPos,
+ failExp GHC.Base.<> Data.Set.Internal.empty
+ #)
+ GHC.Types.GT ->
+ (#
+ initPos,
+ Data.Set.Internal.empty
+ #)
+ in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
+ in if callerEnded
+ then noMoreInput
+ else
+ Symantic.Parser.Machine.Generate.returnST GHC.Base.$
+ ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
+ ( \newInput ->
+ if Symantic.Parser.Machine.Input.nullInput newInput
+ then noMoreInput
+ else partialCont (append buf newInput)
+ )
+ )
+ in partialCont callerBuffer
+ in let _ = "jump"
+ in loop finalRet initPos buf GHC.Types.False Data.Map.Internal.Tip
+ else
+ let _ = "checkHorizon.newCheck.fail"
+ in let noMoreInput =
+ 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' 1
+ )
+ )
+ Data.Set.Internal.Tip
+ Data.Set.Internal.Tip
+ in let (#
+ farInp,
+ farExp
+ #) = case GHC.Classes.compare @GHC.Types.Int initPos initPos of
+ GHC.Types.LT ->
+ (#
+ initPos,
+ failExp
+ #)
+ GHC.Types.EQ ->
+ (#
+ initPos,
+ failExp GHC.Base.<> Data.Set.Internal.empty
+ #)
+ GHC.Types.GT ->
+ (#
+ initPos,
+ Data.Set.Internal.empty
+ #)
+ in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure initPos farInp farExp buf GHC.Types.True
+ in if GHC.Types.False
+ then noMoreInput
+ else
+ Symantic.Parser.Machine.Generate.returnST GHC.Base.$
+ ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
+ ( \newInput ->
+ if Symantic.Parser.Machine.Input.nullInput newInput
+ then noMoreInput
+ else partialCont (append buf newInput)
)
)
- Data.Set.Internal.Tip
- Data.Set.Internal.Tip
- in let (#
- 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 finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp
- )
+ in partialCont initBuffer
sourcephile / git / haskell / symantic-parser.git / blobdiff