Odd.hs

Odd.hs

-- implementation of https://esolangs.org/wiki/An_Odd_Rewriting_System
-- I, Chris Pressey, hereby place this source code into the public domain.

import Data.Char

-- A program in An Odd Rewriting System consists an alphabet of symbols,
-- each of which belongs to one of two categories (an odd symbol or an even symbol),
-- except for a special halt symbol that appears in neither category;
-- two definitions for each symbol (an odd definition and an even definition);
-- and an initial string.  Both the initial string, and each definition, is simply a
-- (possibly empty) string of symbols from the alphabet. 

data Defn = Defn {
    symbol :: Char,
    oddDefn :: String,
    evenDefn :: String
} deriving (Show)
data Program = Program {
    defns :: [Defn],
    initial :: String
} deriving (Show)

-- The source code is in Unicode (and should be represented in a file via using UTF-8);
-- most symbols are represented as Unicode characters with the "cased letter" property
-- (odd symbols have the "uppercase letter" property, even symbols the "lowercase letter" property),
-- with the halt symbol being represented as $. 

isOdd = isUpper
isEven = isLower

findDefn char defnGetter [] = error "No such defn"
findDefn char defnGetter (defn:defns) =
    if symbol defn == char then defnGetter defn else findDefn char defnGetter defns

-- At the start of execution of the program, a data string (which forms the program's memory)
-- is initialised with the contents of the initial string. Thereafter, execution of the program proceeds
-- as follows: a new data string (replacing the old data string) is formed via concatenating the
-- definitions of the symbols in the old data string. At positions which have an odd number of
-- odd symbols to their left (in the old data string), the odd definition is used;
-- if the position has an even number of odd symbols to its left, the even definition is used.

run program = evolve (initial program) (defns program)

evolve dataString defns =
    let
        dataString' = step dataString defns
    in
        [dataString] ++ evolve dataString' defns

step dataString defns =
   let
       (transformedSymbols, _) = foldl (transformSymbol) ([],0) dataString
   in
       concat transformedSymbols
   where
       transformSymbol (newElems, numSeenOddSymbols) char =
           let
               defnGetter = if numSeenOddSymbols `mod` 2 == 0 then evenDefn else oddDefn
               replacement = findDefn char defnGetter defns
               numSeenOddSymbols' = numSeenOddSymbols + if isOdd char then 1 else 0
           in
               (newElems ++ [replacement], numSeenOddSymbols')

-- - - - - --

testProg1 = Program{
    initial = "Cwg",
    defns = [
        Defn{ symbol='c', evenDefn="c", oddDefn="C" },
        Defn{ symbol='C', evenDefn="C", oddDefn="c" },
        Defn{ symbol='g', evenDefn="wg",oddDefn="wg" },
        Defn{ symbol='w', evenDefn="w", oddDefn="C" }
    ]
}