Updates it to use the new nlambda (with better support for generics).

NominalAngluin.cabal

@@ -20,11 +20,13 @@ executable NominalAngluin
     Examples.Stack,
     NLStar,
     ObservationTable,
-    Teacher
+    Teacher,
+    Teachers.Teacher,
+    Teachers.Terminal,
+    Teachers.Whitebox
   build-depends:
     base >= 4.8 && < 5,
     containers,
-    deepseq,
     haskeline,
     mtl,
     NLambda >= 1.1

src/AbstractLStar.hs

@@ -4,7 +4,6 @@ module AbstractLStar where
 import ObservationTable
 import Teacher
 
-import Control.DeepSeq (deepseq)
 import Debug.Trace
 import NLambda
 
@@ -48,7 +47,6 @@ learn :: LearnableAlphabet i
   -> State i
   -> Automaton (BRow i) i
 learn makeComplete handleCounterExample constructHypothesis teacher s =
-    deepseq s $ -- This helps ordering the traces somewhat.
     trace "##################" $
     trace "1. Making it complete and consistent" $
     let s2 = makeComplete teacher s in

src/Examples/Contrived.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 module Examples.Contrived where
 
 import           NLambda
@@ -12,8 +12,8 @@ import           GHC.Generics (Generic)
 -- Example automaton from the whiteboard. Three orbits with 0, 1 and 2
 -- registers. The third orbit has a local symmetry (S2).
 data Example1 = Initial | S1 Atom | S2 (Atom, Atom)
-  deriving (Show, Eq, Ord, Generic)
+  deriving (Show, Eq, Ord, Generic, NominalType, Contextual)
-instance BareNominalType Example1
+
 example1 :: Automaton Example1 Atom
 example1 = automaton
     -- states, 4 orbits (of which one unreachable)
@@ -36,8 +36,9 @@ example1 = automaton
 
 -- Accepts all even words (ignores the alphabet). Two orbits, with a
 -- trivial action. No registers.
-data Aut2 = Even | Odd deriving (Eq, Ord, Show, Generic)
+data Aut2 = Even | Odd
-instance BareNominalType Aut2
+  deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
+
 example2 :: Automaton Aut2 Atom
 example2 = automaton
     -- states, two orbits
@@ -55,8 +56,9 @@ example2 = automaton
 
 -- Accepts all non-empty words with the same symbol. Three orbits: the initial
 -- state, a state with a register and a sink state.
-data Aut3 = Empty | Stored Atom | Sink deriving (Eq, Ord, Show, Generic)
+data Aut3 = Empty | Stored Atom | Sink
-instance BareNominalType Aut3
+  deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
+
 example3 :: Automaton Aut3 Atom
 example3 = automaton
     -- states, three orbits
@@ -84,8 +86,8 @@ data Aut4 = Aut4Init              -- Initial state
           | Second Atom Atom      -- After reading two different symbols
           | Symm Atom Atom Atom   -- Accepting state with C3 symmetry
           | Sorted Atom Atom Atom -- State without symmetry
-  deriving (Eq, Ord, Show, Generic)
+  deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
-instance BareNominalType Aut4
+
 example4 :: Automaton Aut4 Atom
 example4 = automaton
     -- states
@@ -123,8 +125,8 @@ example4 = automaton
 
 -- Accepts all two-symbols words with different atoms
 data Aut5 = Aut5Init | Aut5Store Atom | Aut5T | Aut5F
-    deriving (Eq, Ord, Show, Generic)
+    deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
-instance BareNominalType Aut5
+
 example5 :: Automaton Aut5 Atom
 example5 = automaton
     -- states

