S-expressions: Difference between revisions
Content added Content deleted
Alextretyak (talk | contribs) (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 |
||
----------------------- |
------------------------- 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 [] |
||
---------------------- 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 |