{
 A Haskell program with functions to convert a Turing machine to the esolang
 Geom.

 Made by Ã˜rjan Johansen, October 2011.
 This file is in the public domain.
}
import Data.List(foldl')
data Direction = Lft  Rgt deriving (Show, Read)
type State = Int
type Value = Int
{ swapBlocks creates a program to swap two arbitrary sized blocks of values on
 the stack. }
swapBlocks :: Int > Int > String
swapBlocks m n = unwords [cmd ++ show i 
(cmd,is) < [
("> a", [n,n1..1]), ("> b", [m,m1..1]), ("a", [1..n]), ("b", [1..m])],
i < is]
{ Cell values and states are encoded as sequences of t (an arbitrary nonnil
 point) and nil, of length one less than the number of values supported. 0
 is encoded as all nils while anything else is encoded a single t in some
 spot, the rest nils. }
outOf :: Int > Int > String
m `outOf` n
 m >= 0 && m < n = unwords [if i == m then "t" else "nil"  i < [1 .. n1]]
 otherwise = error "Bit position out of range"
{ branchTable creates a program to decode a sequence of t's and nils on the
 stack and perform an action dependent on what value was decoded. }
branchTable :: [String] > String
branchTable (zeroOption : otherOptions)
= snd $ foldl' branch (0, zeroOption) otherOptions where
branch (n, nested) this = n `seq` (n+1, unwords $
"[" : replicate n "drop" ++ [this, "\n" ++ nested, "]"])
{ table is a list of state entries, which are either empty for a halting
 state, or a list of cell value entries. Each cell value entry is a triple
 of direction to move, state to transfer to, and cell value to put in the
 cell the machine was in. (Counting states and values starts at 0.)
 initialState is the initial state of the machine. (duh)
 runOffLeftEnd is a state which the machine enters if ever hitting
 the left end of the tape. It should probably be a halting state.
 paddingValue is the cell value used to extend the tape rightward when
 necessary.
 input is a list of cell values that give the initial tape contents. }
encodeTM :: [[(Direction, State, Value)]]
> State > State > Value > [Value] > String
encodeTM table initialState runOffLeftEnd paddingValue input
= unlines [
 These two lines are from another program on the Geom wiki page
": drop > _ ;",
": neq > a > b a b @ drop drop b a @ drop ;",
"> t t t t neq > nil",
": swap_blocks " ++ swapBlocks (states1) values ++ " ;",
": right_end " ++ right_end ++ " ;",
": tm_table " ++ tm_table ++ " ;",
leftEndMarker,
encodeState initialState,
unlines $ map encodeRightCell input
++ ["right_end"]
]
where
states = length table
values = maximum $ map length table
encodeState s = s `outOf` states
leftEndMarker = 0 `outOf` (values+1)
encodeLeftCell v = (v+1) `outOf` (values+1)
encodeRightCell v = encodeLeftCell v ++ " swap_blocks tm_table"
branchWithHaltCheck f = branchTable $ zipWith (\s stateEntry >
if null stateEntry then encodeState s else f s stateEntry)
[0..] table
right_end = branchWithHaltCheck $ \s _ > unwords [
encodeLeftCell paddingValue, encodeState s, "tm_table right_end"]
tm_table = branchWithHaltCheck $ \s stateEntry > branchTable $
unwords [leftEndMarker, encodeState runOffLeftEnd] :
[case dir of
Lft > unwords [
encodeState nextState, "tm_table", encodeRightCell nextValue]
Rgt > unwords [encodeLeftCell nextValue, encodeState nextState]
 (dir, nextState, nextValue) < stateEntry]
{
 Test TM: Wolfram's 2,3Turing machine, which is a bit silly since it has no
 halting state, and our conversion supports neither infinite nonrepeating
 setup nor going to the left of the initial tape end.
 But it's simple and shows how to run the conversion.
}
wolfram2_3 =
[[(Rgt, 1, 1), (Lft, 0, 2), (Lft, 0, 1)],
[(Lft, 0, 2), (Rgt, 1, 2), (Rgt, 0, 0)]]
main = putStr $ encodeTM wolfram2_3 0 0 0 [0,1,2,1,0]