gistfile1.hs

-- Convert an Nfa to a Dfa using the algorithms from section 3.7.1 of the "Dragon book"
toDfa :: Nfa -> Dfa
toDfa nfa =
    let
        dstrt = e_closure nfa (n_start nfa)
        init = Map.fromList [(dstrt, genStates dstrt)]
        dfa = getps init
        stateNames = genStateMap dfa
        partial = Map.mapKeys (\x -> lookupDefault x 0 stateNames) dfa
        dfaTrans = Map.map (\x -> Map.map (\y -> (lookupDefault y 0 stateNames)) x) partial
        accepting = Set.fromList
                    (Map.elems
                            (Map.filterWithKey
                                    (\k x ->
                                         (Set.size (Set.intersection (n_accepting nfa) k)) > 0
                                    )
                             stateNames
                            )
                    )
    in
      Dfa dfaTrans (n_start nfa) accepting (n_rgx nfa)
    where
      getps old =
          if (new == old)
            then new
            else (getps new)
          where
            new = generateProductions old

      generateProductions :: Map.Map (StateSet) (Map.Map NfaChar (StateSet))
                          -> Map.Map (StateSet) (Map.Map NfaChar (StateSet))
      generateProductions fad = foldl
                                (\acc x ->
                                     let
                                         gt = (genStates x)
                                     in 
                                       Map.insert x gt acc
                                ) fad (getProductionStates fad) 

      genStateMap :: Map.Map (StateSet) (Map.Map NfaChar (StateSet))
                  -> Map.Map (StateSet) Int
      genStateMap dfa = foldl
                        (\acc x ->
                             let
                                 (y, sm) = mapState acc x
                             in
                               sm
                        ) Map.empty (Map.keys dfa)
      getProductionStates fad = (concat
                                 (map
                                  (\x -> Map.elems x)
                                  (Map.elems fad)
                                 )
                                )

      mapState sm set = case Map.lookup set sm of
                          Just y -> (y, sm)
                          Nothing -> let ms = Map.size sm
                                     in (ms, Map.insert set ms sm)
      genStates set = Map.fromList (filter (\(x,y) -> not (Set.null y))
                      (Set.toList
                              (Set.map
                                      (\ch -> (ch, e_closure_set nfa (nfa_move nfa set ch)))
                                      inSyms
                              )
                      ))
      inSyms = Set.delete Epsilon (Set.fromList (Map.fold (\x acc -> acc ++ Map.keys x) [] (n_transitions nfa)))