A little bit more on Mealy machines and updates the README

README.md

@@ -1,19 +1,13 @@
 Learning Nominal Automata
 =========================
 
-*NOTE*: Please download the archive `popl-artifact.zip`. This contains the
-specific versions (of this and nlambda) used for the POPL submission.
-This archive should contain a similar README, with simpler instructions.
-If you want the newest version of the software, then don't use that
-archive, but use the code in this repository.
-
-
 # Dependencies
 
 This artifact was tested on a Debian system. During development both Mac and
 Windows have been used, so it should work on these operating systems too. Note
 that you will need the Z3 solver (as executable). The algorithms are
 implemented in Haskell and you will need a recent GHC (at least 7.10).
+Currently, GHC 9.10 is used in the development.
 
 We use the library [nlambda](https://github.com/szynwelski/nlambda). It
 is recommended to use the most recent version. Just grab the source and
@@ -26,24 +20,28 @@ Follow the build guide on their website.
 
 # Building
 
-You can use the stack tool. Make sure to include nlambda as a package.
+The `cabal` build tool should suffice. Please put both this repository and
-It should be a matter of `stack build`, if not, stack will probably
+the nlambda repository somehwere, and add a `cabal.project` file with the
-tell you what to do. (If you need any help, send me a message.)
+following contents:
+```
+packages: nominal-lstar nlambda
+```
+Then a simple `cabal build all` should do it. To test whether everything
+works, run `cabal test nominal-lstar`. (Please get in touch if you have
+trouble setting it up.)
 
 
 # Running
 
-Stack will produce a binary in the `.stack-works` directory, which can
+Run `cabal run nominal-lstar` within the `nominal-lstar` directory.
-be invoked directly. Alternatively one can run `stack exec nominal-lstar`.
-There is two modes of operation: Running the examples, or running it
-interactively.
 
 ## Examples
 
-The executable expects three arguments:
+The executable expects one or three arguments:
 
 ```
-stack exec NominalAngluin -- <Learner> <Oracle> <Example>
+cabal run nominal-lstar <Learner>
+cabal run nominal-lstar <Learner> <Oracle> <Example>
 ```
 
 There are three learners:
@@ -75,7 +73,7 @@ stack data structure):
 
 For example:
 ```
-stack exec nominal-lstar -- NomLStar EqDFA "Fifo 2"
+cabal run nominal-lstar NomLStar EqDFA "Fifo 2"
 ```
 
 The program will output all the intermediate hypotheses. And will terminate
@@ -95,7 +93,7 @@ We proved by hand that the learnt model did indeed accept the language.
 
 Run the tool like so:
 ```
-stack exec nominal-lstar -- <Leaner>
+cabal run nominal-lstar <Leaner>
 ```
 (So similar to the above case, but without specifying the equivalence
 checker and example.) The tool will ask you membership queries and
@@ -147,6 +145,9 @@ A:
 
 # Changes since first release
 
+The original version of the tool, presented at POPL, is commit e1b00e1 (from
+2016). Since then, some new features are implemented:
+
 * Better support for interactive communication.
 * Optimisation: add only one row/column to fix closedness/consistency
 * Simpler observation table

test/Spec.hs

@@ -14,25 +14,38 @@ import Test.Tasty
 import Test.Tasty.HUnit
 
 main :: IO ()
-main = defaultMain (testGroup "Unit tests" unitTests)
+main = defaultMain (testGroup "Unit tests" [dfaLearning, mealyBasics])
   where
