5ce3dd9635d55704823b48ebecac62af242882ea
[nofib.git] / real / rx / src / Instance.hs
1 module Instance
2
3 ( instpublic
4 )
5
6 -- find some instances of a language
7 -- just delete all recursive rules in the automaton
8
9 where
10
11 import Trace
12
13 import Set
14 import FiniteMap
15
16 import Stuff
17 import Options
18
19 import TA
20 import FAtypes
21
22
23
24
25 weed moves current seen =
26 if isEmptySet current then moves
27 else
28 let
29 -- reachables
30 neigh = mkSet [ d
31 | c <- setToList current
32 , st <- setToList (lookupset moves c)
33 , d <- stargs st
34 ]
35
36 seen' = (seen `unionSet` current)
37 current' = (neigh `minusSet` seen)
38
39 moves' = mapFM (\ q sts -> mkSet [ st | st <- setToList sts
40 , q `elementOf` seen
41 || not (or [ p `elementOf` seen'
42 | p <- stargs st ])
43 ]
44 ) moves
45 in
46 weed moves' current' seen'
47
48
49 inst :: TNFA Int -> Set Int -> TNFA Int
50 inst a @ (TNFA cons all starts moves) is =
51 let
52 moves' = weed moves is emptySet
53 in TNFA cons all is moves'
54
55 instpublic :: Opts -> [ TNFA Int ] -> TNFA Int
56
57 instpublic opts args =
58 if length args /= 1
59 then error "instpublic.args"
60 else
61 let [ arg1 @ (TNFA cons all starts moves) ] = args
62 in inst arg1 starts
63
64