-- SPDX-FileCopyrightText: Chris Pressey, the creator of this work, has dedicated it to the public domain.
-- For more information, please refer to <https://unlicense.org/>
-- 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'