diff --git a/src/Lexer.hs b/src/Lexer.hs index 2e2303d..6d65c2e 100644 --- a/src/Lexer.hs +++ b/src/Lexer.hs @@ -104,7 +104,6 @@ tricuLexer = do , closeBracket ] - lexTricu :: String -> [LToken] lexTricu input = case runParser tricuLexer "" input of Left err -> error $ "Lexical error:\n" ++ errorBundlePretty err diff --git a/src/Main.hs b/src/Main.hs index 54eecf7..281a279 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -40,7 +40,7 @@ main = do Repl -> do putStrLn "Welcome to the tricu REPL" putStrLn "You can exit with `CTRL+D` or the `:_exit` command.`" - repl Map.empty + repl library Compile filePath -> do result <- evaluateFile filePath print result diff --git a/src/Parser.hs b/src/Parser.hs index beb157b..d113a0a 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -11,7 +11,8 @@ import Text.Megaparsec.Error (errorBundlePretty, ParseErrorBundle) import qualified Data.Set as Set -type Parser = Parsec Void [LToken] +type Parser = Parsec Void [LToken] +type AltParser = Parsec Void String data TricuAST = SVar String @@ -242,6 +243,42 @@ isLiteral _ = False isNewline (LNewline) = True 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 handleParseError :: ParseErrorBundle [LToken] Void -> String handleParseError bundle = diff --git a/src/Research.hs b/src/Research.hs index 0b59f1d..83fb157 100644 --- a/src/Research.hs +++ b/src/Research.hs @@ -88,6 +88,12 @@ toList (Fork x rest) = case toList rest of Left err -> Left err 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 type Env = Map.Map String T