src/Examples/ContrivedNFAs.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 {-# LANGUAGE TupleSections #-}
 module Examples.ContrivedNFAs where
 
@@ -14,8 +14,8 @@ import           GHC.Generics (Generic)
 -- The complement of 'all distinct atoms'
 -- Not determinizable
 data NFA1 = Initial1 | Guessed1 Atom | Final1
-  deriving (Show, Eq, Ord, Generic)
+  deriving (Show, Eq, Ord, Generic, NominalType, Contextual)
-instance BareNominalType NFA1
+
 exampleNFA1 :: Automaton NFA1 Atom
 exampleNFA1 = automaton
     -- states, 4 orbits (of which one unreachable)
@@ -43,8 +43,8 @@ exampleNFA1 = automaton
 -- So this one *is* determinizable.
 -- Also used in the Bollig et al paper.
 data NFA2 = Initial2 | Distinguished Atom | Count Int
-  deriving (Show, Eq, Ord, Generic)
+  deriving (Show, Eq, Ord, Generic, NominalType, Contextual)
-instance BareNominalType NFA2
+
 exampleNFA2 n = automaton
     (singleton Initial2
         `union` map Distinguished atoms

src/Examples/Fifo.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 module Examples.Fifo (DataInput(..), fifoExample) where
 
-import Control.DeepSeq (NFData)
 import           GHC.Generics (Generic)
 import           NLambda
 import           Prelude      (Eq, Int, Maybe (..), Ord, Show, Read, length, reverse,
@@ -12,7 +11,8 @@ import qualified Prelude      ()
 -- Functional queue data type. First list is for push stuff onto, the
 -- second list is to pop. If the second list is empty, it will reverse
 -- the first.
-data Fifo a = Fifo [a] [a] deriving (Eq, Ord, Show, Generic)
+data Fifo a = Fifo [a] [a]
+  deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
 
 push :: a -> Fifo a -> Fifo a
 push x (Fifo l1 l2) = Fifo (x:l1) l2
@@ -35,16 +35,12 @@ sizeFifo (Fifo l1 l2) = length l1 + length l2
 -- nominal automaton.
 
 -- The alphabet:
-data DataInput = Put Atom | Get Atom deriving (Eq, Ord, Show, Read, Generic, NFData)
+data DataInput = Put Atom | Get Atom
-instance BareNominalType DataInput
+  deriving (Eq, Ord, Show, Read, Generic, NominalType, Contextual)
-instance Contextual DataInput where
-    when f (Put a) = Put (when f a)
-    when f (Get a) = Get (when f a)
 
 -- The automaton: States consist of fifo queues and a sink state.
 -- This representation is not minimal at all, but that's OK, since the
 -- learner will learn a minimal anyways. The parameter n is the bound.
-instance BareNominalType a => BareNominalType (Fifo a)
 fifoExample :: Int -> Automaton (Maybe (Fifo Atom)) DataInput
 fifoExample n = automaton
     -- states

src/Examples/RunningExample.hs

@@ -19,7 +19,7 @@ import           GHC.Generics (Generic)
 
 -- Parametric in the alphabet, because why not?
 data RunningExample a = Store [a] | Check [a] | Accept | Reject
-  deriving (Eq, Ord, Show, Generic, BareNominalType)
+  deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
 
 runningExample alphabet 0 = automaton
     (fromList [Accept, Reject])

src/Examples/Stack.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 module Examples.Stack (DataInput(..), stackExample) where
 
 import           Examples.Fifo (DataInput (..))
@@ -10,7 +10,8 @@ import qualified Prelude       ()
 
 
 -- Functional stack data type is simply a list.
-data Stack a = Stack [a] deriving (Eq, Ord, Show, Generic)
+data Stack a = Stack [a]
+  deriving (Eq, Ord, Show, Generic, NominalType, Contextual)
 
 push :: a -> Stack a -> Stack a
 push x (Stack l1) = Stack (x:l1)
@@ -35,7 +36,6 @@ sizeStack (Stack l1) = length l1
 
 -- The automaton: States consist of stacks and a sink state.
 -- The parameter n is the bound.
-instance BareNominalType a => BareNominalType (Stack a)
 stackExample :: Int -> Automaton (Maybe (Stack Atom)) DataInput
 stackExample n = automaton
     -- states

src/ObservationTable.hs

@@ -10,7 +10,6 @@ module ObservationTable where
 import           NLambda      hiding (fromJust)
 import           Teacher
 
-import           Control.DeepSeq (NFData, force)
 import           Data.Maybe   (fromJust)
 import           Debug.Trace  (trace)
 import           GHC.Generics (Generic)
@@ -43,7 +42,7 @@ type Row i o = Fun [i] o
 
 -- This is a rather arbitrary set of constraints
 -- But I use them *everywhere*, so let's define them once and for all.
-type LearnableAlphabet i = (NFData i, Contextual i, NominalType i, Show i)
+type LearnableAlphabet i = (Contextual i, NominalType i, Show i)
 
 -- `row is` denotes the data of a single row
 -- that is, the function E -> O
@@ -83,17 +82,7 @@ data State i = State
     , ee  :: Set [i]  -- suffixes
     , aa  :: Set i    -- alphabet (remains constant)
     }
-    deriving (Show, Ord, Eq, Generic, NFData, BareNominalType)
+    deriving (Show, Ord, Eq, Generic, NominalType, Conditional, Contextual)
-
-instance NominalType i => Conditional (State i) where
-    cond f s1 s2 = fromTup (cond f (toTup s1) (toTup s2)) where
-        toTup State{..} = (t,ss,ssa,ee,aa)
-        fromTup (t,ss,ssa,ee,aa) = State{..}
-
-instance (Ord i, Contextual i) => Contextual (State i) where
-    when f s = fromTup (when f (toTup s)) where
-        toTup State{..} = (t,ss,ssa,ee,aa)
-        fromTup (t,ss,ssa,ee,aa) = State{..}
 
 -- Precondition: the set together with the current rows is prefix closed
 addRows :: LearnableAlphabet i => Teacher i -> Set [i] -> State i -> State i