diff --git a/app/Main.hs b/app/Main.hs index 86f7466..75365fa 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -24,7 +24,7 @@ data Aut = Fifo Int | Stack Int | Running Int | NFA1 | Bollig Int | NonResidual deriving (Show, Read) -- existential wrapper -data A = forall q i . (NominalType i, Contextual i, Show i, Read i, NominalType q, Show q) => A (Automaton q i) +data A = forall q i . (Nominal i, Contextual i, Show i, Read i, Nominal q, Show q) => A (Automaton q i) {- HLINT ignore "Redundant $" -} mainExample :: String -> String -> String -> IO () diff --git a/app/Main2.hs b/app/Main2.hs index 1b95dae..63be488 100644 --- a/app/Main2.hs +++ b/app/Main2.hs @@ -13,7 +13,7 @@ import System.IO data Learner = NomLStar | NomLStarCol | NomNLStar deriving (Show, Read) -learn :: (Read i, Contextual i, NominalType i, Show i) => Set i -> IO () +learn :: (Read i, Contextual i, Nominal i, Show i) => Set i -> IO () learn alphSet = do [learnerName] <- getArgs let t = teacherWithIO2 alphSet diff --git a/nominal-lstar.cabal b/nominal-lstar.cabal index 26a7751..0ef3d0b 100644 --- a/nominal-lstar.cabal +++ b/nominal-lstar.cabal @@ -2,7 +2,7 @@ cabal-version: 2.2 name: nominal-lstar version: 0.1.0.0 author: Joshua Moerman -copyright: (c) 2016 - 2020, Joshua Moerman +copyright: (c) 2016 - 2023, Joshua Moerman build-type: Simple extra-source-files: README.md @@ -10,7 +10,8 @@ common stuff default-language: Haskell2010 ghc-options: -O2 -Wall build-depends: - base >= 4.8 && < 5, + -- at most 4.17: one transitive dependency breaks with more recent base + base >= 4.8 && < 4.17, haskeline, NLambda >= 1.1 diff --git a/src/Angluin.hs b/src/Angluin.hs index f12186f..4fda5a5 100644 --- a/src/Angluin.hs +++ b/src/Angluin.hs @@ -16,7 +16,7 @@ import Prelude (Bool (..), Maybe (..), error, show, ($), (++), (.)) -- This returns all witnesses (of the form sa) for non-closedness -closednessTest :: (NominalType i, _) => table -> TestResult i +closednessTest :: (Nominal i, _) => table -> TestResult i closednessTest t = case solve (isEmpty defect) of Just True -> Succes Just False -> trace "Not closed" $ Failed defect empty @@ -27,7 +27,7 @@ closednessTest t = case solve (isEmpty defect) of defect = filter (not . hasEqRow) (rowsExt t) -- We look for inconsistencies and return columns witnessing it -consistencyTestDirect :: (NominalType i, _) => table -> TestResult i +consistencyTestDirect :: (Nominal i, _) => table -> TestResult i consistencyTestDirect t = case solve (isEmpty defect) of Just True -> Succes Just False -> trace "Not consistent" $ Failed empty defect @@ -39,7 +39,7 @@ consistencyTestDirect t = case solve (isEmpty defect) of -- Given a C&C table, constructs an automaton. The states are given by 2^E (not -- necessarily equivariant functions) -constructHypothesis :: (NominalType i, _) => table -> Automaton (Row table) i +constructHypothesis :: (Nominal i, _) => table -> Automaton (Row table) i constructHypothesis t = simplify $ automaton q (alph t) d i f where q = map (row t) (rows t) @@ -48,28 +48,28 @@ constructHypothesis t = simplify $ automaton q (alph t) d i f f = filter (`contains` []) q -- Extends the table with all prefixes of a set of counter examples. -useCounterExampleAngluin :: (NominalType i, _) => Teacher i -> Set [i] -> table -> table +useCounterExampleAngluin :: (Nominal i, _) => Teacher i -> Set [i] -> table -> table useCounterExampleAngluin teacher ces t = let newRows = sum . map (fromList . inits) $ ces newRowsRed = newRows \\ rows t in addRows (mqToBool teacher) newRowsRed t -- This is the variant by Maler and Pnueli: Adds all suffixes as columns -useCounterExampleMP :: (NominalType i, _) => Teacher i -> Set [i] -> table -> table +useCounterExampleMP :: (Nominal i, _) => Teacher i -> Set [i] -> table -> table useCounterExampleMP teacher ces t = let newColumns = sum . map (fromList . tails) $ ces newColumnsRed = newColumns \\ cols t in addColumns (mqToBool teacher) newColumnsRed t -- Default: use counter examples in columns, which is slightly faster -learnAngluin :: (NominalType i, _) => Teacher i -> Automaton _ i +learnAngluin :: (Nominal i, _) => Teacher i -> Automaton _ i learnAngluin teacher = learnLoop useCounterExampleMP teacher (OT.initialBTable (mqToBool teacher) (alphabet teacher)) -- The "classical" version, where counter examples are added as rows -learnAngluinRows :: (NominalType i, _) => Teacher i -> Automaton _ i +learnAngluinRows :: (Nominal i, _) => Teacher i -> Automaton _ i learnAngluinRows teacher = learnLoop useCounterExampleAngluin teacher (OT.initialBTable (mqToBool teacher) (alphabet teacher)) -learnLoop :: (NominalType i, ObservationTable table i Bool, _) => _ -> Teacher i -> table -> Automaton (Row table) i +learnLoop :: (Nominal i, ObservationTable table i Bool, _) => _ -> Teacher i -> table -> Automaton (Row table) i learnLoop cexHandler teacher t = let -- No worry, these are computed lazily diff --git a/src/Bollig.hs b/src/Bollig.hs index 7dcc22b..bb03a12 100644 --- a/src/Bollig.hs +++ b/src/Bollig.hs @@ -23,7 +23,7 @@ import Prelude (Bool (..), Int, Maybe (..), Show (..), ($), (++), (.)) -- This does hinder generalisations to other nominal join semi- -- lattices than the Booleans. -rfsaClosednessTest :: (NominalType i, _) => Set (Row table) -> table -> TestResult i +rfsaClosednessTest :: (Nominal i, _) => Set (Row table) -> table -> TestResult i rfsaClosednessTest primesUpp t = case solve (isEmpty defect) of Just True -> Succes Just False -> trace "Not closed" $ Failed defect empty @@ -32,7 +32,7 @@ rfsaClosednessTest primesUpp t = case solve (isEmpty defect) of where defect = filter (\ua -> row t ua `neq` sum (filter (`isSubsetOf` row t ua) primesUpp)) (rowsExt t) -rfsaConsistencyTest :: (NominalType i, _) => table -> TestResult i +rfsaConsistencyTest :: (Nominal i, _) => table -> TestResult i rfsaConsistencyTest t = case solve (isEmpty defect) of Just True -> Succes Just False -> trace "Not consistent" $ Failed empty defect @@ -43,7 +43,7 @@ rfsaConsistencyTest t = case solve (isEmpty defect) of defect = triplesWithFilter (\(u1, u2) a v -> maybeIf (not (tableAt2 (u1 ++ [a]) v) /\ tableAt2 (u2 ++ [a]) v) (a:v)) candidates (alph t) (cols t) tableAt2 s e = singleton True `eq` tableAt t s e -constructHypothesisBollig :: (NominalType i, _) => Set (Row table) -> table -> Automaton (Row table) i +constructHypothesisBollig :: (Nominal i, _) => Set (Row table) -> table -> Automaton (Row table) i constructHypothesisBollig primesUpp t = automaton q (alph t) d i f where q = primesUpp @@ -55,20 +55,20 @@ constructHypothesisBollig primesUpp t = automaton q (alph t) d i f -- Adds all suffixes as columns -- TODO: do actual Rivest and Schapire -addCounterExample :: (NominalType i, _) => MQ i Bool -> Set [i] -> table -> table +addCounterExample :: (Nominal i, _) => MQ i Bool -> Set [i] -> table -> table addCounterExample mq ces t = let newColumns = sum . map (fromList . tails) $ ces newColumnsRed = newColumns \\ cols t in addColumns mq newColumnsRed t -learnBollig :: (NominalType i, _) => Int -> Int -> Teacher i -> Automaton _ i +learnBollig :: (Nominal i, _) => Int -> Int -> Teacher i -> Automaton _ i learnBollig k n teacher = learnBolligLoop teacher (BOT.initialBTableSize (mqToBool teacher) (alphabet teacher) k n) -- Slow version -learnBolligOld :: (NominalType i, _) => Int -> Int -> Teacher i -> Automaton _ i +learnBolligOld :: (Nominal i, _) => Int -> Int -> Teacher i -> Automaton _ i learnBolligOld k n teacher = learnBolligLoop teacher (SOT.initialBTableSize (mqToBool teacher) (alphabet teacher) k n) -learnBolligLoop :: (NominalType i, _) => Teacher i -> table -> Automaton (Row table) i +learnBolligLoop :: (Nominal i, _) => Teacher i -> table -> Automaton (Row table) i learnBolligLoop teacher t = let -- These simplify's do speed up diff --git a/src/BooleanObservationTable.hs b/src/BooleanObservationTable.hs index c9b306f..d824ec9 100644 --- a/src/BooleanObservationTable.hs +++ b/src/BooleanObservationTable.hs @@ -15,7 +15,7 @@ import Prelude (Bool (..), Eq, Int, Ord, Show (..), (++), (.)) import qualified Prelude () -- Helper function -mqToSubset :: NominalType i => (Set [i] -> Set ([i], Bool)) -> Set [i] -> Set [i] +mqToSubset :: Nominal i => (Set [i] -> Set ([i], Bool)) -> Set [i] -> Set [i] mqToSubset mq = mapFilter (\(i, o) -> maybeIf (fromBool o) i) . mq -- A table is nothing more than a part of the language. @@ -28,9 +28,9 @@ data Table i = Table , colIndices :: Set (ColumnIndex i) , aa :: Set i } - deriving (Show, Ord, Eq, Generic, NominalType, Conditional, Contextual) + deriving (Show, Ord, Eq, Generic, Nominal, Conditional, Contextual) -instance (NominalType i, Contextual i) => ObservationTable (Table i) i Bool where +instance (Nominal i, Contextual i) => ObservationTable (Table i) i Bool where type Row (Table i) = Set [i] rows = rowIndices cols = colIndices @@ -62,7 +62,7 @@ instance (NominalType i, Contextual i) => ObservationTable (Table i) i Bool wher newContent = mqToSubset mq newPartRed -initialBTableWith :: NominalType i => MQ i Bool -> Set i -> Set (RowIndex i) -> Set (ColumnIndex i) -> Table i +initialBTableWith :: Nominal i => MQ i Bool -> Set i -> Set (RowIndex i) -> Set (ColumnIndex i) -> Table i initialBTableWith mq alphabet newRows newColumns = Table { content = content , domain = domain @@ -75,8 +75,8 @@ initialBTableWith mq alphabet newRows newColumns = Table domain = pairsWith (++) newRows (newColumns `union` newColumnsExt) content = mqToSubset mq domain -initialBTable :: NominalType i => MQ i Bool -> Set i -> Table i +initialBTable :: Nominal i => MQ i Bool -> Set i -> Table i initialBTable mq alphabet = initialBTableWith mq alphabet (singleton []) (singleton []) -initialBTableSize :: NominalType i => MQ i Bool -> Set i -> Int -> Int -> Table i +initialBTableSize :: Nominal i => MQ i Bool -> Set i -> Int -> Int -> Table i initialBTableSize mq alphabet rs cs = initialBTableWith mq alphabet (replicateSetUntil rs alphabet) (replicateSetUntil cs alphabet) diff --git a/src/Examples/Contrived.hs b/src/Examples/Contrived.hs index 4d9c9bf..36fe5e1 100644 --- a/src/Examples/Contrived.hs +++ b/src/Examples/Contrived.hs @@ -12,7 +12,7 @@ import qualified Prelude () -- 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, NominalType, Contextual) + deriving (Show, Eq, Ord, Generic, Nominal, Contextual) example1 :: Automaton Example1 Atom example1 = automaton @@ -37,7 +37,7 @@ 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, NominalType, Contextual) + deriving (Eq, Ord, Show, Generic, Nominal, Contextual) example2 :: Automaton Aut2 Atom example2 = automaton @@ -57,7 +57,7 @@ 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, NominalType, Contextual) + deriving (Eq, Ord, Show, Generic, Nominal, Contextual) example3 :: Automaton Aut3 Atom example3 = automaton @@ -86,7 +86,7 @@ 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, NominalType, Contextual) + deriving (Eq, Ord, Show, Generic, Nominal, Contextual) example4 :: Automaton Aut4 Atom example4 = automaton @@ -125,7 +125,7 @@ example4 = automaton -- Accepts all two-symbols words with different atoms data Aut5 = Aut5Init | Aut5Store Atom | Aut5T | Aut5F - deriving (Eq, Ord, Show, Generic, NominalType, Contextual) + deriving (Eq, Ord, Show, Generic, Nominal, Contextual) example5 :: Automaton Aut5 Atom example5 = automaton diff --git a/src/Examples/ContrivedNFAs.hs b/src/Examples/ContrivedNFAs.hs index 37eb139..363dfe4 100644 --- a/src/Examples/ContrivedNFAs.hs +++ b/src/Examples/ContrivedNFAs.hs @@ -14,7 +14,7 @@ import qualified Prelude () -- The complement of 'all distinct atoms' -- Not determinizable data NFA1 = Initial1 | Guessed1 Atom | Final1 - deriving (Show, Eq, Ord, Generic, NominalType, Contextual) + deriving (Show, Eq, Ord, Generic, Nominal, Contextual) exampleNFA1 :: Automaton NFA1 Atom exampleNFA1 = automaton @@ -43,7 +43,7 @@ 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, NominalType, Contextual) + deriving (Show, Eq, Ord, Generic, Nominal, Contextual) exampleNFA2 :: Int -> Automaton NFA2 Atom exampleNFA2 n = automaton diff --git a/src/Examples/Fifo.hs b/src/Examples/Fifo.hs index a95d3f7..e058750 100644 --- a/src/Examples/Fifo.hs +++ b/src/Examples/Fifo.hs @@ -14,7 +14,7 @@ import qualified Prelude () -- 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, NominalType, Contextual) + deriving (Eq, Ord, Show, Generic, Nominal, Contextual) push :: a -> Fifo a -> Fifo a push x (Fifo l1 l2) = Fifo (x:l1) l2 @@ -38,7 +38,7 @@ sizeFifo (Fifo l1 l2) = length l1 + length l2 -- The alphabet: data DataInput = Put Atom | Get Atom - deriving (Eq, Ord, Show, Read, Generic, NominalType, Contextual) + deriving (Eq, Ord, Show, Read, Generic, Nominal, Contextual) -- The automaton: States consist of fifo queues and a sink state. -- This representation is not minimal at all, but that's OK, since the diff --git a/src/Examples/NonResidual.hs b/src/Examples/NonResidual.hs index ea1715e..09e4025 100644 --- a/src/Examples/NonResidual.hs +++ b/src/Examples/NonResidual.hs @@ -18,7 +18,7 @@ import qualified Prelude () -- Parametric in the alphabet, because why not? data NonResidual a = Q1 | Q2 a | Q3 a a | Q4 a | Q5 - deriving (Eq, Ord, Show, Generic, NominalType, Contextual) + deriving (Eq, Ord, Show, Generic, Nominal, Contextual) exampleNonResidual :: Automaton (NonResidual Atom) Atom exampleNonResidual = automaton diff --git a/src/Examples/Residual.hs b/src/Examples/Residual.hs index 1d348a2..a0a9eb8 100644 --- a/src/Examples/Residual.hs +++ b/src/Examples/Residual.hs @@ -13,7 +13,7 @@ import Prelude (Eq, Ord, Read, Show) import qualified Prelude () data Res1 a = QR1 a | QR2 | QEmpty - deriving (Eq, Ord, Show, Generic, NominalType, Contextual) + deriving (Eq, Ord, Show, Generic, Nominal, Contextual) -- Language L = { w a | a fresh for w } + {eps}, but anchored with a new symbol exampleResidual1 :: Automaton (Res1 Atom) DataInput @@ -35,10 +35,10 @@ exampleResidual1 = automaton -- Example when learning breaks data Res2 a = Guess a | GuessConfused a | Accept - deriving (Eq, Ord, Show, Generic, NominalType, Contextual) + deriving (Eq, Ord, Show, Generic, Nominal, Contextual) data AlphabetR a = A a | Anc a - deriving (Eq, Ord, Show, Read, Generic, NominalType, Contextual) + deriving (Eq, Ord, Show, Read, Generic, Nominal, Contextual) exampleResidual2 :: Automaton (Res2 Atom) (AlphabetR Atom) exampleResidual2 = automaton diff --git a/src/Examples/RunningExample.hs b/src/Examples/RunningExample.hs index e23b050..86011f0 100644 --- a/src/Examples/RunningExample.hs +++ b/src/Examples/RunningExample.hs @@ -18,9 +18,9 @@ import qualified Prelude () data RunningExample a = Store [a] | Check [a] | Accept | Reject - deriving (Eq, Ord, Show, Generic, NominalType, Contextual) + deriving (Eq, Ord, Show, Generic, Nominal, Contextual) -runningExample :: NominalType a => Set a -> Int -> Automaton (RunningExample a) a +runningExample :: Nominal a => Set a -> Int -> Automaton (RunningExample a) a runningExample alphabet 0 = automaton (fromList [Accept, Reject]) alphabet diff --git a/src/Examples/Stack.hs b/src/Examples/Stack.hs index 79751fd..fc6a736 100644 --- a/src/Examples/Stack.hs +++ b/src/Examples/Stack.hs @@ -12,7 +12,7 @@ import qualified Prelude () -- Functional stack data type is simply a list. newtype Stack a = Stack [a] - deriving (Eq, Ord, Show, Generic, NominalType, Contextual) + deriving (Eq, Ord, Show, Generic, Nominal, Contextual) push :: a -> Stack a -> Stack a push x (Stack l1) = Stack (x:l1) diff --git a/src/ObservationTableClass.hs b/src/ObservationTableClass.hs index 6212bd3..d1dca64 100644 --- a/src/ObservationTableClass.hs +++ b/src/ObservationTableClass.hs @@ -3,7 +3,8 @@ module ObservationTableClass where -import NLambda (NominalType, Set, pairsWith) +import Data.Kind (Type) +import NLambda (Nominal, Set, pairsWith) import Prelude ((++)) -- Words are indices to our table @@ -14,9 +15,9 @@ type ColumnIndex i = [i] type MQ i o = Set [i] -> Set ([i], o) -- This is a fat class, so that instances could give more efficient implementations -class (NominalType table, NominalType i, NominalType o) => ObservationTable table i o | table -> i o where +class (Nominal table, Nominal i, Nominal o) => ObservationTable table i o | table -> i o where -- The type of data in a row is determined by the table - type Row table :: * + type Row table :: Type -- getters rows :: table -> Set (RowIndex i) diff --git a/src/SimpleObservationTable.hs b/src/SimpleObservationTable.hs index 384e3b0..c69ea2d 100644 --- a/src/SimpleObservationTable.hs +++ b/src/SimpleObservationTable.hs @@ -22,7 +22,7 @@ import qualified Prelude () -- Except when o = Bool, more on that later type Fun i o = Set (i, o) -dom :: (NominalType i, NominalType o) => Fun i o -> Set i +dom :: (Nominal i, Nominal o) => Fun i o -> Set i dom = map fst -- A table is nothing more than a part of the language. @@ -34,9 +34,9 @@ data Table i o = Table , colIndices :: Set (ColumnIndex i) , aa :: Set i } - deriving (Show, Ord, Eq, Generic, NominalType, Conditional, Contextual) + deriving (Show, Ord, Eq, Generic, Nominal, Conditional, Contextual) -instance (NominalType i, NominalType o) => ObservationTable (Table i o) i o where +instance (Nominal i, Nominal o) => ObservationTable (Table i o) i o where type Row (Table i o) = Fun [i] o rows = rowIndices cols = colIndices @@ -70,11 +70,11 @@ instance (NominalType i, NominalType o) => ObservationTable (Table i o) i o wher -- We can reuse the above tables for the Boolean case and -- perform some minor optimisations. newtype Boolean table = B { unB :: table } - deriving (Show, Ord, Eq, Generic, NominalType, Conditional, Contextual) + deriving (Show, Ord, Eq, Generic, Nominal, Conditional, Contextual) type BTable i = Boolean (Table i Bool) -instance (NominalType i) => ObservationTable (BTable i) i Bool where +instance (Nominal i) => ObservationTable (BTable i) i Bool where -- Special case of a boolean: functions to Booleans are subsets type Row (BTable i) = Set [i] @@ -94,7 +94,7 @@ instance (NominalType i) => ObservationTable (BTable i) i Bool where rowEps (B Table{..}) = mapFilter (\(i, o) -> maybeIf (fromBool o /\ i `member` colIndices) i) content -initialTableWith :: (NominalType i, NominalType o) => MQ i o -> Set i -> Set (RowIndex i) -> Set (ColumnIndex i) -> Table i o +initialTableWith :: (Nominal i, Nominal o) => MQ i o -> Set i -> Set (RowIndex i) -> Set (ColumnIndex i) -> Table i o initialTableWith mq alphabet newRows newColumns = Table { content = content , rowIndices = newRows @@ -106,17 +106,17 @@ initialTableWith mq alphabet newRows newColumns = Table domain = pairsWith (++) newRows (newColumns `union` newColumnsExt) content = mq domain -initialTable :: (NominalType i, NominalType o) => MQ i o -> Set i -> Table i o +initialTable :: (Nominal i, Nominal o) => MQ i o -> Set i -> Table i o initialTable mq alphabet = initialTableWith mq alphabet (singleton []) (singleton []) -initialTableSize :: (NominalType i, NominalType o) => MQ i o -> Set i -> Int -> Int -> Table i o +initialTableSize :: (Nominal i, Nominal o) => MQ i o -> Set i -> Int -> Int -> Table i o initialTableSize mq alphabet rs cs = initialTableWith mq alphabet (replicateSetUntil rs alphabet) (replicateSetUntil cs alphabet) -initialBTableWith :: NominalType i => MQ i Bool -> Set i -> Set (RowIndex i) -> Set (ColumnIndex i) -> BTable i +initialBTableWith :: Nominal i => MQ i Bool -> Set i -> Set (RowIndex i) -> Set (ColumnIndex i) -> BTable i initialBTableWith = coerce initialTableWith -initialBTable :: NominalType i => MQ i Bool -> Set i -> BTable i +initialBTable :: Nominal i => MQ i Bool -> Set i -> BTable i initialBTable = coerce initialTable -initialBTableSize :: NominalType i => MQ i Bool -> Set i -> Int -> Int -> BTable i +initialBTableSize :: Nominal i => MQ i Bool -> Set i -> Int -> Int -> BTable i initialBTableSize = coerce initialTableSize diff --git a/src/Teacher.hs b/src/Teacher.hs index 8b5a79d..dea2b3c 100644 --- a/src/Teacher.hs +++ b/src/Teacher.hs @@ -23,7 +23,7 @@ import Prelude hiding (map) -- The teacher interface is slightly inconvenient -- But this is for a good reason. The type [i] -> o -- doesn't work well in nlambda -mqToBool :: NominalType i => Teacher i -> Set [i] -> Set ([i], Bool) +mqToBool :: Nominal i => Teacher i -> Set [i] -> Set ([i], Bool) mqToBool teacher qs = answer where realQ = membership teacher qs @@ -41,7 +41,7 @@ mqToBool teacher qs = answer -- 1. This is a fully automatic teacher, which has an internal automaton -- Only works for DFAs for now, as those can be checked for equivalence -teacherWithTarget :: (NominalType i, NominalType q) => Automaton q i -> Teacher i +teacherWithTarget :: (Nominal i, Nominal q) => Automaton q i -> Teacher i teacherWithTarget aut = Teacher { membership = foreachQuery $ accepts aut , equivalent = automaticEquivalent bisim aut @@ -50,7 +50,7 @@ teacherWithTarget aut = Teacher -- 1b. This is a fully automatic teacher, which has an internal automaton -- NFA have undecidable equivalence, n is a bound on deoth of bisimulation. -teacherWithTargetNonDet :: (Show i, Show q, NominalType i, NominalType q) => Int -> Automaton q i -> Teacher i +teacherWithTargetNonDet :: (Show i, Show q, Nominal i, Nominal q) => Int -> Automaton q i -> Teacher i teacherWithTargetNonDet n aut = Teacher { membership = foreachQuery $ accepts aut , equivalent = automaticEquivalent (bisimNonDet n) aut @@ -62,7 +62,7 @@ teacherWithTargetNonDet n aut = Teacher -- Note that parsing is very unforgiving, one mistake, and there is no way back -- Atoms are referenced by Ints. When the user provides a counter example, we -- consider the whole orbit generated by it. -teacherWithIO :: (Show i, Read i, NominalType i, Contextual i) => Set i -> Teacher i +teacherWithIO :: (Show i, Read i, Nominal i, Contextual i) => Set i -> Teacher i teacherWithIO alph = Teacher { membership = ioMembership , equivalent = ioEquivalent @@ -70,7 +70,7 @@ teacherWithIO alph = Teacher } -- 2b. Same as above. But with machine readable queries (except for EQs maybe) -teacherWithIO2 :: (Show i, Read i, NominalType i, Contextual i) => Set i -> Teacher i +teacherWithIO2 :: (Show i, Read i, Nominal i, Contextual i) => Set i -> Teacher i teacherWithIO2 alph = Teacher { membership = ioMembership2 , equivalent = ioEquivalent2 @@ -80,7 +80,7 @@ teacherWithIO2 alph = Teacher -- 3. A teacher uses a target for the mebership queries, but you for equivalence -- Useful as long as you don't have an equivalence check -- used for NFAs when there was no bounded bisimulation yet -teacherWithTargetAndIO :: (Show i, Read i, NominalType i, Contextual i, NominalType q) => Automaton q i -> Teacher i +teacherWithTargetAndIO :: (Show i, Read i, Nominal i, Contextual i, Nominal q) => Automaton q i -> Teacher i teacherWithTargetAndIO aut = Teacher { membership = foreachQuery $ accepts aut , equivalent = ioEquivalent diff --git a/src/Teachers/Teacher.hs b/src/Teachers/Teacher.hs index ff7174a..ba45c1f 100644 --- a/src/Teachers/Teacher.hs +++ b/src/Teachers/Teacher.hs @@ -17,12 +17,12 @@ data Teacher i = Teacher -- Given a hypothesis, returns Nothing when equivalence or a (equivariant) -- set of counter examples. Needs to be quantified over q, because the -- learner may choose the type of the state space. - , equivalent :: forall q. (Show q, NominalType q) => Automaton q i -> Maybe (Set [i]) + , equivalent :: forall q. (Show q, Nominal q) => Automaton q i -> Maybe (Set [i]) -- Returns the alphabet to the learner , alphabet :: Set i } -- Often a membership query is defined by a function [i] -> Formula. This wraps -- such a function to the required type for a membership query (see above). -foreachQuery :: NominalType i => ([i] -> Formula) -> Set[i] -> Set ([i], Formula) +foreachQuery :: Nominal i => ([i] -> Formula) -> Set[i] -> Set ([i], Formula) foreachQuery f = map (\q -> (q, f q)) diff --git a/src/Teachers/Terminal.hs b/src/Teachers/Terminal.hs index 788af05..9f63061 100644 --- a/src/Teachers/Terminal.hs +++ b/src/Teachers/Terminal.hs @@ -9,7 +9,7 @@ import System.IO.Unsafe (unsafePerformIO) import Text.Read (readMaybe) -- Posing a membership query to the terminal and waits for used to input a formula -ioMembership :: (Show i, NominalType i, Contextual i) => Set [i] -> Set ([i], Formula) +ioMembership :: (Show i, Nominal i, Contextual i) => Set [i] -> Set ([i], Formula) ioMembership queries = unsafePerformIO $ do cache <- readIORef mqCache let cachedAnswers = filter (\(a, _) -> a `member` queries) cache @@ -41,7 +41,7 @@ ioMembership queries = unsafePerformIO $ do -- Same as above, but with a machine-readable format -ioMembership2 :: (Show i, NominalType i, Contextual i) => Set [i] -> Set ([i], Formula) +ioMembership2 :: (Show i, Nominal i, Contextual i) => Set [i] -> Set ([i], Formula) ioMembership2 queries = unsafePerformIO $ do cache <- readIORef mqCache let cachedAnswers = filter (\(a, _) -> a `member` queries) cache @@ -73,7 +73,7 @@ newtype TestIO i = T [i] -- Poses a query to the terminal, waiting for the user to provide a counter example -- User can pose a "test query" which is evaluated on the hypothesis -ioEquivalent :: (Show q, NominalType q, Show i, Read i, NominalType i) => Automaton q i -> Maybe (Set [i]) +ioEquivalent :: (Show q, Nominal q, Show i, Read i, Nominal i) => Automaton q i -> Maybe (Set [i]) ioEquivalent hypothesis = unsafePerformIO $ do putStrLn "\n# Is the following automaton correct?" putStr "# " @@ -102,7 +102,7 @@ ioEquivalent hypothesis = unsafePerformIO $ do -- Same as above but in different format. -- This is used for automation and benchmarking different nominal tools -ioEquivalent2 :: (Show q, NominalType q, Show i, Read i, NominalType i) => Automaton q i -> Maybe (Set [i]) +ioEquivalent2 :: (Show q, Nominal q, Show i, Read i, Nominal i) => Automaton q i -> Maybe (Set [i]) ioEquivalent2 hypothesis = unsafePerformIO $ do putStrLn "EQ\n\"Is the following automaton correct?" print hypothesis diff --git a/src/Teachers/Whitebox.hs b/src/Teachers/Whitebox.hs index 71946ac..b004405 100644 --- a/src/Teachers/Whitebox.hs +++ b/src/Teachers/Whitebox.hs @@ -8,7 +8,7 @@ import Prelude hiding (filter, map, not, sum) -- Checks bisimulation of initial states (only for DFAs) -- returns some counterexamples if not bisimilar -- returns empty set iff bisimilar -bisim :: (NominalType i, NominalType q1, NominalType q2) => Automaton q1 i -> Automaton q2 i -> Set [i] +bisim :: (Nominal i, Nominal q1, Nominal q2) => Automaton q1 i -> Automaton q2 i -> Set [i] bisim aut1 aut2 = go empty (pairsWith addEmptyWord (initialStates aut1) (initialStates aut2)) where go rel todo = @@ -37,7 +37,7 @@ bisim aut1 aut2 = go empty (pairsWith addEmptyWord (initialStates aut1) (initial -- I am not sure about correctness, but that is not really an issue for our -- use-case. Note that deciding equivalence of NFAs is undecidable, so we -- bound the bisimulation depth. -bisimNonDet :: (Show i, Show q1, Show q2, NominalType i, NominalType q1, NominalType q2) => Int -> Automaton q1 i -> Automaton q2 i -> Set [i] +bisimNonDet :: (Show i, Show q1, Show q2, Nominal i, Nominal q1, Nominal q2) => Int -> Automaton q1 i -> Automaton q2 i -> Set [i] bisimNonDet n aut1 aut2 = go empty (singleton ([], initialStates aut1, initialStates aut2)) where go rel todo0 =