S-expressions: Difference between revisions
Content deleted Content added
Alextretyak (talk | contribs) Added 11l |
|||
Line 3,178:
Or, parsing by hand (rather than with a parser combinator library) and printing a parse tree diagram:
<lang haskell>{-# LANGUAGE TupleSections #-}
import Data.Bifunctor (bimap)
import Data.List (mapAccumL)
Line 3,184:
import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
import Data.Tree (Forest, Tree (..), drawForest)
------------------------ DATA TYPE -----------------------
data Val
Line 3,193:
| List [Val]
deriving (Eq, Show, Read)
instance Semigroup Val where
List a <> List b = List (a <> b)
instance Monoid Val where
mempty = List []
--------------------------- MAIN -------------------------
main :: IO ()
Line 3,209:
]
parse = fst (parseExpr (tokenized expr))
putStrLn $ treeDiagram $ forestFromVal parse
putStrLn "Serialized from the parse tree:\n"
putStrLn $ litVal parse
------------------- S-EXPRESSION PARSER ------------------
parseExpr :: [String] -> (Val, [String])
parseExpr = until finished parseToken . (mempty,)
finished :: (Val, [String]) -> Bool
finished (_, []) = True
finished (_, token : _) = ")" == token
parseToken :: (Val, [String]) -> (Val, [String])
parseToken (v, "(" : rest) =
Line 3,231:
parseToken (v, ")" : rest) = (v, rest)
parseToken (v, t : rest) = (v <> List [atom t], rest)
----------------------- TOKEN PARSER ---------------------
atom :: String -> Val
atom [] = mempty
Line 3,242:
catMaybes $
maybeRead . (<> (' ' : s)) <$> ["Int", "Float"]
maybeRead :: String -> Maybe Val
maybeRead = fmap fst . listToMaybe . reads
----------------------- TOKENIZATION ---------------------
tokenized :: String -> [String]
tokenized s = quoteTokens '"' s >>= go
Line 3,254:
go token@('"' : _) = [token]
go s = words $ spacedBrackets s
quoteTokens :: Char -> String -> [String]
quoteTokens q s = snd $ mapAccumL go False (splitOn [q] s)
Line 3,261:
| b = (False, '"' : s <> "\"")
| otherwise = (True, s)
spacedBrackets :: String -> String
spacedBrackets [] = []
Line 3,267:
| c `elem` "()" = ' ' : c : " " <> spacedBrackets cs
| otherwise = c : spacedBrackets cs
-------------------------
treeDiagram :: Forest Val -> String
treeDiagram = drawForest . fmap (fmap show)
forestFromVal :: Val -> Forest Val
forestFromVal (List xs) = treeFromVal <$> xs
treeFromVal :: Val -> Tree Val
treeFromVal (List xs) =
Node (Symbol "List") (treeFromVal <$> xs)
treeFromVal v = Node v []
litVal (Symbol x) = x
litVal (Int x) = show x
Line 3,289:
litVal (List [List xs]) = litVal (List xs)
litVal (List xs) = '(' : (unwords (litVal <$> xs) <> ")")
------------------------- GENERIC ------------------------
headDef :: a -> [a] -> a
headDef d [] = d
|