diff --git a/Grm/Layout.hs b/Grm/Layout.hs
new file mode 100644
--- /dev/null
+++ b/Grm/Layout.hs
@@ -0,0 +1,69 @@
+{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
+
+-- The grm grammar generator
+-- Copyright 2011-2012, Brett Letner
+
+module Grm.Layout (layout) where
+
+import Grm.Lex
+import Grm.Prims
+
+layout :: [Token Point] -> [Token Point]
+layout ts = loop [] ts
+  where
+  loop [] [] = []
+
+  loop (_:cs) [] = stopSyms eofLoc ++ loop cs []
+
+  loop cs (x:y:xs) | isStopSym x && isStopWord y = x : y : loop cs xs
+
+  loop (_:cs) (x:xs) | isStopWord x =
+    stopSyms (startLoc x) ++ [x] ++ loop (filter ((>=) $ col x) cs) xs
+
+  loop (c:cs) xs0@(x:_) | col x < c = stopSyms (startLoc x) ++ loop cs xs0
+
+  loop (c:cs) (x:xs) | col x == c && (isWord ["where"] x) = stopSyms (startLoc x) ++ cont cs x xs
+
+  loop cs0@(c:_) (x:xs) | col x == c = termSym (startLoc x) : cont cs0 x xs
+
+  loop cs0 (x:xs) = cont cs0 x xs
+
+  cont cs0 x0 [] | isStartWord x0 = x0 : startSym (stopLoc x0) : loop (col x0 : cs0) []
+
+  cont cs0 x0 (x:xs) | isStartWord x0 && not (isStartSym x) =
+    x0 : startSym (startLoc x) : cont (col x : cs0) x xs
+
+  cont cs0 x xs0 = x : loop cs0 xs0
+
+  eofLoc = stopLoc $ last ts
+
+isStartWord :: Token Point -> Bool
+isStartWord = isWord [ "where", "do", "of", "imports", "exports", "branch" ] -- , "let"
+
+isStopWord :: Token Point -> Bool
+isStopWord = isWord [ "until" ]
+
+isStartSym :: Token Point -> Bool
+isStartSym = isWord ["{"]
+
+isStopSym :: Token Point -> Bool
+isStopSym = isWord ["}"]
+
+isWord :: [String] -> Token Point -> Bool
+isWord ss (TSymbol _ s) = s `elem` ss
+isWord _ _ = False
+
+col :: Token Point -> Int
+col = locColumn . startLoc
+
+mkSym :: String -> Loc -> Token Point
+mkSym s l = TSymbol (Point l l) s
+
+startSym :: Loc -> Token Point
+startSym = mkSym "{"
+
+stopSyms :: Loc -> [Token Point]
+stopSyms loc = [ termSym loc, mkSym "}" loc ]
+
+termSym :: Loc -> Token Point
+termSym = mkSym ";"
diff --git a/Grm/Lex.hs b/Grm/Lex.hs
new file mode 100644
--- /dev/null
+++ b/Grm/Lex.hs
@@ -0,0 +1,536 @@
+{-# OPTIONS -Wall #-}
+
+-- The grm grammar generator
+-- Copyright 2011-2012, Brett Letner
+
+module Grm.Lex
+  ( Token(..)
+  , Point(..)
+  , lexFilePath
+  , lexContents
+  , ppToken
+  , ppTokenList
+  , happyError
+  , notWSToken
+  , unTWhitespace
+  , unTSLComment
+  , unTMLComment
+  , unTString
+  , unTChar
+  , unTNumber
+  , unTSymbol
+  , unTUsym
+  , unTUident
+  , unTLident
+  ) where
+
+import Control.Monad
+import Data.Char
+-- import Numeric
+import Data.List
+import Grm.Prims
+import Text.PrettyPrint.Leijen
+
+happyError :: [Token Point] -> a
+happyError [] = error "unexpected end of tokens"
+happyError (t:_) = error $ ppErr (startLoc t) ("unexpected token: " ++ show (show (ppToken t)))
+
+-- fixme: doesn't work for empty modules (e.g. module Foo where)
+
+notWSToken :: Token t -> Bool
+notWSToken t = case t of
+  TWhitespace{} -> False
+  TSLComment{} -> False
+  TMLComment{} -> False
+  _ -> True
+
+data Token a
+  = TWhitespace a String
+  | TSLComment a String
+  | TMLComment a String
+  | TString a String
+  | TChar a Char
+  | TNumber a String
+  | TSymbol a String
+  | TUsym a String
+  | TUident a String
+  | TLident a String
+  deriving (Show)
+
+unTWhitespace :: Token t -> String
+unTWhitespace (TWhitespace _ b) = b
+unTWhitespace _ = error "unTWhitespace"
+
+unTSLComment :: Token t -> String
+unTSLComment (TSLComment _ b) = b
+unTSLComment _ = error "unTSLComment"
+
+unTMLComment :: Token t -> String
+unTMLComment (TMLComment _ b) = b
+unTMLComment _ = error "unTMLComment"
+
+unTString :: Token t -> String
+unTString (TString _ b) = b
+unTString _ = error "unTString"
+
+unTChar :: Token t -> Char
+unTChar (TChar _ b) = b
+unTChar _ = error "unTChar"
+
+unTNumber :: Token t -> String
+unTNumber (TNumber _ b) = b
+unTNumber _ = error "unTNumber"
+
+unTSymbol :: Token t -> String
+unTSymbol (TSymbol _ b) = b
+unTSymbol _ = error "unTSymbol"
+
+unTUsym :: Token t -> String
+unTUsym (TUsym _ b) = b
+unTUsym _ = error "unTUsym"
+
+unTUident :: Token t -> String
+unTUident (TUident _ b) = b
+unTUident _ = error "unTUident"
+
+unTLident :: Token t -> String
+unTLident (TLident _ b) = b
+unTLident _ = error "unTLident"
+
+instance Eq (Token a) where
+  (==) a b = case (a,b) of
+    (TWhitespace _ x, TWhitespace _ y) -> x == y
+    (TSLComment _ x, TSLComment _ y) -> x == y
+    (TMLComment _ x, TMLComment _ y) -> x == y
+    (TString _ x, TString _ y) -> x == y
+    (TChar _ x, TChar _ y) -> x == y
+    (TNumber _ x, TNumber _ y) -> x == y -- numbers are compared lexically
+    (TSymbol _ x, TSymbol _ y) -> x == y
+    (TUsym _ x, TUsym _ y) -> x == y
+    (TUident _ x, TUident _ y) -> x == y
+    (TLident _ x, TLident _ y) -> x == y
+    _ -> False
+
+ppTokenList :: [Token a] -> Doc
+ppTokenList = sep . map ppToken
+
+ppToken :: Token a -> Doc
+ppToken t = text $ case t of
+  TWhitespace _ s -> s
+  TSLComment _ s -> s
+  TMLComment _ s -> s
+  TString _ a -> show a
+  TChar _ a -> show a
+  TNumber _ s -> s
+  TSymbol _ s -> s
+  TUsym _ s -> s
+  TUident _ s -> s
+  TLident _ s -> s
+
+instance HasMeta Token where
+  meta t = case t of
+    TWhitespace a _ -> a
+    TSLComment a _ -> a
+    TMLComment a _ -> a
+    TString a _ -> a
+    TChar a _ -> a
+    TNumber a _ -> a
+    TSymbol a _ -> a
+    TUsym a _ -> a
+    TUident a _ -> a
+    TLident a _ -> a
+
+  -- mapMetaM f t = case t of
+  --   TWhitespace a b -> f a >>= \x -> return (TWhitespace x b)
+  --   TSLComment a b -> f a >>= \x -> return (TSLComment x b)
+  --   TMLComment a b -> f a >>= \x -> return (TMLComment x b)
+  --   TString a b -> f a >>= \x -> return (TString x b)
+  --   TChar a b -> f a >>= \x -> return (TChar x b)
+  --   TNumber a b -> f a >>= \x -> return (TNumber x b)
+  --   TSymbol a b -> f a >>= \x -> return (TSymbol x b)
+  --   TUsym a b -> f a >>= \x -> return (TUsym x b)
+  --   TUident a b -> f a >>= \x -> return (TUident x b)
+  --   TLident a b -> f a >>= \x -> return (TLident x b)
+
+lexFilePath :: [String] -> FilePath -> IO [Token Point]
+lexFilePath syms fn = do
+  s <- readFile fn
+  lexContents syms fn s
+
+lexContents :: [String] -> FilePath -> String -> IO [Token Point]
+lexContents syms fn s = do
+  let st0 = initSt syms fn $ filter ((/=) '\r') s
+  let M f = lexTokens
+  case f st0 of
+    (Left e, st) -> error $ ppErr (stLoc st) e
+    (Right ts, st) -> case stInput st of
+      "" -> return ts
+      e -> error $ ppErr (stLoc st) $ "lexical error:" ++ show (head e)
+
+initSt :: [String] -> FilePath -> String -> St
+initSt syms fn s = St
+  { stLoc = initLoc fn
+  , stInput = s
+  , stSymbols = syms
+  }
+
+instance Monad M where
+  (M f) >>= g = M $ \st ->
+    let (ma, st1) = f st
+      in case ma of
+        Left e -> (Left e, st)
+        Right a ->
+          let M h = g a
+            in h st1
+
+  return a = M $ \st -> (Right a, st)
+  fail s = M $ \st -> (Left s, st)
+
+data M a = M (St -> (Either String a, St))
+
+getSt :: M St
+getSt = M $ \st -> (Right st, st)
+
+lexAnyChar :: M Char
+lexAnyChar = M $ \st ->
+  let
+    loc0 = stLoc st
+    in case stInput st of
+      "" -> (Left "unexpected eof", st)
+      (c:cs) | c == eolChar ->
+        (Right c, st{ stInput = cs
+                    , stLoc = loc0{ locColumn = 0, locLine = succ (locLine loc0) }})
+      (c:cs) ->
+        (Right c, st{ stInput = cs
+                    , stLoc = loc0{ locColumn = succ (locColumn loc0) }})
+
+tryLex :: M a -> M (Maybe a)
+tryLex (M f) = M $ \st -> case f st of
+  (Left _, _) -> (Right Nothing, st)
+  (Right a, st1) -> (Right $ Just a, st1)
+
+data St = St
+  { stLoc :: Loc
+  , stInput :: String
+  , stSymbols :: [String]
+  } deriving (Show)
+
+qualChar :: Char
+qualChar = '.'
+
+escChar :: Char
+escChar = '\\'
+
+dQuoteChar :: Char
+dQuoteChar = '"'
+
+sQuoteChar :: Char
+sQuoteChar = '\''
+
+eolChar :: Char
+eolChar = '\n'
+
+wsChar :: String
+wsChar = [ ' ', eolChar ]
+
+slCommentStart :: String
+slCommentStart = "//"
+
+mlCommentStart :: String
+mlCommentStart = "/*"
+
+mlCommentEnd :: String
+mlCommentEnd = "*/"
+
+-- slCommentStart = "--", doesn't work if you support the decrement statement, e.g. i--
+-- mlCommentStart = "{-"
+-- mlCommentEnd = "-}"
+
+uidentStart :: String
+uidentStart = [ 'A' .. 'Z' ]
+
+lidentStart :: String
+lidentStart = '_' : [ 'a' .. 'z' ]
+
+identEnd :: String
+identEnd = uidentStart ++ lidentStart ++ [ '0' .. '9' ]
+
+getLoc :: M Loc
+getLoc = liftM stLoc getSt
+
+getSymbols :: M [String]
+getSymbols = liftM stSymbols getSt
+
+lexStringLit :: String -> M String
+lexStringLit s = do
+  s1 <- sequence $ replicate (length s) lexAnyChar
+  if s1 == s
+    then return s
+    else fail $ "unexpected string:" ++ s
+
+lexCharPred :: (Char -> Bool) -> M Char
+lexCharPred p = do
+  c <- lexAnyChar
+  if p c
+    then return c
+    else fail $ "unexpected char:" ++ show c
+
+many :: M a -> M [a]
+many m = do
+  mx <- tryLex m
+  case mx of
+    Just x -> do
+      xs <- many m
+      return $ x : xs
+    Nothing -> return []
+
+oneof :: [M a] -> M a
+oneof [] = fail "token doesn't match any alternatives"
+oneof (m:ms) = do
+  mx <- tryLex m
+  case mx of
+    Just x -> return x
+    Nothing -> oneof ms
+
+lexKeyword :: M (Token Point)
+lexKeyword = do
+  a <- getLoc
+  s <- oneof [ lexUpperWord, lexLowerWord ]
+  ss <- getSymbols
+  b <- getLoc
+  if s `elem` ss
+    then return $ TSymbol (Point a b) s
+    else fail $ "not a keyword:" ++ s
+
+lexSymbol :: M (Token Point)
+lexSymbol = do
+  a <- getLoc
+  ss <- getSymbols
+  s <- oneof [ lexUsymTok, liftM singleton $ lexCharPred (flip elem symChar) ]
+  b <- getLoc
+  if s `elem` ss
+    then return $ TSymbol (Point a b) s
+    else fail $ "not a symbol:" ++ s
+
+usymChar :: String
+usymChar = "!#$%&*+-/:<=>?@\\^|~"
+
+symChar :: String
+symChar = "(),;`{}[]."
+
+lexUsymTok :: M String
+lexUsymTok = many1 (lexCharPred $ flip elem usymChar)
+
+lexUsym :: M (Token Point)
+lexUsym = do
+  a <- getLoc
+  s <- lexUsymTok
+  b <- getLoc
+  return $ TUsym (Point a b) s
+
+lexUident :: M (Token Point)
+lexUident = do
+  a <- getLoc
+  s <- lexQualified
+  b <- getLoc
+  return $ TUident (Point a b) s
+
+lexLident :: M (Token Point)
+lexLident = do
+  a <- getLoc
+  s <- oneof [ lexLowerQualified, lexLowerWord ]
+  b <- getLoc
+  return $ TLident (Point a b) s
+
+lexLowerQualified :: M String
+lexLowerQualified = do
+    s1 <- lexQualified
+    s2 <- do
+      _ <- lexCharPred ((==) qualChar)
+      lexLowerWord
+    return $ qualify [s1,s2]
+
+lexQualified :: M String
+lexQualified = do
+  s0 <- lexUpperWord
+  ss <- many $ do
+    _ <- lexCharPred ((==) qualChar)
+    s <- lexUpperWord
+    return s
+  return $ qualify $ s0 : ss
+
+lexUpperWord :: M String
+lexUpperWord = do
+  c <- lexCharPred (flip elem uidentStart)
+  cs <- many $ lexCharPred (flip elem identEnd)
+  return $ c : cs
+
+lexLowerWord :: M String
+lexLowerWord = do
+  c <- lexCharPred (flip elem lidentStart)
+  cs <- many $ lexCharPred (flip elem identEnd)
+  return $ c : cs
+
+qualify :: [String] -> String
+qualify = concat . intersperse [qualChar]
+
+many1 :: M a -> M [a]
+many1 m = do
+  x <- m
+  xs <- many m
+  return $ x : xs
+
+lexTokens :: M [Token Point]
+lexTokens = many lexToken
+
+lexToken :: M (Token Point)
+lexToken = oneof
+  [ lexWhitespace
+  , lexSingleLineComment
+  , lexMultiLineComment
+  , lexString
+  , lexChar
+  , lexNumber
+  , lexKeyword
+  , lexLident -- must be before lexUident for qualification
+  , lexUident
+  , lexSymbol
+  , lexUsym
+  ]
+
+lexWhitespace :: M (Token Point)
+lexWhitespace = do
+  a <- getLoc
+  s <- many1 $ lexCharPred (flip elem wsChar)
+  b <- getLoc
+  return $ TWhitespace (Point a b) s
+
+lexSingleLineComment :: M (Token Point)
+lexSingleLineComment = do
+  a <- getLoc
+  _ <- lexStringLit slCommentStart
+  cs <- many $ lexCharPred ((/=) eolChar)
+  b <- getLoc
+  return $ TSLComment (Point a b) $ slCommentStart ++ cs
+
+lexMultiLineComment :: M (Token Point)
+lexMultiLineComment = do
+  a <- getLoc
+  s <- lexMLCommentStart
+  b <- getLoc
+  return $ TMLComment (Point a b) s
+
+lexMLCommentStart :: M String
+lexMLCommentStart = do
+  sa <- lexStringLit mlCommentStart
+  sb <- lexMLCommentEnd
+  return $ sa ++ sb
+
+lexMLCommentEnd :: M String
+lexMLCommentEnd = do
+  ms0 <- tryLex $ lexStringLit mlCommentEnd
+  case ms0 of
+    Just s -> return s
+    Nothing -> do
+      ms <- tryLex lexMLCommentStart
+      sa <- case ms of
+        Just s -> return s
+        Nothing -> do
+          c <- lexAnyChar
+          return [c]
+      sb <- lexMLCommentEnd
+      return $ sa ++ sb
+
+lexChar :: M (Token Point)
+lexChar = do
+  a <- getLoc
+  _ <- lexCharPred ((==) sQuoteChar)
+  s <- oneof [ lexEscChar, liftM singleton $ lexCharPred ((/=) sQuoteChar) ]
+  _ <- lexCharPred ((==) sQuoteChar)
+  b <- getLoc
+  return $ TChar (Point a b) $ read ([sQuoteChar] ++ s ++ [sQuoteChar])
+
+lexString :: M (Token Point)
+lexString = do
+  a <- getLoc
+  _ <- lexCharPred ((==) dQuoteChar)
+  s <- liftM concat $ many $ oneof [ lexEscChar, liftM singleton $ lexCharPred ((/=) dQuoteChar) ]
+  _ <- lexCharPred ((==) dQuoteChar)
+  b <- getLoc
+  return $ TString (Point a b) $ read ([dQuoteChar] ++ s ++ [dQuoteChar])
+
+lexDot :: M String
+lexDot = liftM singleton $ lexCharPred ((==) '.')
+
+lexSeq :: [M String] -> M String
+lexSeq = liftM concat . sequence
+
+lexExponent :: M String
+lexExponent = do
+  a <- liftM toLower $
+       oneof [ lexCharPred ((==) 'e'), lexCharPred ((==) 'E') ]
+  b <- oneof [ lexCharPred ((==) '+') >> return ""
+             , liftM singleton $ lexCharPred ((==) '-')
+             , return ""
+             ]
+  c <- lexDecimal
+  return $ a : b ++ c
+  
+lexNumber :: M (Token Point)
+lexNumber = do
+  a <- getLoc
+  c <- oneof
+       [ liftM singleton $ lexCharPred ((==) '-')
+       , return ""
+       ]
+  s <- oneof
+       [ lex0x "0x" isHexit
+       , lex0x "0X" isHexit
+       , lex0x "0o" isOctit
+       , lex0x "0O" isOctit
+       , lex0x "0b" isBinit
+       , lex0x "0B" isBinit
+       , lexFloat
+       , lexDecimal
+       ]
+  b <- getLoc
+  return $ TNumber (Point a b) $ c ++ s
+
+lexFloat :: M String
+lexFloat = oneof
+  [ lexSeq [ lexDecimal, lexDot, lexDecimal, lexExponent ]
+  , lexSeq [ lexDecimal, lexDot, lexDecimal ]
+  , lexSeq [ lexDecimal, lexExponent ]
+  ]
+
+lexDecimal :: M String
+lexDecimal = liftM delLeadingZeros $ many1 $ lexCharPred isDigit
+
+lex0x :: String -> (Char -> Bool) -> M String
+lex0x s f = do
+  cs <- sequence [lexCharPred ((==) c) | c <- s]
+  ds <- many1 $ lexCharPred f
+  return $ map toLower (cs ++ delLeadingZeros ds)
+
+delLeadingZeros :: String -> String
+delLeadingZeros x = case dropWhile ((==) '0') x of
+  [] -> "0"
+  a -> a
+  
+isHexit :: Char -> Bool
+isHexit c = isDigit c || toLower c `elem` ['a' .. 'f']
+
+isOctit :: Char -> Bool
+isOctit c = c `elem` ['0' .. '7']
+
+isBinit :: Char -> Bool
+isBinit c = c `elem` ['0','1']
+
+lexEscChar :: M String
+lexEscChar = do
+  _ <- lexCharPred ((==) escChar)
+  s <- oneof
+    [ liftM (show . (read :: String -> Int)) lexDecimal
+    , liftM singleton lexAnyChar
+    ]
+  return $ escChar : s
diff --git a/Grm/Prims.hs b/Grm/Prims.hs
new file mode 100644
--- /dev/null
+++ b/Grm/Prims.hs
@@ -0,0 +1,199 @@
+{-# OPTIONS -Wall #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-- The grm grammar generator
+-- Copyright 2011-2012, Brett Letner
+
+module Grm.Prims
+  ( module Grm.Prims
+  , module Debug.Trace
+  )
+where
+
+import Control.Monad
+import Data.Char
+import Data.Generics hiding (empty)
+import Data.List
+import Data.Unique
+import Debug.Trace
+import System.Directory
+import System.Exit (ExitCode(..))
+import System.FilePath
+import System.IO
+import System.IO.Unsafe
+import System.Process (system)
+import Text.PrettyPrint.Leijen
+
+data Terminator = Terminator | Separator deriving (Show, Eq)
+
+data Horiz = Vert | Horiz deriving (Show, Eq)
+
+data Empty = Empty | NonEmpty deriving (Show, Eq)
+
+data Point = Point { beginLoc :: Loc, endLoc :: Loc }
+  deriving (Show, Ord, Eq, Data, Typeable)
+
+data Loc = Loc
+  { locFilePath :: FilePath
+  , locLine :: Int
+  , locColumn :: Int
+  } deriving (Show, Eq, Ord, Data, Typeable)
+
+class HasMeta t where
+  meta :: t a -> a
+  -- mapMetaM :: Monad m => (a -> m b) -> t a -> m (t b)
+
+ppString :: String -> Doc
+ppString = text . show
+
+ppInteger :: Integer -> Doc
+ppInteger = text . show
+
+type Number = String
+
+ppNumber :: Number -> Doc
+ppNumber = text
+
+readNumber :: (Num a, Read a) => Number -> a
+readNumber ('-':cs) = negate $ readNumber cs
+readNumber cs | isBinary cs = fromIntegral $ readBinary cs
+readNumber s = read s
+
+readBinary :: String -> Integer
+readBinary = foldl' (\b a -> 2*b + f a) 0 . drop 2
+  where
+    f '0' = 0
+    f '1' = 1
+    f c = error $ "readBinary:" ++ show c
+    
+ppChar :: Char -> Doc
+ppChar c = text s
+  where
+  s = case show c of
+    '\'':'\\':x:_ | isUpper x -> "'\\" ++ show (ord c) ++ "'" -- control chars
+    str -> str
+
+isFloat :: String -> Bool
+isFloat s = '.' `elem` s || 'e' `elem` (map toLower s)
+
+isBinary :: String -> Bool
+isBinary s = 'b' `elem` map toLower s
+
+isOctal :: String -> Bool
+isOctal s = 'o' `elem` map toLower s
+
+ppDouble :: Double -> Doc
+ppDouble = text . show
+
+ppList :: (a -> Doc) -> Terminator -> String -> Horiz -> [a] -> Doc
+ppList f a s b cs = case b of
+  Horiz -> hsep ds
+  Vert -> empty <$> indent 2 (vsep ds) <$> empty
+  where
+    ds = case cs of
+      [] -> []
+      _ -> if a == Terminator then map g cs else map g (init cs) ++ [f $ last cs]
+    g x = if null s then f x else f x <> text s
+
+nubSort :: Ord a => [a] -> [a]
+nubSort = nub . sort
+
+ppLident :: String -> Doc
+ppLident = text
+
+ppMlcode :: String -> Doc
+ppMlcode = text
+
+ppUident :: String -> Doc
+ppUident = text
+
+ppUsym :: String -> Doc
+ppUsym = text
+
+singleton :: a -> [a]
+singleton a = [a]
+
+ppErr :: Loc -> String -> String
+ppErr loc s = ppLoc loc ++ ": " ++ s
+
+ppLoc :: Loc -> String
+ppLoc loc = locFilePath loc ++ ":" ++ show (locLine loc) ++ ":" ++ show (1 + locColumn loc)
+
+startLoc :: HasMeta m => m Point -> Loc
+startLoc = beginLoc . point
+
+stopLoc :: HasMeta m => m Point -> Loc
+stopLoc = endLoc . point
+
+noLoc :: Loc
+noLoc = Loc "" 0 0
+
+noPoint :: Point
+noPoint = Point noLoc noLoc
+
+initLoc :: FilePath -> Loc
+initLoc fn = Loc fn 1 0
+
+point :: HasMeta m => m Point -> Point
+point = meta
+
+lrPoint :: [Point] -> Point
+lrPoint xs = case filter ((/=) noPoint) xs of
+  [] -> noPoint
+  _ -> Point (minimum $ map beginLoc xs) (maximum $ map endLoc xs)
+  
+lrPointList :: HasMeta m => [m Point] -> Point
+lrPointList = lrPoint . map point
+
+type Uident = String
+type Lident = String
+type Mlcode = String
+type Usym = String
+
+ppShow :: Pretty a => a -> String
+ppShow = show . pretty
+
+unreachable :: a
+unreachable = panic "unreachable"
+
+unused :: a
+unused = panic "unused"
+
+panic :: String -> a
+panic s = error $ "internal:" ++ s
+
+lowercase :: String -> String
+lowercase "" = ""
+lowercase (c:cs) = toLower c : cs
+
+freshNm :: IO String
+freshNm = liftM (show . hashUnique) newUnique
+
+commaSep :: [String] -> String
+commaSep = concat . intersperse ", "
+
+mySystem :: String -> IO ()
+mySystem s = do
+  putStrLn s
+  ec <- system s
+  case ec of
+    ExitSuccess -> return ()
+    ExitFailure i -> error $ "unable to execute(" ++ show i ++ "):" ++ s
+
+bitsToEncode :: Integer -> Integer
+bitsToEncode 0 = 0
+bitsToEncode i = ceiling $ logBase 2 (fromIntegral i :: Double)
+
+uId :: a -> String -> String
+{-# NOINLINE uId #-}
+uId a s = seq a $ unsafePerformIO $ liftM ((++) s . show . hashUnique) newUnique
+
+writeFileBinary :: FilePath -> String -> IO ()
+writeFileBinary fn s = withBinaryFile fn WriteMode $ \h -> hPutStrLn h s
+
+findFile :: [FilePath] -> FilePath -> IO (Maybe FilePath)
+findFile [] _ = return Nothing
+findFile (d:ds) n = do
+  let fn = combine d n
+  r <- doesFileExist fn
+  if r then return (Just fn) else findFile ds n
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c)2011-2012, Brett Letner
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Brett Letner nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,31 @@
+Introducing the grm compiler construction tool.  Grm takes a grammar
+specification and generates Haskell bindings.  Grm is essentially a
+simplified bnfc which only generates Haskell (bnfc
+http://www.cse.chalmers.se/research/group/Language-technology/BNFC/).
+
+Given a grammar the tool produces:
+  - an abstract syntax implementation
+  - a Happy parser generator file
+  - a pretty-printer
+
+Grm also has some library code for lexing and misc. language
+development tasks (e.g. unique identifiers).
+
+I use grm heavily in my pec language
+compiler. (git@github.com:stevezhee/pec.git and on hackage).  You can
+check out pec for example grm usage.
+
+Building
+  - type 'make'
+  - resolve all hackage dependencies
+  - type 'make' again
+
+You can download and install grm via cabal or access the git
+repository on github (git@github.com:stevezhee/grm.git).
+
+Any feedback on the design and/or implementation of grm would be
+greatly appreciated :)
+
+Thanks,
+Brett
+brettletner at gmail dot com
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,5 @@
+-- The grm grammar generator
+-- Copyright 2011-2012, Brett Letner
+
+import Distribution.Simple
+main = defaultMain
diff --git a/THANKS b/THANKS
new file mode 100644
--- /dev/null
+++ b/THANKS
@@ -0,0 +1,14 @@
+The developement of grm would not have been possible without the following free software:
+  - ghc http://haskell.org/ghc/
+  - bnfc http://www.cse.chalmers.se/research/group/Language-technology/BNFC/
+  - happy http://haskell.org/happy/
+  - hackage modules http://hackage.haskell.org/packages/hackage.html
+
+In addition I'd like to thank the following people...
+
+Sigbjorn Finne, Andy Gill, Iavor Diatchki, Lee Pike, Isaac
+Potoczny-Jones, Brian Adams, Travis Rhoades, Mike Letner, Brevin
+Letner, and my family
+
+Thanks guys!
+
diff --git a/grm.cabal b/grm.cabal
new file mode 100644
--- /dev/null
+++ b/grm.cabal
@@ -0,0 +1,39 @@
+Name:                grm
+
+Version:             0.1.0
+
+Synopsis:            grm grammar converter
+
+Description:  Grm takes a grammar specification and generates Haskell bindings.  Given a grammar the tool produces an abstract syntax implementation, a Happy parser generator file, and a pretty-printer.
+
+License:             BSD3
+
+License-file:        LICENSE
+
+Author:              Brett Letner <brettletner@gmail.com>
+
+Maintainer:          Brett Letner <brettletner@gmail.com>
+
+Copyright:           Brett Letner 2011-2012
+
+Category:            Development
+
+Build-type:          Simple
+
+Extra-source-files:  README, THANKS
+
+Cabal-version:       >= 1.8
+
+source-repository head
+  type: git
+  location: git://github.com/stevezhee/grm.git
+
+Library
+  Exposed-modules:     Grm.Prims, Grm.Layout, Grm.Lex
+  Build-depends: base < 5, wl-pprint, process, syb, filepath, directory
+
+Executable grm
+  Main-is:             grm.hs
+  Build-depends:       base < 5, parsec, wl-pprint, filepath, cmdargs, directory, Cabal, process, syb
+  Build-tools:         happy
+  
diff --git a/grm.hs b/grm.hs
new file mode 100644
--- /dev/null
+++ b/grm.hs
@@ -0,0 +1,491 @@
+{-# OPTIONS -Wall #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-- The grm grammar generator
+-- Copyright 2011-2012, Brett Letner
+
+module Main where
+
+import Control.Monad
+import Data.Char
+import Data.List
+import Data.Maybe
+import Distribution.Text
+import Grm.Prims
+import Paths_grm
+import System.Console.CmdArgs
+import System.Directory
+import System.FilePath.Posix
+import Text.ParserCombinators.Parsec
+import Text.ParserCombinators.Parsec.Language
+import Text.PrettyPrint.Leijen (braces,brackets,text,hsep,(<+>),empty,vcat,Doc,indent,(<>),parens,int,list)
+import qualified Text.ParserCombinators.Parsec.Token as P
+
+type P a = Parser a
+
+data Args = Args
+  { files :: [FilePath]
+  , locations :: Bool
+  } deriving (Show, Data, Typeable)
+
+argsDesc :: Args
+argsDesc = Args
+  { files = def &= args
+  , locations = def &= help "generate location information"
+  } &= summary summ &= program prog
+  where
+  summ = prog ++ " v" ++ display version ++ ", " ++ copyright
+  prog = "grm"
+  copyright = "(C) Brett Letner 2011-2012"
+
+main :: IO ()
+main = do
+  a <- cmdArgs argsDesc
+  mapM_ (doit (locations a)) $ files a
+
+doit :: Bool -> String -> IO ()
+doit gen_locs fn = do
+  eea <- parseFromFile grm fn
+  case eea of
+    Left e -> error $ show e
+    Right xs -> do
+      let bn = takeBaseName fn
+      let dir = combine "Language" bn
+      createDirectoryIfMissing True dir
+      absGrm gen_locs dir bn xs
+      parGrm gen_locs dir bn xs
+
+absGrm :: Bool -> FilePath -> String -> [Decl] -> IO ()
+absGrm gen_locs dir bn xs = writeFile (combine dir "Abs.hs") $ show d
+  where
+  d = vcat $
+    [ text "{-# LANGUAGE DeriveDataTypeable #-}"
+    , hsep [ text "module"
+           , text $ "Language." ++ bn ++ ".Abs"
+           , text "where"]
+    , vcat [ text "import" <+> text imp | imp <- imps ]
+    , lexDecls xs
+    ] ++
+    map (dataDecl gen_locs) xs ++ 
+    (if gen_locs then map metaDecl xs else []) ++
+    map (ppDecl gen_locs) xs
+  imps =
+    [ "Control.DeepSeq"
+    , "Data.Generics"
+    , "Grm.Prims"
+    , "Grm.Lex"
+    , "Text.PrettyPrint.Leijen"
+    ]
+
+lexDecls :: [Decl] -> Doc
+lexDecls xs = vcat
+  [ hsep [text "myLexemes =", text $ show $ resDecls xs]
+  , text "grmLexFilePath = lexFilePath myLexemes"
+  , text "grmLexContents = lexContents myLexemes"
+  ]
+
+absName :: FilePath -> String
+absName fn = takeBaseName fn
+
+hdr :: String
+hdr = unlines
+  [ "{-# OPTIONS -w #-}"
+  , "-- Haskell module generated by grm *** DO NOT EDIT ***"
+  ]
+
+parGrm :: Bool -> FilePath -> String -> [Decl] -> IO ()
+parGrm gen_locs dir bn xs = do
+  let fn1 = dir </> "Par.y"
+  writeFile fn1 $ show d
+  where
+  d = vcat $
+    [ parHdr
+    ] ++
+    map (parDecl gen_locs [ s | List s _ _ _ _ _ <- xs ]) xs
+  parHdr = vcat $ map text
+    [ "{"
+    , hdr
+    , ""
+    , "module Language." ++ bn ++ ".Par where"
+    , "import Grm.Prims"
+    , "import Grm.Lex"
+    , "import Language." ++ bn ++ ".Abs"
+    , "}"
+    , "%tokentype { (Token Point) }"
+    , "%name grmParse"
+    , "%token"
+    , unlines [ "  " ++ show sym ++ " " ++ "{ TSymbol _ " ++ show sym ++ " }"
+                | sym <- resDecls xs ]
+    , "  uident { TUident _ _ }"
+    , "  usym { TUsym _ _ }"
+    , "  lident { TLident _ _ }"
+    , "  string { TString _ _ }"
+    , "  char { TChar _ _ }"
+    , "  number { TNumber _ _ }"
+    , "%%"
+    ]
+
+capitalize :: String -> String
+capitalize "" = ""
+capitalize (c:cs) = toUpper c : cs
+
+grm :: P [Decl]
+grm = do
+  whiteSpace
+  ds <- many decl
+  eof
+  return ds
+
+pGroup :: P Decl
+pGroup = do
+  reserved "group"
+  liftM Group $ pBraces $ many1 pData
+
+pData :: P DataD
+pData = do
+  reserved "data"
+  n <- identifier
+  xs <- many1 alt
+  return $ DataD n xs
+
+pList :: P Decl
+pList = do
+  reserved "list"
+  liftM6 List identifier identifier pEmpty terminator stringLiteral horiz
+
+decl :: P Decl
+decl = choice [pGroup, liftM (Group . singleton) pData, pType, pList]
+
+vcatStr :: String -> [Doc] -> Doc
+vcatStr s xs = vcat $ intersperse (text s) xs
+
+altList :: [Doc] -> Doc
+altList (x0:xs) = vcat $
+  [text "=" <+> x0] ++ [ text "|" <+> x | x <- xs ] ++
+  [text "deriving (Show,Eq,Ord,Data,Typeable)"]
+altList [] = unreachable
+
+dataDecl :: Bool -> Decl -> Doc
+dataDecl gen_locs x = case x of
+  Group [] -> unreachable
+  Group xs@(DataD n0 _ : _) -> vcat $
+    [text "data" <+> text n0 <+> locs, indent 2 $ altList $ concatMap (dataData gen_locs) xs]
+    ++ types (dataDecl gen_locs) xs
+  Type a b -> dataType gen_locs a $ text (capitalize b) <+> locs
+  List a b _ _ _ _ -> dataType gen_locs a $ brackets $ text b <+> locs
+  where
+    locs = if gen_locs then text "a" else empty
+    
+types :: (Decl -> Doc) -> [DataD] -> [Doc]
+types f (DataD b _ : xs) = [ f $ Type a b | DataD a _ <- xs ]
+types _ [] = unreachable
+
+dataType :: Bool -> String -> Doc -> Doc
+dataType gen_locs a b = hsep [text "type", text a, locs, text "=", b]
+  where locs = if gen_locs then text "a" else empty
+        
+dataData :: Bool -> DataD -> [Doc]
+dataData gen_locs (DataD _ xs) =
+  [ hsep $ map text $ s : locs : (catMaybes $ map (nameAltTok gen_locs) ts)
+    | Alt s ts <- xs ]
+  where locs = if gen_locs then "a" else ""
+        
+nameAltTok :: Bool -> AltTok -> Maybe String
+nameAltTok gen_locs x = case x of
+  StringT{} -> Nothing
+  IdentT s -> Just $ if gen_locs then "(" ++ s ++ " a)" else s
+  PrimT s -> Just $ capitalize s
+
+metaDecl :: Decl -> Doc
+metaDecl x = case x of
+  Group [] -> unreachable
+  Group xs@(DataD n0 _ : _) -> vcat $
+    [ hsep [text "instance HasMeta", text n0, text "where"]
+    , indent 2 $ text $ "meta x = case x of"
+    , indent 4 $ vcat $ concatMap metaData xs
+    ]
+  Type{} -> empty
+  List{} -> empty
+
+metaData :: DataD -> [Doc]
+metaData (DataD _ xs) = [ f s ts | Alt s ts <- xs ]
+  where
+  f s ts =
+    hsep [text s, text "a", hsep $ replicate (length ys) (text "_"), text "-> a" ]
+    where
+    ys = filter (not . isStringT) ts
+
+ppDecl :: Bool -> Decl -> Doc
+ppDecl gen_locs x = case x of
+  Group [] -> unreachable
+  Group xs@(DataD n0 _ : _) -> vcat $
+    [ hsep [ text "instance Pretty"
+           , parens (text n0 <+> if gen_locs then text "a" else empty)
+           , text "where" ]
+    , indent 2 $ text "pretty = pp" <> text n0
+    , text $ "pp" ++ n0 ++ " x = case x of"
+    , indent 2 $ vcat $ concatMap (ppData gen_locs) xs
+    ] ++ types (ppDecl gen_locs) xs
+  Type a b -> hsep $ map text ["pp" ++ a, "=", "pp" ++ capitalize b]
+  List a b _ d e f ->
+    hsep $ map text ["pp" ++ a, "=", "ppList", "pp" ++ b, show d, show e, show f]
+
+ppData :: Bool -> DataD -> [Doc]
+ppData gen_locs (DataD _ xs) = [ f s ts | Alt s ts <- xs ]
+  where
+  f s ts =
+    hsep [ text s
+         , if gen_locs then text "_" else empty
+         , hsep $ map text [ v | (Just v, _) <- ys ], text "->", ppAltToks ys ]
+    where
+    ys = nameToks "v" $ numberToks (not . isStringT) ts
+
+isStringT :: AltTok -> Bool
+isStringT (StringT{}) = True
+isStringT _ = False
+
+nameToks :: String -> [(Maybe Int, AltTok)] -> [(Maybe String, AltTok)]
+nameToks s xs = [ (fmap (\i -> s ++ show i) mi, t) | (mi,t) <- xs ]
+
+resDecls :: [Decl] -> [String]
+resDecls xs = filter (not . null) $ sort $ nub $ concatMap resDecl xs
+
+numberToks :: (AltTok -> Bool) -> [AltTok] -> [(Maybe Int, AltTok)]
+numberToks f = loop 1
+  where
+  loop _ [] = []
+  loop i (x:xs)
+    | f x = (Just i, x) : loop (succ i) xs
+    | otherwise = (Nothing, x) : loop i xs
+
+ppAltToks :: [(Maybe String, AltTok)] -> Doc
+ppAltToks [] = text "Text.PrettyPrint.Leijen.empty"
+ppAltToks [x] = ppAltTok x
+ppAltToks (x:y:xs) = ppAltTok x <+> rest
+  where
+  rest = case y of
+    (_, StringT "") -> text "<>" <+> ppAltToks xs
+    _ -> text "<+>" <+> ppAltToks (y:xs)
+
+ppAltTok :: (Maybe String, AltTok) -> Doc
+ppAltTok x = case x of
+  (_, StringT "") -> error "unexpected empty string"
+  (_, StringT s) -> hsep [text "text", text $ show s]
+  (Just v, IdentT s) -> text $ "pp" ++ s ++ " " ++ v
+  (mv, PrimT s) -> ppAltTok (mv, IdentT $ capitalize s)
+  _ -> unreachable
+
+pEmpty :: P Empty
+pEmpty = choice
+  [ reserved "empty" >> return Empty
+  , reserved "nonempty" >> return NonEmpty
+  ]
+
+terminator :: P Terminator
+terminator = choice
+  [ reserved "separator" >> return Separator
+  , reserved "terminator" >> return Terminator
+  ]
+
+horiz :: P Horiz
+horiz = choice
+  [ reserved "vert" >> return Vert
+  , reserved "horiz" >> return Horiz
+  ]
+
+alt :: P Alt
+alt = do
+  reservedOp "|"
+  choice [pAlt,defAlt]
+
+pAlt :: P Alt
+pAlt = do
+  c <- identifier
+  ts <- many altTok
+  return $ Alt c ts
+
+defAlt :: P Alt
+defAlt = do
+  reserved "_"
+  liftM DefAlt identifier
+
+pType :: P Decl
+pType = do
+  reserved "type"
+  c <- identifier
+  reservedOp "="
+  p <- identifier
+  return $ Type c p
+
+altTok :: P AltTok
+altTok = choice
+  [ liftM StringT stringLiteral
+  , liftM IdentT identifier
+  , liftM PrimT prim
+  ]
+
+prim :: P String
+prim = choice $ map res primNames
+
+res :: String -> P String
+res s = reserved s >> return s
+
+primNames :: [String]
+primNames = ["string","number","char","uident","lident","usym"]
+
+data Decl
+  = Group [DataD]
+  | Type String String
+  | List String String Empty Terminator String Horiz
+  deriving Show
+
+resDecl :: Decl -> [String]
+resDecl x = case x of
+  Group xs -> concatMap resData xs
+  Type{} -> []
+  List _ _ _ _ s _ -> [s]
+
+resData :: DataD -> [String]
+resData (DataD _ xs) = concatMap resAlt xs
+
+resAlt :: Alt -> [String]
+resAlt x = case x of
+  Alt _ ys -> concatMap resAltTok ys
+  DefAlt{} -> []
+
+data DataD = DataD String [Alt] deriving Show
+
+data Alt
+  = Alt String [AltTok]
+  | DefAlt String
+  deriving Show
+
+resAltTok :: AltTok -> [String]
+resAltTok x = case x of
+  StringT s -> [s]
+  _ -> []
+
+data AltTok
+  = StringT String
+  | IdentT String
+  | PrimT String
+  deriving (Show, Eq)
+
+parData :: Bool -> [String] -> DataD -> Doc
+parData gen_locs ss (DataD c xs0) = case filter f xs0 of
+  [] -> unreachable
+  x0:xs -> vcat
+    [ text c
+    , indent 2 $ vcat
+        [ hsep [ text ":", parAlt gen_locs ss x0 ]
+        , vcat [ text "|" <+> parAlt gen_locs ss x | x <- xs ]
+        ]
+    ]
+  where
+  f x = case x of
+    Alt a _ -> last a /= '_'
+    DefAlt{} -> True
+
+parAlt :: Bool -> [String] -> Alt -> Doc
+parAlt gen_locs ss x = case x of
+  Alt c ts -> hsep $
+    map parAltTokL ts ++
+    [braces $ hsep $ text c : (if gen_locs then loc else empty) : map parAltTokR ns ]
+    where
+    ns = nameToks "$" $ numberToks ((/=) (StringT "")) ts
+    loc = case filter ((/=) (StringT "")) ts of
+      [] -> text "noPoint"
+      [_] -> parens (text "point $1")
+      zs -> parens $ text "lrPoint" <+> list (map (pointAltTok ss) (zip zs [ 1 .. ]))
+  DefAlt c -> hsep [text c, text "{ $1 }"]
+
+pointAltTok :: [String] -> (AltTok,Int) -> Doc
+pointAltTok ss (x,i) = case x of
+  IdentT s | s `elem` ss -> text "lrPointList" <+> text "$" <> int i
+  _ -> text "point" <+> text "$" <> int i
+
+parAltTokR :: (Maybe String, AltTok) -> Doc
+parAltTokR x = case x of
+  (Just i, IdentT _) -> text i
+  (Just i, PrimT s) -> parens (text ("unT" ++ capitalize s) <+> text i)
+  _ -> empty
+
+parAltTokL :: AltTok -> Doc
+parAltTokL x = case x of
+  StringT "" -> empty
+  StringT s -> text $ show s
+  IdentT s -> text s
+  PrimT s -> text s
+
+parDecl :: Bool -> [String] -> Decl -> Doc
+parDecl gen_locs ss x = case x of
+  Type a b -> hsep [text a, text ":", text b, braces $ text "$1"]
+  Group xs -> vcat $ map (parData gen_locs ss) xs
+  List prodsStr prodStr empt term sepStr _ -> vcat
+    [ prods
+    , indent 2 $ vcat
+      [ hsep [text ":", rev_prods, braces $ text "reverse $1"]
+      , case empt of
+          Empty -> text "| {- empty -} { [] }"
+          NonEmpty -> empty
+      ]
+    , rev_prods
+    , indent 2 $ vcat
+      [ hsep [text ":", a, braces $ brackets $ text "$1"]
+      , hsep [text "|", rev_prods, b, braces $ hsep [c, text ": $1"]]
+      ]
+    ]
+    where
+    a = case term of
+      Terminator | sepStr /= "" -> prod <+> sp
+      _ -> prod
+    b = case (sepStr, term) of
+      ("", _) -> prod
+      (_, Terminator) -> prod <+> sp
+      (_, Separator) -> sp <+> prod
+    c = case term of
+      Separator | sepStr /= "" -> text "$3"
+      _ -> text "$2"
+    sp = text $ show sepStr
+    rev_prods = text $ "REV_" ++ prodsStr
+    prod = text prodStr
+    prods = text prodsStr
+
+
+lexer :: P.TokenParser a
+lexer = P.makeTokenParser grmStyle
+
+reserved :: String -> P ()
+reserved = P.reserved lexer
+
+pBraces :: P a -> P a
+pBraces = P.braces lexer
+
+identifier :: P String
+identifier = P.identifier lexer
+
+reservedOp :: String -> P ()
+reservedOp = P.reservedOp lexer
+
+stringLiteral :: P String
+stringLiteral = P.stringLiteral lexer
+
+whiteSpace :: P ()
+whiteSpace = P.whiteSpace lexer
+
+grmStyle :: LanguageDef a
+grmStyle = haskellStyle
+  { P.identStart = upper
+  }
+
+liftM6 :: Monad m =>
+  (t -> t1 -> t2 -> t3 -> t4 -> t5 -> b) ->
+  m t -> m t1 -> m t2 -> m t3 -> m t4 -> m t5 -> m b
+liftM6 z ma mb mc md me mf = do
+  a <- ma
+  b <- mb
+  c <- mc
+  d <- md
+  e <- me
+  f <- mf
+  return $ z a b c d e f