kztk-m / flippre

Imported from Bitbucket for its sunsetting support of Mercurial.
BSD 3-Clause "New" or "Revised" License
1 stars 1 forks source link

Bug: Unexpected behaviour of `AM.union` together with `<>` #5

Open nuernbergk opened 3 weeks ago

nuernbergk commented 3 weeks ago

In the code

{-# LANGUAGE TemplateHaskell           #-}
{-# LANGUAGE TypeOperators             #-}

-- To suppress warnings caused by TH code.
{-# LANGUAGE MonoLocalBinds            #-}

import           Prelude
import           Data.Word (Word64)
import           Numeric (showHex, showOct)
import           Text.FliPpr
import           Text.FliPpr.Driver.Earley as E
import qualified Text.FliPpr.Automaton     as AM

data OK = OK
    deriving (Show, Eq)

digit :: AM.DFA Char
digit = AM.range '0' '9'

exponentExp :: AM.DFA Char
exponentExp = AM.union (AM.singleton 'e') (AM.singleton 'E')
               <> (AM.plus digit)

exponentExp' :: AM.DFA Char
exponentExp' = AM.union (AM.singleton 'e' <> AM.plus digit) (AM.singleton 'E' <> AM.plus digit)

printExp :: FliPprD a e => FliPprM e (A a OK -> E e D)
printExp = define $ \x -> case_ x [constp $ \s -> textAs s exponentExp]
  where constp = Branch (PartialBij "constp" (Just . const "OK") (Just . const OK))

printExp' :: FliPprD a e => FliPprM e (A a OK -> E e D)
printExp' = define $ \x -> case_ x [constp $ \s -> textAs s exponentExp']
  where constp = Branch (PartialBij "constp" (Just . const "OK") (Just . const OK))

parseExp :: [Char] -> Err [OK]
parseExp = E.parse $ parsingMode (flippr $ fromFunction <$> printExp)

parseExp' :: [Char] -> Err [OK]
parseExp' = E.parse $ parsingMode (flippr $ fromFunction <$> printExp')

parseExp and parseExp' should parse the same values (simply by the definition of the automata). However, they don't. The latter parses "E3", while the latter gives the following error message:

ghci> parseExp "E3"
*** Exception: RangeSet.List.findMin: empty set
CallStack (from HasCallStack):
  error, called at src/Data/RangeSet/List.hs:313:32 in range-set-list-0.1.3.1-GdDRYX7ZhQuDGO9hT50ao5:Data.RangeSet.List

Unfortunately, couldn't figure out how to print the grammars using pretty (type bounds couldn't be resolved automatically).

kztk-m commented 3 weeks ago

Fixed in the "restructure" branch.

ghci> pretty (union (singleton 'e') (singleton 'E') <> plus digit)
State(s): fromList [0,2,3,4]
Initial:  3
Final(s): fromList [0]
Transition(s):
0 -> ['\NUL'-'/'':'-'\1114111'] 4 | ['0'-'9'] 0;
2 -> ['\NUL'-'/'':'-'\1114111'] 4 | ['0'-'9'] 0;
3 -> ['\NUL'-'D''F'-'d''f'-'\1114111'] 4 | ['E''e'] 2;
4 -> ['\NUL'-'\1114111'] 4
ghci> pretty (union (singleton 'e' <> plus digit) (singleton 'E' <> plus digit))
State(s): fromList [2,5,6,9]
Initial:  6
Final(s): fromList [2]
Transition(s):
2 -> ['\NUL'-'/'':'-'\1114111'] 9 | ['0'-'9'] 2;
5 -> ['\NUL'-'/'':'-'\1114111'] 9 | ['0'-'9'] 2;
6 -> ['\NUL'-'D''F'-'d''f'-'\1114111'] 9 | ['E''e'] 5;
9 -> ['\NUL'-'\1114111'] 9