-    unitTests =
+    dfaLearning =
-        [ testCase "Learning DFA DW1" $ learnAndCompare (runningExample atoms 1) @?= True
+        testGroup
-        , testCase "Learning DFA DW2" $ learnAndCompare (runningExample atoms 2) @?= True
+            "DFA Learning"
-        , testCase "Mealy deterministic echo" $ isTrue (mealyIsDeterministic echoMachine) @?= True
+            [ testCase "Learning DFA DW1" $ learnDFAAndCompare (runningExample atoms 1) @?= True
+            , testCase "Learning DFA DW2" $ learnDFAAndCompare (runningExample atoms 2) @?= True
+            ]
+    mealyBasics =
+        testGroup
+            "Mealy Basics"
+            [ testCase "Mealy deterministic echo" $ isTrue (mealyIsDeterministic echoMachine) @?= True
             , testCase "Mealy deterministic memory True" $ isTrue (mealyIsDeterministic (memoryMachine True)) @?= True
             , testCase "Mealy deterministic memory False" $ isTrue (mealyIsDeterministic (memoryMachine False)) @?= True
             , testCase "Mealy enabled echo" $ isTrue (mealyIsEnabled echoMachine) @?= True
             , testCase "Mealy enabled memory True" $ isTrue (mealyIsEnabled (memoryMachine True)) @?= True
             , testCase "Mealy enabled memory False" $ isTrue (mealyIsEnabled (memoryMachine False)) @?= True
+            , testCase "Mealy reachable echo" $ isTrue (mealyReachable echoMachine `eq` singleton ()) @?= True
+            , testCase "Mealy reachable memory True" $ isTrue (mealyReachable (memoryMachine True) `eq` (singleton Nothing `union` NLambda.map Just atoms)) @?= True
+            , testCase "Mealy reachable memory False" $ isTrue (mealyReachable (memoryMachine False) `eq` (singleton Nothing `union` NLambda.map Just atoms)) @?= True
             ]
 
-learnAndCompare :: (Contextual i, Show i, Nominal i, Nominal q1) => Automaton q1 i -> Bool
+learnDFAAndCompare :: (Contextual i, Show i, Nominal i, Nominal q1) => Automaton q1 i -> Bool
-learnAndCompare target = equivalenceCheck target learnedModel
+learnDFAAndCompare target = equivalenceCheck target learnedModel
   where
     learnedModel = learnAngluin (teacherWithTarget target)
     equivalenceCheck m1 m2 = isTrue . isEmpty $ bisim m1 m2
 
+{- *******************************************************************
+   Basic data structure for Nominal Mealy machines and basic functions to
+   check whether they are deterministic and input-enabled.
+-}
 data MealyMachine s i o = MealyMachine
     { mealyInitialState :: s
     , mealyStates :: Set s
@@ -47,14 +60,35 @@ mealyIsDeterministic m = forAll (\s -> forAll (\i -> let ot = mapFilter ((\(s2,
 mealyIsEnabled :: _ => MealyMachine s i o -> Formula
 mealyIsEnabled m = forAll (\s -> forAll (\i -> let ot = mapFilter ((\(s2, i2, o, t) -> maybeIf ((s, i) `eq` (s2, i2)) (o, t))) (mealyTransitions m) in isNotEmpty ot) (mealyInputs m)) (mealyStates m)
 
+-- Computes all reachable states
+mealyReachable :: _ => MealyMachine s i o -> Set s
+mealyReachable m = go (singleton (mealyInitialState m)) empty
+  where
+    go todo visited =
+      ite (isEmpty todo)
+      {- then -} visited
+      {- else -} (let v = visited `union` todo
+                      s = successors todo
+                    in go (s \\ v) v)
+    successors todo = NLambda.sum (pairsWith (\s i -> mapFilter ((\(s2, i2, _, t) -> maybeIf ((s, i) `eq` (s2, i2)) t)) (mealyTransitions m)) todo (mealyInputs m))
+
+{- *******************************************************************
+   EXAMPLE MEALY MACHINES
+-}
+
+-- Immediately echoes the input (of type Atom)
 echoMachine :: MealyMachine () Atom Atom
-echoMachine = MealyMachine
+echoMachine =
+    MealyMachine
         { mealyInitialState = ()
         , mealyStates = singleton ()
         , mealyInputs = atoms
         , mealyTransitions = NLambda.map (\a -> ((), a, a, ())) atoms
         }
 
+-- The next example is a memory cell to store a single atom. You can Put
+-- or Get the values. Depending on the mode, the machine can forget its
+-- value after a Get operation.
 data MIn a = MPut a | MGet
     deriving (Eq, Ord, Show, Generic, Nominal, Contextual)
 
@@ -62,12 +96,15 @@ data MOut a = MNok | MOk | MVal a
     deriving (Eq, Ord, Show, Generic, Nominal, Contextual)
 
 memoryMachine :: Bool -> MealyMachine (Maybe Atom) (MIn Atom) (MOut Atom)
-memoryMachine forget = MealyMachine
+memoryMachine forget =
+    MealyMachine
         { mealyInitialState = Nothing
         , mealyStates = allStates
         , mealyInputs = singleton MGet `union` NLambda.map MPut atoms
-    , mealyTransitions = NLambda.pairsWith (\q a -> (q, MPut a, MOk, Just a)) allStates atoms `union`
+        , mealyTransitions =
-                         NLambda.map (\a -> (Just a, MGet, MVal a, if forget then Nothing else Just a)) atoms `union`
+            NLambda.pairsWith (\q a -> (q, MPut a, MOk, Just a)) allStates atoms
-                         NLambda.singleton (Nothing, MGet, MNok, Nothing)
+                `union` NLambda.map (\a -> (Just a, MGet, MVal a, if forget then Nothing else Just a)) atoms
+                `union` NLambda.singleton (Nothing, MGet, MNok, Nothing)
         }
-  where allStates = singleton Nothing `union` (NLambda.map Just atoms)
+  where
+    allStates = singleton Nothing `union` (NLambda.map Just atoms)