module Control.Compilation.Compile
where
type FreshIndex = Integer
type Indentation = String
type ModuleName = String
type NestingDepth = Integer
data State a =
State FreshIndex Indentation (Maybe ModuleName) NestingDepth a
empState :: a -> State a
empState s = State 0 "" Nothing 0 s
data Compile a b =
Compile (State a -> (State a, b))
instance Monad (Compile a) where
return x = Compile (\s -> (s, x))
(>>=) (Compile c1) fc2 = Compile $
(\state ->
let (state', r) = c1 state
Compile c2 = fc2 r
in c2 state'
)
extract :: Compile a () -> a -> a
extract (Compile c) o = let (State _ _ _ _ r, _) = c (empState o) in r
nothing :: Compile a ()
nothing = Compile $ \s -> (s, ())
fresh :: Compile a String
fresh = Compile $ \(State f i m n s) -> (State (f+1) i m n s, show f)
freshWithPrefix :: String -> Compile a String
freshWithPrefix p = Compile $ \(State f i m n s) -> (State (f+1) i m n s, p ++ show f)
setModule :: String -> Compile a ()
setModule m = Compile $ \(State f i _ n s) -> (State f i (Just m) n s, ())
getModule :: Compile a (Maybe String)
getModule = Compile $ \(State f i m n s) -> (State f i m n s, m)
nest :: Compile a ()
nest = Compile $ \(State f i m n s) -> (State f i m (n+1) s, ())
unnest :: Compile a ()
unnest = Compile $ \(State f i m n s) -> (State f i m (n1) s, ())
depth :: Compile a Integer
depth = Compile $ \(State f i m n s) -> (State f i m n s, n)
indent :: Compile String ()
indent = Compile $ \(State f i m n s) -> (State f (" " ++ i) m n s, ())
unindent :: Compile String ()
unindent = Compile $ \(State f i m n s) -> (State f (drop (min (length i) 2) i) m n s, ())
space :: Compile String ()
space = Compile $ \(State f i m n s) -> (State f i m n (s ++ " "), ())
spaces :: Int -> Compile String ()
spaces k = Compile $ \(State f i m n s) -> (State f i m n (s ++ (take k $ repeat ' ')), ())
newline :: Compile String ()
newline = Compile $ \(State f i m n s) -> (State f i m n (s ++ "\n" ++ i), ())
newlines :: Int -> Compile String ()
newlines k = Compile $ \(State f i m n s) -> (State f i m n (s ++ (take k $ repeat '\n') ++ i), ())
string :: String -> Compile String ()
string s' = Compile $ \(State f i m n s) -> (State f i m n (s ++ s'), ())
raw :: String -> Compile String ()
raw = string
--eof