DFA.hs

{-# LANGUAGE ExistentialQuantification #-}
-- DFA borrowed from Romain Ruetschi on github: https://gist.github.com/romac/9193493

module DFA (
  DFA(..),
  runDFA,
  scanDFA,
  isAccepting,
) where

import Data.Set (Set)
import qualified Data.Set as Set

data DFA state input = Ord state => DFA
  (Set state)               -- available states
  (Set input)               -- alphabet
  (state -> input -> state) -- transition function
  state                     -- starting state
  (Set state)               -- accepting states

isAccepting :: DFA state input -> state -> Bool
isAccepting (DFA states alphabet delta start accepting) state =
  Set.member state accepting

scanDFA :: DFA state input -> [input] -> [state]
scanDFA (DFA state alphabet delta start accepting) input =
  scanl delta start input

runDFA :: DFA state input -> [input] -> (Bool, [state])
runDFA dfa input = (isAccepting dfa (last states), states)
  where states = scanDFA dfa input

DFAExamples.hs

module DFAExamples (dfa) where

import qualified Data.Set as Set
import DFA (DFA(..))


data State = Q1 | Q2 deriving (Eq, Ord, Read, Show)
type Input = Char

delta :: State -> Input -> State
delta Q1 '0' = Q2
delta Q1 '1' = Q1
delta Q2 '1' = Q2
delta Q2 '0' = Q1

dfa :: DFA State Input
dfa = DFA (Set.fromList [Q1, Q2]) (Set.fromList ['0', '1']) delta Q1 (Set.singleton Q2)

MonoidMachine.hs

{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}

{--
  MonoidMachine is inspired by:
    Matos, Armando B., 2006, "Monoid machines: a O(log n) parser for regular languages", http://www.dcc.fc.up.pt/~acm/semigr.pdf
  I don't actually implement the (log n) parallel parsing algorithm, I just play around with the definition of a monoid machine and the proof that every deterministic finite automata has a monoid machine.
--}
module MonoidMachine (
  MonoidMachine(..),
  translate,
  runMonoidMachine
) where

import DFA (DFA(..))
import Data.Set (member)
import Data.Monoid (Endo(..))

data MonoidMachine monoid input = Monoid monoid =>  MonoidMachine
  (input  -> monoid)
  (monoid -> Bool)

-- From the proof of Theorem 1 in the paper.
translate :: DFA state input -> MonoidMachine (Endo state) input
translate (DFA _ _ delta initial accepting) = MonoidMachine f g where
  f a = Endo (\q -> delta q a)
  g (Endo h) = h initial `member` accepting

runMonoidMachine :: MonoidMachine monoid input -> [input] -> Bool
runMonoidMachine (MonoidMachine f g) = g . mconcat . map f