S-expressions: Difference between revisions
Content added Content deleted
m (→JavaScript :: Functional: Added one comment line) |
(→{{header|Haskell}}: Added a variant which parses by hand and shows a parse tree diagram.) |
||
Line 3,027: | Line 3,027: | ||
Parsed as: |
Parsed as: |
||
List [List [Symbol "data",String "quoted data",Int 123,Float 4.5],List [Symbol "data",List [Symbol "!@#",List [Float 4.5],String "(more",String "data)"]]]</pre> |
List [List [Symbol "data",String "quoted data",Int 123,Float 4.5],List [Symbol "data",List [Symbol "!@#",List [Float 4.5],String "(more",String "data)"]]]</pre> |
||
Or, parsing by hand (rather than with a parser combinator library) and printing a parse tree diagram: |
|||
<lang haskell>import Data.Bifunctor (bimap) |
|||
import Data.List.Split (splitOn) |
|||
import Data.Maybe (catMaybes, fromMaybe, listToMaybe) |
|||
import Data.Tree (Tree (..), drawForest) |
|||
------------------------ DATA TYPES ---------------------- |
|||
data Val |
|||
= Int Integer |
|||
| Float Double |
|||
| String String |
|||
| Symbol String |
|||
| 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 () |
|||
main = do |
|||
let expr = |
|||
unlines |
|||
[ "((data \"quoted data\" 123 4.5)", |
|||
" (data (!@# (4.5) \"(more\" \"data)\")))" |
|||
] |
|||
putStrLn $ |
|||
drawForest $ |
|||
fmap show |
|||
<$> fst (parseExpr (tokenized expr)) |
|||
------------------ PARSING S-EXPRESSIONS ----------------- |
|||
parseExpr :: [String] -> ([Tree Val], [String]) |
|||
parseExpr = go |
|||
where |
|||
finished (_, []) = True |
|||
finished (_, ")" : _) = True |
|||
finished (_, _) = False |
|||
parseToken (trees, []) = (trees, []) |
|||
parseToken (trees, "(" : rest) = |
|||
bimap |
|||
((trees <>) . return . Node (Symbol "List")) |
|||
tail |
|||
(go rest) |
|||
parseToken (trees, ")" : rest) = (trees, rest) |
|||
parseToken (trees, t : rest) = |
|||
(trees <> [Node (atom t) []], rest) |
|||
go tokens = until finished parseToken ([], tokens) |
|||
---------------------- PARSING TOKENS -------------------- |
|||
atom :: String -> Val |
|||
atom [] = mempty |
|||
atom s@('"' : _) = |
|||
fromMaybe mempty (maybeRead ("String " <> s)) |
|||
atom s = firstParse parses |
|||
where |
|||
firstParse [] = mempty |
|||
firstParse (x : _) = x |
|||
parses = |
|||
catMaybes $ |
|||
maybeRead |
|||
<$> ( fmap |
|||
(<> (' ' : s)) |
|||
[ "Int", |
|||
"Integer", |
|||
"Float", |
|||
"Double" |
|||
] |
|||
<> ["Symbol \"" <> s <> "\""] |
|||
) |
|||
maybeRead :: String -> Maybe Val |
|||
maybeRead = fmap fst . listToMaybe . reads |
|||
----------------------- TOKENIZATION --------------------- |
|||
tokenized :: String -> [String] |
|||
tokenized s = quoteTokens '"' s >>= go |
|||
where |
|||
go [] = [] |
|||
go token@('"' : _) = [token] |
|||
go s = words $ spacedBrackets s |
|||
spacedBrackets :: String -> String |
|||
spacedBrackets [] = [] |
|||
spacedBrackets (c : cs) |
|||
| c `elem` "()" = ' ' : c : " " <> spacedBrackets cs |
|||
| otherwise = c : spacedBrackets cs |
|||
quoteTokens :: Char -> String -> [String] |
|||
quoteTokens q s = zip [0 ..] (splitOn [q] s) >>= go |
|||
where |
|||
go (_, []) = [] |
|||
go (i, k) |
|||
| even i = [k] |
|||
| otherwise = [q : k <> [q]]</lang> |
|||
{{Out}} |
|||
<pre>Symbol "List" |
|||
| |
|||
+- Symbol "List" |
|||
| | |
|||
| +- Symbol "data" |
|||
| | |
|||
| +- String "quoted data" |
|||
| | |
|||
| +- Int 123 |
|||
| | |
|||
| `- Float 4.5 |
|||
| |
|||
`- Symbol "List" |
|||
| |
|||
+- Symbol "data" |
|||
| |
|||
`- Symbol "List" |
|||
| |
|||
+- Symbol "!@#" |
|||
| |
|||
+- Symbol "List" |
|||
| | |
|||
| `- Float 4.5 |
|||
| |
|||
+- String "(more" |
|||
| |
|||
`- String "data)"</pre> |
|||
=={{header|Icon}} and {{header|Unicon}}== |
=={{header|Icon}} and {{header|Unicon}}== |