Add interactive shell

1 files changed, 130 insertions, 0 deletions

diff --git a/Sjit/Syntax.icl b/Sjit/Syntax.icl
index e512e0c..ae75087 100644
--- a/Sjit/Syntax.icl
+++ b/Sjit/Syntax.icl
@@ -1 +1,131 @@
 implementation module Sjit.Syntax
+
+import StdEnv
+
+import Control.Applicative
+import Control.Monad
+import Data.Either
+from Data.Func import $
+import Data.Functor
+import Data.GenEq
+import Text.Parsers.Simple.Core
+
+:: Token
+	= TIdent !String
+	| TInt !Int
+
+	| TEq
+	| TComma
+
+	| TParenOpen
+	| TParenClose
+
+derive gEq Token
+instance == Token where == a b = a === b
+
+instance toString Token
+where
+	toString t = case t of
+		TIdent s    -> "'" +++ s +++ "'"
+		TInt n      -> toString n
+		TEq         -> "="
+		TComma      -> ","
+		TParenOpen  -> "("
+		TParenClose -> ")"
+
+lex :: !String -> Either String [Token]
+lex s = reverse <$> lex [] 0 (size s) s
+where
+	lex :: ![Token] !Int !Int !String -> Either String [Token]
+	lex tks i e s | i >= e = Right tks
+	lex tks i e s = case s.[i] of
+		w | isSpace w
+			-> lex tks (i+1) e s
+
+		n | isIdent n
+			# (i,n) = readIdent isIdent [] i e s
+			-> lex [TIdent n:tks] i e s
+
+		n | isFunnyIdent n
+			# (i,n) = readIdent isFunnyIdent [] i e s
+			-> lex [TIdent n:tks] i e s
+
+		n | isDigit n
+			# (i,n) = readInt [] i e s
+			-> lex [TInt n:tks] i e s
+
+		'=' -> lex [TEq:        tks] (i+1) e s
+		',' -> lex [TComma:     tks] (i+1) e s
+		'(' -> lex [TParenOpen: tks] (i+1) e s
+		')' -> lex [TParenClose:tks] (i+1) e s
+
+		c   -> Left ("Unexpected character '" +++ {c} +++ "'")
+
+	isIdent :: !Char -> Bool
+	isIdent c = isAlpha c || c == '_'
+
+	isFunnyIdent :: !Char -> Bool
+	isFunnyIdent c = isMember c ['+-*/']
+
+	readIdent :: !(Char -> Bool) ![Char] !Int !Int !String -> (!Int, !String)
+	readIdent ok cs i e s
+	| i >= e = (i,{c \\ c <- reverse cs})
+	# c = s.[i]
+	| ok c = readIdent ok [c:cs] (i+1) e s
+	| otherwise = (i,{c \\ c <- reverse cs})
+
+	readInt :: ![Char] !Int !Int !String -> (!Int, !Int)
+	readInt cs i e s
+	| i >= e = (i,toInt {#c \\ c <- reverse cs})
+	# c = s.[i]
+	| isDigit c = readInt [c:cs] (i+1) e s
+	| otherwise = (i,toInt {#c \\ c <- reverse cs})
+
+function :: Parser Token Function
+function =:
+	liftM3 make_fun ident (many arg) (pToken TEq *> expr)
+where
+	make_fun :: !String ![String] !Expr -> Function
+	make_fun name args expr = {fun_name=name, fun_args=args, fun_expr=expr}
+
+expr :: Parser Token Expr
+expr
+	= leftAssoc (tok "+" <|> tok "-")
+	$ leftAssoc (tok "*" <|> tok "/")
+	$ noInfix
+where
+	tok :: !String -> Parser Token String
+	tok s = pToken (TIdent s) $> s
+
+	leftAssoc :: !(Parser Token String) !(Parser Token Expr) -> Parser Token Expr
+	leftAssoc opp exprp = exprp >>= \e1 ->
+		many (opp >>= \op -> exprp >>= \e -> pure (op,e)) >>=
+		foldM (\e (op,e2) -> pure $ App op [e,e2]) e1
+
+	noInfix :: Parser Token Expr
+	noInfix =
+		liftM2 App ident (pToken TParenOpen *> pSepBy expr (pToken TComma) <* pToken TParenClose)
+		<|> Var <$> ident
+		<|> Int <$> int
+		<|> (pToken TParenOpen *> expr <* pToken TParenClose)
+
+ident :: Parser Token String
+ident =: (\(TIdent n) -> n) <$> pSatisfy (\t->t=:TIdent _)
+
+arg :: Parser Token String
+arg =: ident
+
+int :: Parser Token Int
+int =: (\(TInt n) -> n) <$> pSatisfy (\t->t=:TInt _)
+
+parse_function :: !String -> Either String Function
+parse_function s = lex s >>= \tks -> case parse function tks of
+	Right f -> Right f
+	Left _  -> Left "parsing failed"
+
+parse_interactive_line :: !String -> Either String Function
+parse_interactive_line s = lex s >>= \tks -> case parse function tks of
+	Right f -> Right f
+	Left _  -> case parse expr tks of
+		Right e -> Right {fun_name="main", fun_args=[], fun_expr=e}
+		Left _  -> Left "parsing failed"