diff --git a/app/LStar.hs b/app/LStar.hs index 7e56d1a..53c4166 100644 --- a/app/LStar.hs +++ b/app/LStar.hs @@ -15,7 +15,7 @@ import qualified EquivariantSet as Set import Data.List (tails) import Control.Monad.State -import Prelude hiding (filter, null, elem, lookup, product, Word, map, take) +import Prelude hiding (filter, null, elem, lookup, product, Word, map, take, init) -- We use Lists, as they provide a bit more laziness type Rows a = OrbitList (Word a) @@ -175,13 +175,26 @@ askEquiv aut = do 'N':' ':w -> return $ Just (fst $ fromStr w) _ -> askEquiv aut +init alph = Observations + { alph = alph + , prefs = singleOrbit [] + , prefsExt = productWith ext (singleOrbit []) alph + , suffs = singleOrbit[] + , table = mempty + } + main :: IO () main = do - let alph = rationals - prefs = singleOrbit [] - prefsExt = productWith ext prefs alph - suffs = singleOrbit [] - table = Map.empty - init = Observations{..} - aut <- evalStateT (fillTable askMember >> learn askMember askEquiv) init - return () + putStrLn "ALPHABET" + alph <- getLine + case alph of + "ATOMS" -> do + aut <- evalStateT (fillTable askMember >> learn askMember askEquiv) (init rationals) + return () + "FIFO" -> do + let alph = map Put rationals `union` map Get rationals + aut <- evalStateT (fillTable askMember >> learn askMember askEquiv) (init alph) + return () + al -> do + putStr "Unknown alphabet " + putStrLn al diff --git a/app/OnsAutomata.hs b/app/OnsAutomata.hs index f9bc6a4..d0d9ecc 100644 --- a/app/OnsAutomata.hs +++ b/app/OnsAutomata.hs @@ -1,5 +1,9 @@ +{-# language DeriveGeneric #-} +{-# language DerivingVia #-} {-# language FlexibleContexts #-} {-# language RecordWildCards #-} +{-# language StandaloneDeriving #-} +{-# language UndecidableInstances #-} module OnsAutomata where import Data.Char (isSpace) @@ -12,6 +16,7 @@ import OrbitList as L (OrbitList, toList) import EquivariantMap as M (EquivariantMap, toList, (!)) import Prelude hiding (print, Word) +import qualified GHC.Generics as GHC type Word a = [a] @@ -32,6 +37,11 @@ accepts aut l = go (initialState aut) l go s (a:w) = go (transition aut ! (s, a)) w +-- alphetbet for the Fifo queue example +data Fifo = Put Rat | Get Rat + deriving (Eq, Ord, Show, GHC.Generic) +deriving via Generic Fifo instance Nominal Fifo + -- I do not want to give weird Show instances for basic types, so I create my -- own. This is not meant to be generic, but just enough for the queries of L*. @@ -48,6 +58,10 @@ instance ToStr Rat where instance ToStr Support where toStr (Support s) = "{" ++ toStr s ++ "}" +instance ToStr Fifo where + toStr (Put a) = "Put " ++ toStr a + toStr (Get a) = "Get " ++ toStr a + instance ToStr Bool where toStr b = show b instance ToStr Int where toStr i = show i instance ToStr a => ToStr [a] where @@ -73,3 +87,7 @@ instance FromStr a => FromStr [a] where (a, str2) = fromStr str (l, emptyStr) = fromStr (dropWhile isSpace str2) +instance FromStr Fifo where + fromStr ('P':'u':'t':' ':a) = let (x, r) = fromStr a in (Put x, r) + fromStr ('G':'e':'t':' ':a) = let (x, r) = fromStr a in (Get x, r) + fromStr _ = error "Cannot parse Fifo"