{-# 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 Message s pos
_ = state -> state
forall a. a -> a
id
insertSymbol :: s -> state -> state
insertSymbol s
_ = state -> state
forall a. a -> a
id
deleteSymbol :: s -> state -> state
deleteSymbol s
_ = 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 s
b = Int#
5#
symBefore = [Char] -> s -> s
forall a. HasCallStack => [Char] -> a
error [Char]
"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 [Char]
"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 { forall val s p. Steps val s p -> Steps val s p
rest :: Steps val s p}
| Cost {forall val s p. Steps val s p -> Int#
costing::Int# , rest :: Steps val s p}
| StRepair {costing::Int# , forall val s p. 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 :: forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
val a -> b
f (OkVal a -> a
a 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 a -> b
f (Ok 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 a -> b
f (Cost Int#
i 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 a -> b
f (StRepair Int#
c Message s p
m 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 a -> b
f (Best Steps a s p
l Steps a s p
s 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 a -> b
f (NoMoreSteps 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 :: forall a s p. Steps a s p -> a
evalSteps (OkVal a -> a
v 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 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 Int#
_ 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 Int#
_ Message s p
msg 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 Steps a s p
_ Steps a s p
rest Steps a s p
_) = Steps a s p -> a
forall a s p. Steps a s p -> a
evalSteps Steps a s p
rest
evalSteps (NoMoreSteps a
v ) = a
v
getMsgs :: Steps a s p -> [Message s p]
getMsgs :: forall a s p. Steps a s p -> [Message s p]
getMsgs (OkVal a -> a
_ 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 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 Int#
_ 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 Int#
_ Message s p
m 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 Steps a s p
_ Steps a s p
m Steps a s p
_) = 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 a
_ ) = []
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 SymbolR s
s) = SymbolR s -> [Char]
forall a. Show a => a -> [Char]
show SymbolR s
s
show (EStr [Char]
str) = [Char]
str
show (EOr []) = [Char]
"Nothing expected "
show (EOr [Expecting s
e]) = Expecting s -> [Char]
forall a. Show a => a -> [Char]
show Expecting s
e
show (EOr (Expecting s
e:[Expecting s]
ee)) = Expecting s -> [Char]
forall a. Show a => a -> [Char]
show Expecting s
e [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" 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 [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 s
expecting p
position Action s
action)
= [Char]
"\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]
++
[Char]
"\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]
++
[Char]
"\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]
++[Char]
"\n"
instance Show s => Show (Action s) where
show :: Action s -> [Char]
show (Insert s
s) = [Char]
"inserting: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ s -> [Char]
forall a. Show a => a -> [Char]
show s
s
show (Delete s
s) = [Char]
"deleting: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ s -> [Char]
forall a. Show a => a -> [Char]
show s
s
show (Other [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
$ccompare :: forall s. Ord s => Expecting s -> Expecting s -> Ordering
compare :: Expecting s -> Expecting s -> Ordering
$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
>= :: Expecting s -> Expecting s -> Bool
$cmax :: forall s. Ord s => Expecting s -> Expecting s -> Expecting s
max :: Expecting s -> Expecting s -> Expecting s
$cmin :: forall s. Ord s => Expecting s -> Expecting s -> Expecting s
min :: Expecting s -> Expecting s -> 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
$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
/= :: 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
$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
/= :: 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
$ccompare :: forall s. Ord s => SymbolR s -> SymbolR s -> Ordering
compare :: SymbolR s -> SymbolR s -> Ordering
$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
>= :: SymbolR s -> SymbolR s -> Bool
$cmax :: forall s. Ord s => SymbolR s -> SymbolR s -> SymbolR s
max :: SymbolR s -> SymbolR s -> SymbolR s
$cmin :: forall s. Ord s => SymbolR s -> SymbolR s -> SymbolR s
min :: SymbolR s -> SymbolR s -> SymbolR s
Ord)
instance (Eq s,Show s) => Show (SymbolR s) where
show :: SymbolR s -> [Char]
show SymbolR s
EmptyR = [Char]
"the empty range"
show (Range s
a 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]
".." [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 s
l 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 a
l 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 (\ 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 a
l 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 (\ 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)
SymbolR a
range except :: SymbolR a -> t a -> [SymbolR a]
`except` t a
elems
= (a -> [SymbolR a] -> [SymbolR a])
-> [SymbolR a] -> t a -> [SymbolR a]
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> [SymbolR a] -> [SymbolR a]
forall {s}. (Ord s, Symbol s) => s -> [SymbolR s] -> [SymbolR s]
removeelem [SymbolR a
range] t a
elems
where removeelem :: s -> [SymbolR s] -> [SymbolR s]
removeelem s
elem [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]
SymbolR s
EmptyR minus :: SymbolR s -> s -> [SymbolR s]
`minus` s
_ = []
ran :: SymbolR s
ran@(Range s
l s
r) `minus` 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 [Char]
m = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char]
"Your grammar contains a problem:\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
m)
systemerror :: [Char] -> [Char] -> a
systemerror [Char]
modname [Char]
m
= [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char]
"I apologise: I made a mistake in my design. This should not have happened.\n"
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[Char]
" Please report: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
modname [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
m [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" to doaitse@cs.uu.nl\n")