diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index 0bf4576..1a153e7 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -11,17 +11,51 @@ import Parse import Scope import System.IO (isEOF) import System.Exit (exitWith, ExitCode (ExitFailure)) -import Compiler +import System.Environment (getArgs) +import Control.Exception +import SExpr (SExpr) +-- import Compiler -- | Infinite loop until EOF from the user inputLoop :: [Scope.ScopeMb] -> IO () -inputLoop new = isEOF >>= \end -> if end then putStrLn "End of Interpretation GLaDOS" else - getLine >>= \line -> case parseLisp line new of - (Left err, _) -> putStrLn ("\ESC[31m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> inputLoop new - (Right Nothing, stack) -> inputLoop stack - (Right (Just res), stack') -> print res >> inputLoop stack' +-- inputLoop = print +inputLoop stack = isEOF >>= \end -> if end then print "End of Interpretation GLaDOS" else + getLine >>= \line -> case runParser parseLisp (0, 0) line of + Left err -> print err >> exitWith (ExitFailure 84) + Right (res, _, _) -> interpretateInfo res stack + +interpretateInfo :: [SExpr] -> [Scope.ScopeMb] -> IO () +interpretateInfo [] _ = putStr "" +interpretateInfo (x:xs) stack = case interpretateLisp x stack of + Left err -> print err + Right (res, stack') -> case res of + Nothing -> interpretateInfo xs stack' + Just value -> print value >> print stack' >> interpretateInfo xs stack' + +compileFile :: String -> IO () +compileFile s = case runParser parseLisp (0, 0) s of + Left err -> print err >> exitWith (ExitFailure 84) + Right (res, _, _) -> interpretateInfo res [] -- (Right (Just res), stack') -> let instructions = (astToInstructions (AST.Cond (Boolean True) (Value 1) (Just (AST.Call "CallHere" [(Value 0)])))) in showInstructions instructions >> writeCompiledInstructionsToFile "output" (compileInstructions instructions) + +checkArgs :: [String] -> IO () +checkArgs ("-i": _) = print "Launch Interpreter" >> inputLoop [] +checkArgs (file:_) = either + (\_ -> print "File doesn't exist" >> exitWith (ExitFailure 84)) + compileFile + =<< (try (readFile file) :: IO (Either SomeException String)) +checkArgs _ = exitWith (ExitFailure 84) + -- | Main main :: IO () -main = putStrLn "Start of Interpretation Lisp" >> inputLoop [] +main = getArgs >>= \argv -> checkArgs argv +-- inputLoop new = isEOF >>= \end -> if end then putStrLn "End of Interpretation GLaDOS" else +-- getLine >>= \line -> case parseLisp line new of +-- (Left err, _) -> putStrLn ("\ESC[31m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> inputLoop new +-- (Right Nothing, stack) -> inputLoop stack +-- (Right (Just res), stack') -> print res >> inputLoop stack' + +-- -- | Main +-- main :: IO () +-- main = putStrLn "Start of Interpretation Lisp" >> inputLoop [] diff --git a/LobsterLang/src/Parse.hs b/LobsterLang/src/Parse.hs index 8dac2c5..83ebe38 100644 --- a/LobsterLang/src/Parse.hs +++ b/LobsterLang/src/Parse.hs @@ -27,6 +27,10 @@ module Parse ( parseElem, parseValue, parseLisp, + parseAnyString, + parseSpace, + parseLine, + interpretateLisp, -- parseTuple, ) where @@ -36,9 +40,15 @@ import Control.Applicative (Alternative (..)) import qualified AstEval import qualified AST import qualified Scope +import GHC.IO.SubSystem (IoSubSystem(IoPOSIX)) + +type Col = Int +type Row = Int +type Position = (Int, Int) data Parser a = Parser { - runParser :: String -> Maybe (a, String) + runParser :: Position -> String -> Either String (a, String, Position) + } @@ -47,33 +57,33 @@ instance Functor Parser where fmap fct parser = Parser ( - \s -> case runParser parser s of - Nothing -> Nothing - Just (a, b) -> Just (fct a, b) + \pos s -> case runParser parser pos s of + Left err -> Left err + Right (a, b, c) -> Right (fct a, b, c) ) -- | Instance Applicative of the data Parser instance Applicative Parser where - pure result = Parser (\_ -> Just (result, "")) + -- pure result = Parser (\_ -> Left (result, "",)) (<*>) parserA parserB = Parser ( - \s -> case runParser parserA s of - Nothing -> Nothing - Just (a, b) -> case runParser parserB b of - Nothing -> Nothing - Just (a', b') -> Just (a a', b') + \pos s -> case runParser parserA pos s of + Left err -> Left err + Right (a, b, c) -> case runParser parserB c b of + Left err' -> Left err' + Right (a', b', c') -> Right (a a', b', c') ) -- | Instance Alternative of the data Parser instance Alternative Parser where - empty = Parser (const Nothing) + empty = Parser (\_ _ -> Left "Error on parsing") (<|>) parserA parserB = Parser ( - \s -> case runParser parserA s of - Nothing -> runParser parserB s + \pos s -> case runParser parserA pos s of + Left _ -> runParser parserB pos s result -> result ) @@ -84,9 +94,9 @@ instance Monad Parser where a >>= b = Parser ( - \s -> case runParser a s of - Nothing -> Nothing - Just (res, s') -> runParser (b res) s' + \pos s -> case runParser a pos s of + Left err -> Left err + Right (res, s', pos') -> runParser (b res) pos' s' ) -- | Parse a character c @@ -95,9 +105,10 @@ instance Monad Parser where parseChar :: Char -> Parser Char parseChar c = Parser (f c) where - f :: Char -> String -> Maybe (Char, String) - f char (x:xs) = if char == x then Just (char, xs) else Nothing - f _ _ = Nothing + f :: Char -> Position -> String -> Either String (Char, String, Position) + f '\n' (row, col) (x:xs) = if '\n' == x then Right ('\n', xs, (row + 1, 0)) else Left ("Error on parsing on '" ++ show row ++ "' '" ++ show col) + f char (row, col) (x:xs) = if char == x then Right (char, xs, (row, col + 1)) else Left ("Error on parsing on '" ++ show row ++ "' '" ++ show col) + f _ (row, col) _ = Left ("Error on parsing on '" ++ show row ++ "' '" ++ show col) -- | Parse with the first or the second parser -- Takes two parsers @@ -111,11 +122,12 @@ parseOr parserA parserB = parserA <|> parserB parseAnd :: Parser a -> Parser b -> Parser (a, b) parseAnd parserA parserB = Parser (f parserA parserB) where - f :: Parser a -> Parser b -> String -> Maybe ((a, b), String) - f pA pB s = case runParser pA s of - Nothing -> Nothing - Just resultA -> - runParser ((\b -> (fst resultA, b)) <$> pB) (snd resultA) + f :: Parser a -> Parser b -> Position -> String -> Either String ((a, b), String, Position) + f pA pB pos s = case runParser pA pos s of + Left err -> Left err + Right (res, s', pos') -> case runParser pB pos' s' of + Left err -> Left err + Right (res', s'', pos'') -> Right ((res, res'), s'', pos'') -- | Parse with function after the two parsers -- Takes two parsers and a function @@ -123,10 +135,10 @@ parseAnd parserA parserB = Parser (f parserA parserB) parseAndWith :: (a -> b -> c) -> Parser a -> Parser b -> Parser c parseAndWith f' parserA parseB = Parser (f f' parserA parseB) where - f :: (a -> b -> c) -> Parser a -> Parser b ->String -> Maybe (c, String) - f f'' pA pB s = case runParser (parseAnd pA pB) s of - Nothing -> Nothing - Just ((a, b), s') -> Just (f'' a b, s') + f :: (a -> b -> c) -> Parser a -> Parser b -> Position -> String -> Either String (c, String, Position) + f f'' pA pB pos s = case runParser (parseAnd pA pB) pos s of + Left err -> Left err + Right ((a, b), s', pos') -> Right (f'' a b, s', pos') -- | Parse with a parser -- Takes a parser @@ -134,12 +146,12 @@ parseAndWith f' parserA parseB = Parser (f f' parserA parseB) parseMany :: Parser a -> Parser [a] parseMany parserA = Parser (f parserA) where - f :: Parser a -> String -> Maybe ([a], String) - f parser s = case runParser parser s of - Nothing -> Just ([] , s) - Just (a, b) -> case runParser (parseMany parser) b of - Nothing -> Just ([a], b) - Just (a', b') -> Just (a : a', b') + f :: Parser a -> Position -> String -> Either String ([a], String, Position) + f parser pos s = case runParser parser pos s of + Left _ -> Right ([], s, pos) + Right (res, s', pos') -> case runParser (parseMany parser) pos' s' of + Left _ -> Right ([res], s', pos') + Right (res', s'', pos'') -> Right (res : res', s'', pos'') -- | Parse with a parser -- Takes a parser @@ -151,11 +163,10 @@ parseSome parser = (:) <$> parser <*> parseMany parser parseUInt :: Parser Int parseUInt = Parser f where - f :: String -> Maybe (Int, String) - f s = case runParser (parseSome (parseAnyChar ['0'..'9'])) s of - Nothing -> Nothing - Just ([], _) -> Nothing - Just (a, b) -> Just (read a :: Int, b) + f :: Position -> String -> Either String (Int, String, Position) + f pos s = case runParser (parseSome parseDigit) pos s of + Left err -> Left err + Right (res, s', pos') -> Right (read res :: Int, s', pos') -- | Return a data Parser that parse a '-' or '+' parseSign :: Parser Char @@ -172,14 +183,17 @@ parseDigit = parseChar '0' <|> parseChar '1' <|> parseChar '2' <|> parseInt :: Parser Int parseInt = Parser f where - f :: String -> Maybe (Int, String) - f ('-':xs) = runParser ((\x -> -x) <$> parseUInt) xs - f s = runParser parseUInt s + f :: Position -> String -> Either String (Int, String, Position) + f pos ('-':xs) = runParser ((\x -> -x) <$> parseUInt) pos xs + f pos s = runParser parseUInt pos s -- | Return a data Parser that parse multiple space parseSpace :: Parser [Char] parseSpace = parseMany (parseChar ' ') +parseLine :: Parser [Char] +parseLine = parseMany (parseChar '\n') + -- | Parse with a parser and, if possible with a space -- Return a Parser that parse element with the given parser and, if possible with multiple space parseElem :: Parser a -> Parser a @@ -202,46 +216,90 @@ parseValue = Value <$> parseElem parseInt parseList :: Parser a -> Parser [a] parseList parser = parseStart *> parseListValue <* parseEnd where - parseEnd = parseChar ')' <* parseSpace - parseListValue = parseSpace *> parseMany (parseElem parser) + parseEnd = parseChar ')' <* parseSpace <* parseLine + parseListValue = parseSpace *> parseMany (parseElem parser) <* parseSpace parseStart = parseSpace *> parseChar '(' --- | Parse any characterfrom a String +-- | Parse any character from a String -- Return a Parser that parse every character from a String parseAnyChar :: String -> Parser Char parseAnyChar s = Parser (f s) where - f :: String -> String -> Maybe (Char, String) - f [] _ = Nothing - f (x:xs) s' = case parsed of - Nothing -> runParser (parseAnyChar xs) s' + f :: String -> Position -> String -> Either String (Char, String, Position) + f [] (row, col) _ = Left ("Error on parsing on '" ++ show row ++ "' '" ++ show col) + f (x:xs) pos s' = case parsed of + Left _ -> runParser (parseAnyChar xs) pos s' _ -> parsed where - parsed = runParser (parseOr (parseChar x) (parseChar c)) s' + parsed = runParser (parseOr (parseChar x) (parseChar c)) pos s' c = case xs of [] -> '\0' _ -> head xs +-- | Parse a specific String +parseAnyString :: String -> Parser String +parseAnyString s = Parser (f s s) + where + f :: String -> String -> Position -> String -> Either String (String, String, Position) + f (x:xs) str pos s' = case runParser (parseChar x) pos s' of + Left err -> Left err + Right (_, s'', pos') -> f xs str pos' s'' + f [] str pos s' = Right (str, s', pos) + -- | Return a Parser that parse a Bool (#f or #t) parseBool :: Parser Bool -parseBool = parseElem (Parser f) +parseBool = parseElem (parseTrue <|> parseFalse) + +-- | Return a PArser that parse a True (in lisp -> #t) +parseTrue :: Parser Bool +parseTrue = Parser f + where + f :: Position -> String -> Either String (Bool, String, Position) + f pos s = case runParser (parseAnyString "#t") pos s of + Left err -> Left err + Right (_, s', pos') -> Right (True, s', pos') + +-- | Return a PArser that parse a True (in lisp -> #f) +parseFalse :: Parser Bool +parseFalse = Parser f where - f :: String -> Maybe (Bool, String) - f ('#':'f':' ':xs) = Just (False, xs) - f ('#':'t':' ':xs) = Just (True, xs) - f _ = Nothing + f :: Position -> String -> Either String (Bool, String, Position) + f pos s = case runParser (parseAnyString "#f") pos s of + Left err -> Left err + Right (_, s', pos') -> Right (False, s', pos') -- | Return a Parser that parse a SExpr parseSExpr :: Parser SExpr -parseSExpr = List <$> parseList (parseSpace *> parseValue <|> parseSymbol <|> parseSpace *> parseSExpr) - <|> parseSymbol - <|> parseValue +parseSExpr = + parseSpace *> parseSymbol <|> + parseSpace *> parseValue <|> + List <$> parseList (parseSpace *> parseValue <|> parseSpace *> parseSymbol <|> parseSpace *> parseSExpr) <* parseSpace + +parseLisp :: Parser [SExpr] +parseLisp = parseSome parseSExpr -- | Return a Result that contain the evaluation of our Lisp String -- Takes as parameter the string that need to be evaluated and the Stack (Environment) -parseLisp :: String -> [Scope.ScopeMb] -> (Either String (Maybe AST.Ast), [Scope.ScopeMb]) -parseLisp s stack = case runParser parseSExpr s of - Nothing -> (Left "Input is unparsable", []) - Just (res, _) -> case AstEval.sexprToAst res of - Nothing -> (Left "Cannot convert input in AST", []) - Just value -> AstEval.evalAst stack value +interpretateLisp :: SExpr -> [Scope.ScopeMb] -> Either String (Maybe AST.Ast, [Scope.ScopeMb]) +interpretateLisp value stack = case AstEval.sexprToAst value of + Nothing -> Left "Error on evaluation" + Just res -> case AstEval.evalAst stack res of + (Left err, _) -> Left err + (Right res', stack') -> Right (res', stack') + + -- -- Right (Nothing, stack) -> (if stack == new then print "***ERROR" >> exitWith (ExitFailure 84) else inputLoop stack) +-- - Right (res, stack') -> print res >> inputLoop stack' + -- Right (_, stack') -> interpretateLisp xs stack' stack +-- interpretateLisp s stack new = case runParser (parseSome parseSExpr) (0, 0) s of + -- Left err -> Left err + -- Right (res, s', _) -> case AstEval.sexprToAst res of + -- Nothing -> Left "Error on evaluation" + -- Just value -> case AstEval.evalAst stack value of + -- (Nothing, stack') -> (if stack == new then Left "Error on evaluation" else parseLisp s' stack' new) + -- (_, stack'') -> parseLisp s' stack'' new +-- parseLisp :: String -> [Scope.ScopeMb] -> (Either String (Maybe AST.Ast), [Scope.ScopeMb]) +-- parseLisp s stack = case runParser parseSExpr s of +-- Nothing -> (Left "Input is unparsable", []) +-- Just (res, _) -> case AstEval.sexprToAst res of +-- Nothing -> (Left "Cannot convert input in AST", []) +-- Just value -> AstEval.evalAst stack value diff --git a/assets/lob-ascii.txt b/assets/lob-ascii.txt new file mode 100644 index 0000000..b52403c --- /dev/null +++ b/assets/lob-ascii.txt @@ -0,0 +1,44 @@ + == ++ + ========::::::::::::========= + =======::::+=======::::======== + ======:::+==::::::===:::======= + =====::===:::::::::==::====== + ========:========:-======== + =====-:::::::::====== + :-==::::::-==:: + :----:::::::::: + :-:==========::: + ==:::::::::::::== + ::::::::::::::::: + ::::::::::::::::::: + :::::: ::::::::::::::::::: ::::: + :::==::::::::::===========::::-::::::+:::: + ::::==::====-::=================+:::==== ===::: + ::::==::::::::====-==================== :::: ==:::: + :::==:::=====:::==:::=================::::==:::: ===: + :::=== : ====:::==================:=== ===::: + :::==+ :::::::-=---====================::::: ==::: + ::== :::=====-:=---==================::::==::: +==:: + == :::== ::::=:::==================-=== ==::: = + +===== :::== ::::::::=::::=================-::: ==::: + ===== =========:::::::::===:::=================:::::::: ==:============ + +=====::::::==%%%%%%%%%%%%%%%%%%%%%%%:::::::::===== + + ::::====::=== %*%%%%%%%#=%%*%%%%%%%===:::::===::: + ::::::::=====+ %%%%%%%%%===%%%%%%%%@=========::::::: + :::::::======== @%%%%%%=====%%%%%%% =====::::::: + :::-===+=== ===+ ===%%**=**%%=== === +==::::::= + ============= +===========*%%%%%+===== ===== ========+ + ================+ =====+ === ======== ============+ + +==-================ ================== + ==:::================= ====================== + +=::::================== ======================== + ==::::=========%%%*=====+ ========%================= + ==:::========%%%#======== =========%%%================ + ============%%= =======+ =========== %%%============== + =============== =====+ ======= =*%============= + ================ ==== === +================== + ================= ========================= + ================== ======================== + ==================+ ================== + =============== + diff --git a/exemple/Fibonacci.lob b/exemple/Fibonacci.lob new file mode 100644 index 0000000..c36a726 --- /dev/null +++ b/exemple/Fibonacci.lob @@ -0,0 +1,9 @@ +fn fibonacci(\ x: integer /) -> integer { + if x == 0 { + 0 + } else if x == 1 { + 1 + } else { + fibonacci(\ x - 1 /) + fibonacci(\ x - 2 /) + } +} diff --git a/exemple/Lambda.lob b/exemple/Lambda.lob new file mode 100644 index 0000000..13f82b2 --- /dev/null +++ b/exemple/Lambda.lob @@ -0,0 +1,15 @@ +sqrt = λ (\ x: integer /) -> integer x * x + +add = λ (\ a: integer, b: integer /) -> integer a + b + +sqrt(\ 5 /) # return 25 +add(\ 2, 9 /) # return 11 + +abs = λ (\ x: integer /) -> integer { + if x < 0 { + x * -1 + else { + x + } +} + diff --git a/exemple/RangeToStr.lob b/exemple/RangeToStr.lob new file mode 100644 index 0000000..4fe7808 --- /dev/null +++ b/exemple/RangeToStr.lob @@ -0,0 +1,16 @@ +fn rangeToStr(\ a: integer, b: integer /) -> string { + if a >= b { + @ b + } else { + @ a ++ rangeToStr(\ a + 1, b /) + } +} + +fn rangeToStrLoop(\ a: integer, b: integer /) -> string { + str: string = ""; + while a < b { + str ++= @ tmp; + a += 1; + } + str +} diff --git a/exemple/Script.lob b/exemple/Script.lob new file mode 100644 index 0000000..805ab2a --- /dev/null +++ b/exemple/Script.lob @@ -0,0 +1,7 @@ +a: integer = 0 + +for i: integer = 0; i < 100; i += 1 { + a += i; +} + +@ a