-- SPDX-FileCopyrightText: Chris Pressey, the creator of this work, has dedicated it to the public domain. -- For more information, please refer to -- SPDX-License-Identifier: Unlicense module Language.Turmac.Normalizer where import Data.List (nub, elemIndex) import Data.Maybe (fromJust) import Language.Turmac.Model import Language.Turmac.Analyzer (checkComplete) -- | Create a mapping from original labels to normalized numeric labels (as strings) createMapping :: [String] -> String -> [(String, String)] createMapping originals firstValue = let normalized = map show [0..] pairs = zip (firstValue : filter (/= firstValue) originals) normalized in pairs -- | Create state mapping, ensuring S0 maps to "0" createStateMapping :: [TMRule] -> [(StateId, StateId)] createStateMapping rules = let states = nub [s | (s, _, _, _, _) <- rules] in createMapping states start -- | Create symbol mapping, ensuring blank ("_") maps to "0" createSymbolMapping :: [TMRule] -> [(Symbol, Symbol)] createSymbolMapping rules = let symbols = nub ([sym1 | (_, sym1, _, _, _) <- rules] ++ [sym2 | (_, _, sym2, _, _) <- rules]) in createMapping symbols blank -- | Translate a single rule using the state and symbol mappings translateRule :: [(StateId, StateId)] -> [(Symbol, Symbol)] -> TMRule -> TMRule translateRule stateMap symMap (st1, sym1, sym2, st2, dir) = let lookupWithError msg map key = case lookup key map of Just value -> value Nothing -> error $ msg ++ show key newSt1 = lookupWithError "State not found in mapping: " stateMap st1 newSym1 = lookupWithError "Symbol not found in mapping: " symMap sym1 newSym2 = lookupWithError "Symbol not found in mapping: " symMap sym2 newSt2 = if isHaltState st2 then st2 -- Preserve halt state else lookupWithError "State not found in mapping: " stateMap st2 in (newSt1, newSym1, newSym2, newSt2, dir) -- | Normalize a Turmac machine description. -- -- Normalization only works properly on a *complete* description (every -- state-symbol combination must be covered, or the resulting numeric -- renumbering can be inconsistent/partial). Accordingly this function -- validates its input for completeness. normalizeRules rules = let (Right rules') = checkComplete rules stateMap = createStateMapping rules' symMap = createSymbolMapping rules' in map (translateRule stateMap symMap) rules'