Adding another alphabet for learning

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
+  putStrLn "ALPHABET"
-      prefs = singleOrbit []
+  alph <- getLine
-      prefsExt = productWith ext prefs alph
+  case alph of
-      suffs = singleOrbit []
+    "ATOMS" -> do
-      table = Map.empty
+      aut <- evalStateT (fillTable askMember >> learn askMember askEquiv) (init rationals)
-      init = Observations{..}
+      return ()
-  aut <- evalStateT (fillTable askMember >> learn askMember askEquiv) init
+    "FIFO" -> do
-  return ()
+      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

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"