S-expressions: Difference between revisions

Content added Content deleted
(Added 11l)
Line 3,178: Line 3,178:
Or, parsing by hand (rather than with a parser combinator library) and printing a parse tree diagram:
Or, parsing by hand (rather than with a parser combinator library) and printing a parse tree diagram:
<lang haskell>{-# LANGUAGE TupleSections #-}
<lang haskell>{-# LANGUAGE TupleSections #-}

import Data.Bifunctor (bimap)
import Data.Bifunctor (bimap)
import Data.List (mapAccumL)
import Data.List (mapAccumL)
Line 3,184: Line 3,184:
import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
import Data.Tree (Forest, Tree (..), drawForest)
import Data.Tree (Forest, Tree (..), drawForest)

------------------------ DATA TYPE -----------------------
------------------------ DATA TYPE -----------------------
data Val
data Val
Line 3,193: Line 3,193:
| List [Val]
| List [Val]
deriving (Eq, Show, Read)
deriving (Eq, Show, Read)

instance Semigroup Val where
instance Semigroup Val where
List a <> List b = List (a <> b)
List a <> List b = List (a <> b)

instance Monoid Val where
instance Monoid Val where
mempty = List []
mempty = List []

--------------------------- MAIN -------------------------
--------------------------- MAIN -------------------------
main :: IO ()
main :: IO ()
Line 3,209: Line 3,209:
]
]
parse = fst (parseExpr (tokenized expr))
parse = fst (parseExpr (tokenized expr))

putStrLn $ treeDiagram $ forestFromVal parse
putStrLn $ treeDiagram $ forestFromVal parse
putStrLn "Serialized from the parse tree:\n"
putStrLn "Serialized from the parse tree:\n"
putStrLn $ litVal parse
putStrLn $ litVal parse

------------------- S-EXPRESSION PARSER ------------------
------------------- S-EXPRESSION PARSER ------------------

parseExpr :: [String] -> (Val, [String])
parseExpr :: [String] -> (Val, [String])
parseExpr = until finished parseToken . (mempty,)
parseExpr = until finished parseToken . (mempty,)

finished :: (Val, [String]) -> Bool
finished :: (Val, [String]) -> Bool
finished (_, []) = True
finished (_, []) = True
finished (_, token : _) = ")" == token
finished (_, token : _) = ")" == token

parseToken :: (Val, [String]) -> (Val, [String])
parseToken :: (Val, [String]) -> (Val, [String])
parseToken (v, "(" : rest) =
parseToken (v, "(" : rest) =
Line 3,231: Line 3,231:
parseToken (v, ")" : rest) = (v, rest)
parseToken (v, ")" : rest) = (v, rest)
parseToken (v, t : rest) = (v <> List [atom t], rest)
parseToken (v, t : rest) = (v <> List [atom t], rest)

----------------------- TOKEN PARSER ---------------------
----------------------- TOKEN PARSER ---------------------

atom :: String -> Val
atom :: String -> Val
atom [] = mempty
atom [] = mempty
Line 3,242: Line 3,242:
catMaybes $
catMaybes $
maybeRead . (<> (' ' : s)) <$> ["Int", "Float"]
maybeRead . (<> (' ' : s)) <$> ["Int", "Float"]

maybeRead :: String -> Maybe Val
maybeRead :: String -> Maybe Val
maybeRead = fmap fst . listToMaybe . reads
maybeRead = fmap fst . listToMaybe . reads

----------------------- TOKENIZATION ---------------------
----------------------- TOKENIZATION ---------------------

tokenized :: String -> [String]
tokenized :: String -> [String]
tokenized s = quoteTokens '"' s >>= go
tokenized s = quoteTokens '"' s >>= go
Line 3,254: Line 3,254:
go token@('"' : _) = [token]
go token@('"' : _) = [token]
go s = words $ spacedBrackets s
go s = words $ spacedBrackets s

quoteTokens :: Char -> String -> [String]
quoteTokens :: Char -> String -> [String]
quoteTokens q s = snd $ mapAccumL go False (splitOn [q] s)
quoteTokens q s = snd $ mapAccumL go False (splitOn [q] s)
Line 3,261: Line 3,261:
| b = (False, '"' : s <> "\"")
| b = (False, '"' : s <> "\"")
| otherwise = (True, s)
| otherwise = (True, s)

spacedBrackets :: String -> String
spacedBrackets :: String -> String
spacedBrackets [] = []
spacedBrackets [] = []
Line 3,267: Line 3,267:
| c `elem` "()" = ' ' : c : " " <> spacedBrackets cs
| c `elem` "()" = ' ' : c : " " <> spacedBrackets cs
| otherwise = c : spacedBrackets cs
| otherwise = c : spacedBrackets cs

----------------------- DIAGRAMMING ----------------------
------------------------- DIAGRAMS -----------------------

treeDiagram :: Forest Val -> String
treeDiagram :: Forest Val -> String
treeDiagram = drawForest . fmap (fmap show)
treeDiagram = drawForest . fmap (fmap show)

forestFromVal :: Val -> Forest Val
forestFromVal :: Val -> Forest Val
forestFromVal (List xs) = treeFromVal <$> xs
forestFromVal (List xs) = treeFromVal <$> xs

treeFromVal :: Val -> Tree Val
treeFromVal :: Val -> Tree Val
treeFromVal (List xs) =
treeFromVal (List xs) =
Node (Symbol "List") (treeFromVal <$> xs)
Node (Symbol "List") (treeFromVal <$> xs)
treeFromVal v = Node v []
treeFromVal v = Node v []

----------------------- SERIALIZING ----------------------
---------------------- SERIALISATION ---------------------

litVal (Symbol x) = x
litVal (Symbol x) = x
litVal (Int x) = show x
litVal (Int x) = show x
Line 3,289: Line 3,289:
litVal (List [List xs]) = litVal (List xs)
litVal (List [List xs]) = litVal (List xs)
litVal (List xs) = '(' : (unwords (litVal <$> xs) <> ")")
litVal (List xs) = '(' : (unwords (litVal <$> xs) <> ")")

------------------------- GENERIC ------------------------
------------------------- GENERIC ------------------------

headDef :: a -> [a] -> a
headDef :: a -> [a] -> a
headDef d [] = d
headDef d [] = d