AST.hs

module AST where

data AST = Val String
         | Fun [AST]
         deriving (Show)

takeWord :: String -> String -> (AST,String)
takeWord "" acc       = (Val acc,"")
takeWord (' ':cs) acc = (Val acc,cs)
takeWord (c:cs) acc   = takeWord cs (acc++[c])

toLastParen :: String -> String -> Int -> (String,String)
toLastParen "" acc _ = (acc,"")
toLastParen (')':s) acc n
  | n == 0    = (acc,s)
  | otherwise = toLastParen s (acc++[')']) (n-1)
toLastParen ('(':s) acc n = toLastParen s (acc++['(']) (n+1)
toLastParen (c:s) acc n   = toLastParen s (acc++[c]) n

parse :: String -> AST
parse s = Fun $ parse' s [] where
  parse' "" acc = acc
  parse' ('(':s) acc = parse' rst' (acc ++ [parse s'])
    where (s',rst) = toLastParen s "" 0
          rst'     = case rst of --
            [] -> []
            _  -> tail rst
  parse' s acc = parse' s' (acc ++ [word])
    where (word,s') = takeWord s ""

main :: IO ()
main = do putStrLn "Enter a Lisp expression."
          lisp <- getLine
          case lisp of
            ('(':rst) -> --
              putStrLn $ show $ parse exp where
                (exp,_) = toLastParen rst "" 0
            _         ->
              putStrLn $ show $ fst $ takeWord lisp ""
          -- testing purposes
          -- putStrLn ""
          -- main