Initial ternary representation options
Both parsing and conversion from T to ternary representation supported
This commit is contained in:
parent
fe70aa72ac
commit
8622af9ad2
@ -104,7 +104,6 @@ tricuLexer = do
|
|||||||
, closeBracket
|
, closeBracket
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
lexTricu :: String -> [LToken]
|
lexTricu :: String -> [LToken]
|
||||||
lexTricu input = case runParser tricuLexer "" input of
|
lexTricu input = case runParser tricuLexer "" input of
|
||||||
Left err -> error $ "Lexical error:\n" ++ errorBundlePretty err
|
Left err -> error $ "Lexical error:\n" ++ errorBundlePretty err
|
||||||
|
@ -40,7 +40,7 @@ main = do
|
|||||||
Repl -> do
|
Repl -> do
|
||||||
putStrLn "Welcome to the tricu REPL"
|
putStrLn "Welcome to the tricu REPL"
|
||||||
putStrLn "You can exit with `CTRL+D` or the `:_exit` command.`"
|
putStrLn "You can exit with `CTRL+D` or the `:_exit` command.`"
|
||||||
repl Map.empty
|
repl library
|
||||||
Compile filePath -> do
|
Compile filePath -> do
|
||||||
result <- evaluateFile filePath
|
result <- evaluateFile filePath
|
||||||
print result
|
print result
|
||||||
|
@ -11,7 +11,8 @@ import Text.Megaparsec.Error (errorBundlePretty, ParseErrorBundle)
|
|||||||
|
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
|
|
||||||
type Parser = Parsec Void [LToken]
|
type Parser = Parsec Void [LToken]
|
||||||
|
type AltParser = Parsec Void String
|
||||||
|
|
||||||
data TricuAST
|
data TricuAST
|
||||||
= SVar String
|
= SVar String
|
||||||
@ -242,6 +243,42 @@ isLiteral _ = False
|
|||||||
isNewline (LNewline) = True
|
isNewline (LNewline) = True
|
||||||
isNewline _ = False
|
isNewline _ = False
|
||||||
|
|
||||||
|
-- Alternative parsers
|
||||||
|
altSC :: AltParser ()
|
||||||
|
altSC = skipMany (char ' ' <|> char '\t' <|> char '\n')
|
||||||
|
|
||||||
|
parseTernaryTerm :: AltParser TricuAST
|
||||||
|
parseTernaryTerm = do
|
||||||
|
altSC
|
||||||
|
term <- choice parseTernaryTerm'
|
||||||
|
altSC
|
||||||
|
pure term
|
||||||
|
where
|
||||||
|
parseTernaryTerm' =
|
||||||
|
[ try (between (char '(') (char ')') parseTernaryTerm)
|
||||||
|
, try parseTernaryLeaf
|
||||||
|
, try parseTernaryStem
|
||||||
|
, try parseTernaryFork
|
||||||
|
]
|
||||||
|
|
||||||
|
parseTernaryLeaf :: AltParser TricuAST
|
||||||
|
parseTernaryLeaf = char '0' *> pure TLeaf
|
||||||
|
|
||||||
|
parseTernaryStem :: AltParser TricuAST
|
||||||
|
parseTernaryStem = char '1' *> (TStem <$> parseTernaryTerm)
|
||||||
|
|
||||||
|
parseTernaryFork :: AltParser TricuAST
|
||||||
|
parseTernaryFork = do
|
||||||
|
char '2'
|
||||||
|
term1 <- parseTernaryTerm
|
||||||
|
term2 <- parseTernaryTerm
|
||||||
|
pure $ TFork term1 term2
|
||||||
|
|
||||||
|
parseTernary :: String -> Either String TricuAST
|
||||||
|
parseTernary input = case runParser (parseTernaryTerm <* eof) "" input of
|
||||||
|
Left err -> Left (errorBundlePretty err)
|
||||||
|
Right ast -> Right ast
|
||||||
|
|
||||||
-- Error Handling
|
-- Error Handling
|
||||||
handleParseError :: ParseErrorBundle [LToken] Void -> String
|
handleParseError :: ParseErrorBundle [LToken] Void -> String
|
||||||
handleParseError bundle =
|
handleParseError bundle =
|
||||||
|
@ -88,6 +88,12 @@ toList (Fork x rest) = case toList rest of
|
|||||||
Left err -> Left err
|
Left err -> Left err
|
||||||
toList _ = Left "Invalid Tree Calculus list"
|
toList _ = Left "Invalid Tree Calculus list"
|
||||||
|
|
||||||
|
-- Outputs
|
||||||
|
toTernaryString :: T -> String
|
||||||
|
toTernaryString Leaf = "0"
|
||||||
|
toTernaryString (Stem t) = "1" ++ toTernaryString t
|
||||||
|
toTernaryString (Fork t1 t2) = "2" ++ toTernaryString t1 ++ toTernaryString t2
|
||||||
|
|
||||||
-- Utility
|
-- Utility
|
||||||
type Env = Map.Map String T
|
type Env = Map.Map String T
|
||||||
|
|
||||||
|
Loading…
x
Reference in New Issue
Block a user