git @ Cat's Eye Technologies Burro / master src / Language / Turmac / Normalizer.hs
master

Tree @master (Download .tar.gz)

Normalizer.hs @masterraw · history · blame

-- 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'