{-# LANGUAGE MagicHash,
UnboxedTuples #-}
module UU.Parsing.MachineInterface where
import GHC.Prim
class InputState state s pos | state -> s, state -> pos where
splitStateE :: state -> Either' state s
splitState :: state -> (# s, state #)
getPosition :: state -> pos
reportError :: Message s pos -> state -> state
reportError _ = state -> state
forall a. a -> a
id
insertSymbol :: s -> state -> state
insertSymbol _ = state -> state
forall a. a -> a
id
deleteSymbol :: s -> state -> state
deleteSymbol _ = state -> state
forall a. a -> a
id
class OutputState r where
acceptR :: v -> rest -> r v rest
nextR :: (a -> rest -> rest') -> (b -> a) -> (r b rest) -> rest'
class Symbol s where
deleteCost :: s -> Int#
symBefore :: s -> s
symAfter :: s -> s
deleteCost b :: s
b = 5#
symBefore = [Char] -> s -> s
forall a. HasCallStack => [Char] -> a
error "You should have made your token type an instance of the Class Symbol. eg by defining symBefore = pred"
symAfter = [Char] -> s -> s
forall a. HasCallStack => [Char] -> a
error "You should have made your token type an instance of the Class Symbol. eg by defining symAfter = succ"
data Either' state s = Left' !s (state )
| Right' (state )
data Steps val s p
= forall a . OkVal (a -> val) (Steps a s p)
| Ok { Steps val s p -> Steps val s p
rest :: Steps val s p}
| Cost {Steps val s p -> Int#
costing::Int# , rest :: Steps val s p}
| StRepair {costing::Int# , Steps val s p -> Message s p
m :: !(Message s p) , rest :: Steps val s p}
| Best (Steps val s p) (Steps val s p) ( Steps val s p)
| NoMoreSteps val
data Action s = Insert s
| Delete s
| Other String
val :: (a -> b) -> Steps a s p -> Steps b s p
val :: (a -> b) -> Steps a s p -> Steps b s p
val f :: a -> b
f (OkVal a :: a -> a
a rest :: Steps a s p
rest) = (a -> b) -> Steps a s p -> Steps b s p
forall val s p a. (a -> val) -> Steps a s p -> Steps val s p
OkVal (a -> b
f(a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> a
a) Steps a s p
rest
val f :: a -> b
f (Ok rest :: Steps a s p
rest) = (a -> b) -> Steps a s p -> Steps b s p
forall val s p a. (a -> val) -> Steps a s p -> Steps val s p
OkVal a -> b
f Steps a s p
rest
val f :: a -> b
f (Cost i :: Int#
i rest :: Steps a s p
rest) = Int# -> Steps b s p -> Steps b s p
forall val s p. Int# -> Steps val s p -> Steps val s p
Cost Int#
i ((a -> b) -> Steps a s p -> Steps b s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val a -> b
f Steps a s p
rest)
val f :: a -> b
f (StRepair c :: Int#
c m :: Message s p
m r :: Steps a s p
r) = Int# -> Message s p -> Steps b s p -> Steps b s p
forall val s p.
Int# -> Message s p -> Steps val s p -> Steps val s p
StRepair Int#
c Message s p
m ((a -> b) -> Steps a s p -> Steps b s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val a -> b
f Steps a s p
r)
val f :: a -> b
f (Best l :: Steps a s p
l s :: Steps a s p
s r :: Steps a s p
r) = Steps b s p -> Steps b s p -> Steps b s p -> Steps b s p
forall val s p.
Steps val s p -> Steps val s p -> Steps val s p -> Steps val s p
Best ((a -> b) -> Steps a s p -> Steps b s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val a -> b
f Steps a s p
l) ((a -> b) -> Steps a s p -> Steps b s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val a -> b
f Steps a s p
s) ((a -> b) -> Steps a s p -> Steps b s p
forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val a -> b
f Steps a s p
r)
val f :: a -> b
f (NoMoreSteps v :: a
v) = b -> Steps b s p
forall val s p. val -> Steps val s p
NoMoreSteps (a -> b
f a
v)
evalSteps :: Steps a s p -> a
evalSteps :: Steps a s p -> a
evalSteps (OkVal v :: a -> a
v rest :: Steps a s p
rest ) = a -> a
v (Steps a s p -> a
forall a s p. Steps a s p -> a
evalSteps Steps a s p
rest)
evalSteps (Ok rest :: Steps a s p
rest ) = Steps a s p -> a
forall a s p. Steps a s p -> a
evalSteps Steps a s p
rest
evalSteps (Cost _ rest :: Steps a s p
rest ) = Steps a s p -> a
forall a s p. Steps a s p -> a
evalSteps Steps a s p
rest
evalSteps (StRepair _ msg :: Message s p
msg rest :: Steps a s p
rest ) = Steps a s p -> a
forall a s p. Steps a s p -> a
evalSteps Steps a s p
rest
evalSteps (Best _ rest :: Steps a s p
rest _) = Steps a s p -> a
forall a s p. Steps a s p -> a
evalSteps Steps a s p
rest
evalSteps (NoMoreSteps v :: a
v ) = a
v
getMsgs :: Steps a s p -> [Message s p]
getMsgs :: Steps a s p -> [Message s p]
getMsgs (OkVal _ rest :: Steps a s p
rest) = Steps a s p -> [Message s p]
forall a s p. Steps a s p -> [Message s p]
getMsgs Steps a s p
rest
getMsgs (Ok rest :: Steps a s p
rest) = Steps a s p -> [Message s p]
forall a s p. Steps a s p -> [Message s p]
getMsgs Steps a s p
rest
getMsgs (Cost _ rest :: Steps a s p
rest) = Steps a s p -> [Message s p]
forall a s p. Steps a s p -> [Message s p]
getMsgs Steps a s p
rest
getMsgs (StRepair _ m :: Message s p
m rest :: Steps a s p
rest) = Message s p
mMessage s p -> [Message s p] -> [Message s p]
forall a. a -> [a] -> [a]
:Steps a s p -> [Message s p]
forall a s p. Steps a s p -> [Message s p]
getMsgs Steps a s p
rest
getMsgs (Best _ m :: Steps a s p
m _) = Steps a s p -> [Message s p]
forall a s p. Steps a s p -> [Message s p]
getMsgs Steps a s p
m
getMsgs (NoMoreSteps _ ) = []
data Message sym pos = Msg (Expecting sym) !pos (Action sym)
instance (Eq s, Show s) => Show (Expecting s) where
show :: Expecting s -> [Char]
show (ESym s :: SymbolR s
s) = SymbolR s -> [Char]
forall a. Show a => a -> [Char]
show SymbolR s
s
show (EStr str :: [Char]
str) = [Char]
str
show (EOr []) = "Nothing expected "
show (EOr [e :: Expecting s
e]) = Expecting s -> [Char]
forall a. Show a => a -> [Char]
show Expecting s
e
show (EOr (e :: Expecting s
e:ee :: [Expecting s]
ee)) = Expecting s -> [Char]
forall a. Show a => a -> [Char]
show Expecting s
e [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " or " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Expecting s -> [Char]
forall a. Show a => a -> [Char]
show ([Expecting s] -> Expecting s
forall s. [Expecting s] -> Expecting s
EOr [Expecting s]
ee)
show (ESeq seq :: [Expecting s]
seq) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Expecting s -> [Char]) -> [Expecting s] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Expecting s -> [Char]
forall a. Show a => a -> [Char]
show [Expecting s]
seq)
instance (Eq s, Show s, Show p) => Show (Message s p) where
show :: Message s p -> [Char]
show (Msg expecting :: Expecting s
expecting position :: p
position action :: Action s
action)
= "\n?? Error : " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ p -> [Char]
forall a. Show a => a -> [Char]
show p
position [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
"\n?? Expecting : " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Expecting s -> [Char]
forall a. Show a => a -> [Char]
show Expecting s
expecting [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
"\n?? Repaired by: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Action s -> [Char]
forall a. Show a => a -> [Char]
show Action s
action [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++"\n"
instance Show s => Show (Action s) where
show :: Action s -> [Char]
show (Insert s :: s
s) = "inserting: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ s -> [Char]
forall a. Show a => a -> [Char]
show s
s
show (Delete s :: s
s) = "deleting: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ s -> [Char]
forall a. Show a => a -> [Char]
show s
s
show (Other s :: [Char]
s) = [Char]
s
data Expecting s = ESym (SymbolR s)
| EStr String
| EOr [Expecting s]
| ESeq [Expecting s]
deriving (Eq (Expecting s)
Eq (Expecting s) =>
(Expecting s -> Expecting s -> Ordering)
-> (Expecting s -> Expecting s -> Bool)
-> (Expecting s -> Expecting s -> Bool)
-> (Expecting s -> Expecting s -> Bool)
-> (Expecting s -> Expecting s -> Bool)
-> (Expecting s -> Expecting s -> Expecting s)
-> (Expecting s -> Expecting s -> Expecting s)
-> Ord (Expecting s)
Expecting s -> Expecting s -> Bool
Expecting s -> Expecting s -> Ordering
Expecting s -> Expecting s -> Expecting s
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall s. Ord s => Eq (Expecting s)
forall s. Ord s => Expecting s -> Expecting s -> Bool
forall s. Ord s => Expecting s -> Expecting s -> Ordering
forall s. Ord s => Expecting s -> Expecting s -> Expecting s
min :: Expecting s -> Expecting s -> Expecting s
$cmin :: forall s. Ord s => Expecting s -> Expecting s -> Expecting s
max :: Expecting s -> Expecting s -> Expecting s
$cmax :: forall s. Ord s => Expecting s -> Expecting s -> Expecting s
>= :: Expecting s -> Expecting s -> Bool
$c>= :: forall s. Ord s => Expecting s -> Expecting s -> Bool
> :: Expecting s -> Expecting s -> Bool
$c> :: forall s. Ord s => Expecting s -> Expecting s -> Bool
<= :: Expecting s -> Expecting s -> Bool
$c<= :: forall s. Ord s => Expecting s -> Expecting s -> Bool
< :: Expecting s -> Expecting s -> Bool
$c< :: forall s. Ord s => Expecting s -> Expecting s -> Bool
compare :: Expecting s -> Expecting s -> Ordering
$ccompare :: forall s. Ord s => Expecting s -> Expecting s -> Ordering
$cp1Ord :: forall s. Ord s => Eq (Expecting s)
Ord, Expecting s -> Expecting s -> Bool
(Expecting s -> Expecting s -> Bool)
-> (Expecting s -> Expecting s -> Bool) -> Eq (Expecting s)
forall s. Eq s => Expecting s -> Expecting s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expecting s -> Expecting s -> Bool
$c/= :: forall s. Eq s => Expecting s -> Expecting s -> Bool
== :: Expecting s -> Expecting s -> Bool
$c== :: forall s. Eq s => Expecting s -> Expecting s -> Bool
Eq)
data SymbolR s = Range !s !s | EmptyR deriving (SymbolR s -> SymbolR s -> Bool
(SymbolR s -> SymbolR s -> Bool)
-> (SymbolR s -> SymbolR s -> Bool) -> Eq (SymbolR s)
forall s. Eq s => SymbolR s -> SymbolR s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SymbolR s -> SymbolR s -> Bool
$c/= :: forall s. Eq s => SymbolR s -> SymbolR s -> Bool
== :: SymbolR s -> SymbolR s -> Bool
$c== :: forall s. Eq s => SymbolR s -> SymbolR s -> Bool
Eq,Eq (SymbolR s)
Eq (SymbolR s) =>
(SymbolR s -> SymbolR s -> Ordering)
-> (SymbolR s -> SymbolR s -> Bool)
-> (SymbolR s -> SymbolR s -> Bool)
-> (SymbolR s -> SymbolR s -> Bool)
-> (SymbolR s -> SymbolR s -> Bool)
-> (SymbolR s -> SymbolR s -> SymbolR s)
-> (SymbolR s -> SymbolR s -> SymbolR s)
-> Ord (SymbolR s)
SymbolR s -> SymbolR s -> Bool
SymbolR s -> SymbolR s -> Ordering
SymbolR s -> SymbolR s -> SymbolR s
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall s. Ord s => Eq (SymbolR s)
forall s. Ord s => SymbolR s -> SymbolR s -> Bool
forall s. Ord s => SymbolR s -> SymbolR s -> Ordering
forall s. Ord s => SymbolR s -> SymbolR s -> SymbolR s
min :: SymbolR s -> SymbolR s -> SymbolR s
$cmin :: forall s. Ord s => SymbolR s -> SymbolR s -> SymbolR s
max :: SymbolR s -> SymbolR s -> SymbolR s
$cmax :: forall s. Ord s => SymbolR s -> SymbolR s -> SymbolR s
>= :: SymbolR s -> SymbolR s -> Bool
$c>= :: forall s. Ord s => SymbolR s -> SymbolR s -> Bool
> :: SymbolR s -> SymbolR s -> Bool
$c> :: forall s. Ord s => SymbolR s -> SymbolR s -> Bool
<= :: SymbolR s -> SymbolR s -> Bool
$c<= :: forall s. Ord s => SymbolR s -> SymbolR s -> Bool
< :: SymbolR s -> SymbolR s -> Bool
$c< :: forall s. Ord s => SymbolR s -> SymbolR s -> Bool
compare :: SymbolR s -> SymbolR s -> Ordering
$ccompare :: forall s. Ord s => SymbolR s -> SymbolR s -> Ordering
$cp1Ord :: forall s. Ord s => Eq (SymbolR s)
Ord)
instance (Eq s,Show s) => Show (SymbolR s) where
show :: SymbolR s -> [Char]
show EmptyR = "the empty range"
show (Range a :: s
a b :: s
b) = if s
a s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
b then s -> [Char]
forall a. Show a => a -> [Char]
show s
a else s -> [Char]
forall a. Show a => a -> [Char]
show s
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ".." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ s -> [Char]
forall a. Show a => a -> [Char]
show s
b
mk_range :: s -> s -> SymbolR s
mk_range l :: s
l r :: s
r = if s
l s -> s -> Bool
forall a. Ord a => a -> a -> Bool
> s
r then SymbolR s
forall s. SymbolR s
EmptyR else s -> s -> SymbolR s
forall s. s -> s -> SymbolR s
Range s
l s
r
symInRange :: SymbolR a -> a -> Bool
symInRange (Range l :: a
l r :: a
r) = if a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
r then (a
la -> a -> Bool
forall a. Eq a => a -> a -> Bool
==)
else (\ s :: a
s -> a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
l Bool -> Bool -> Bool
&& a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
r)
symRS :: SymbolR a -> a -> Ordering
symRS (Range l :: a
l r :: a
r)
= if a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
r then (a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
l)
else (\ s :: a
s -> if a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
l then Ordering
GT
else if a
s a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
r then Ordering
LT
else Ordering
EQ)
range :: SymbolR s
range except :: SymbolR s -> t s -> [SymbolR s]
`except` elems :: t s
elems
= (s -> [SymbolR s] -> [SymbolR s])
-> [SymbolR s] -> t s -> [SymbolR s]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr s -> [SymbolR s] -> [SymbolR s]
forall s. (Ord s, Symbol s) => s -> [SymbolR s] -> [SymbolR s]
removeelem [SymbolR s
range] t s
elems
where removeelem :: s -> [SymbolR s] -> [SymbolR s]
removeelem elem :: s
elem ranges :: [SymbolR s]
ranges = [SymbolR s
r | SymbolR s
ran <- [SymbolR s]
ranges, SymbolR s
r <- SymbolR s
ran SymbolR s -> s -> [SymbolR s]
forall s. (Ord s, Symbol s) => SymbolR s -> s -> [SymbolR s]
`minus` s
elem]
EmptyR minus :: SymbolR s -> s -> [SymbolR s]
`minus` _ = []
ran :: SymbolR s
ran@(Range l :: s
l r :: s
r) `minus` elem :: s
elem = if SymbolR s -> s -> Bool
forall a. Ord a => SymbolR a -> a -> Bool
symInRange SymbolR s
ran s
elem
then [s -> s -> SymbolR s
forall s. Ord s => s -> s -> SymbolR s
mk_range s
l (s -> s
forall s. Symbol s => s -> s
symBefore s
elem), s -> s -> SymbolR s
forall s. Ord s => s -> s -> SymbolR s
mk_range (s -> s
forall s. Symbol s => s -> s
symAfter s
elem) s
r]
else [SymbolR s
ran]
usererror :: [Char] -> a
usererror m :: [Char]
m = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ("Your grammar contains a problem:\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
m)
systemerror :: [Char] -> [Char] -> a
systemerror modname :: [Char]
modname m :: [Char]
m
= [Char] -> a
forall a. HasCallStack => [Char] -> a
error ("I apologise: I made a mistake in my design. This should not have happened.\n"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
" Please report: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
modname [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
m [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " to doaitse@cs.uu.nl\n")