Add interactive shell

10 files changed, 239 insertions, 49 deletions

diff --git a/Makefile b/Makefile
index ec6b966..c7c7faa 100644
--- a/Makefile
+++ b/Makefile
@@ -6,8 +6,8 @@ BIN:=isjit
 
 all: $(BIN)
 
-test: $(BIN)
-	./$<
+test: $(BIN) .FORCE
+	./test.sh
 
 $(BIN): %: %.icl Clean\ System\ Files/sjit_c.o .FORCE
 	$(CLM) $(CLMFLAGS) $@ -o $@
diff --git a/README.md b/README.md
index 00eafdd..f92c256 100644
--- a/README.md
+++ b/README.md
@@ -3,8 +3,6 @@
 Sjit is a stupid just in time compiler.
 It does almost nothing, and what it does, it does badly and is not useful.
 
-- There is no parser, you have to write your program in the internal Clean
-  representation (see `Start` in [`sjit.icl`](/sjit.icl)).
 - There is no type checker, you have to guess the implicit rules.
 - There is no register allocation, everything is done on the stack.
 - There is no code optimisation, not even to eliminate `push rbx` followed by
@@ -18,7 +16,7 @@ It does almost nothing, and what it does, it does badly and is not useful.
 git clone https://gitlab.science.ru.nl/cstaps/sjit-compiler
 cd sjit-compiler
 make
-./sjit
+./isjit
 ```
 
 ## Colophon
diff --git a/Sjit/Compile.dcl b/Sjit/Compile.dcl
index 4bc1ed5..166b5c4 100644
--- a/Sjit/Compile.dcl
+++ b/Sjit/Compile.dcl
@@ -1,5 +1,6 @@
 definition module Sjit.Compile
 
+from Data.Either import :: Either
 from Data.Map import :: Map
 from Data.Maybe import :: Maybe
 from Sjit.Syntax import :: Function
@@ -40,5 +41,4 @@ from Sjit.Syntax import :: Function
 
 appendProgram :: !Bool !Program !JITState -> JITState
 bootstrap :: (!Program, !CompileState)
-compile :: !Function !CompileState -> CompileState
-compile_all :: !(Maybe CompileState) ![Function] -> CompileState
+compile :: !Function !CompileState -> Either String CompileState
diff --git a/Sjit/Compile.icl b/Sjit/Compile.icl
index 31b6523..5e4cef5 100644
--- a/Sjit/Compile.icl
+++ b/Sjit/Compile.icl
@@ -5,6 +5,9 @@ import StdGeneric
 import StdMaybe
 import StdOverloadedList
 
+import Control.Applicative
+import Control.Monad
+import Data.Either
 from Data.Func import mapSt, $
 from Data.Map import :: Map(..), get, put, newMap, fromList
 
@@ -80,39 +83,42 @@ where
 			ccall init_jit "II:Vpp"
 		}
 
-compile :: !Function !CompileState -> CompileState
+compile :: !Function !CompileState -> Either String CompileState
 compile f cs
 # cs & funs = put f.fun_name cs.pc cs.funs
 # vars = cs.vars
 # cs & vars = foldr (uncurry put) cs.vars [(v,sp) \\ v <- f.fun_args & sp <- [cs.sp+1..]]
-# (is,cs) = expr f.fun_expr cs
-# is = {i \\ i <- reverse [Ret:Put (max 1 (length f.fun_args)+1):is]}
-=
-	{ cs
-	& vars   = vars
-	, pc     = cs.pc+2
-	, blocks = cs.blocks ++| [!is!]
-	, jitst  = appendProgram (f.fun_name == "main") is cs.jitst
-	}
+= case expr f.fun_expr cs of
+	Left e -> Left e
+	Right (is,cs)
+		# is = {i \\ i <- reverse [Ret:Put (max 1 (length f.fun_args)+1):is]}
+		-> Right
+			{ cs
+			& vars   = vars
+			, pc     = cs.pc+2
+			, blocks = cs.blocks ++| [!is!]
+			, jitst  = appendProgram (f.fun_name == "main") is cs.jitst
+			}
 where
-	expr :: !Expr !CompileState -> (![Instr], !CompileState)
-	expr (Int i) cs = ([PushI i], {cs & sp=cs.sp+1, pc=cs.pc+1})
+	expr :: !Expr !CompileState -> Either String (![Instr], !CompileState)
+	expr (Int i) cs = Right ([PushI i], {cs & sp=cs.sp+1, pc=cs.pc+1})
 	expr (Var v) cs = case get v cs.vars of
-		Just i  -> ([PushRef (i-cs.sp)], {cs & sp=cs.sp+1, pc=cs.pc+1})
-		Nothing -> abort "undefined variable\n"
+		Just i  -> Right ([PushRef (i-cs.sp)], {cs & sp=cs.sp+1, pc=cs.pc+1})
+		Nothing -> Left ("undefined variable '" +++ v +++ "'")
 	expr (App f args) cs
 	# args = if (args=:[]) [Int 0] args
-	# (iss,cs) = mapSt expr args {cs & sp=cs.sp+1}
-	= case get f cs.funs of
-		Just f  -> ([Pop (length args-1):Call f:flatten iss], {cs & sp=cs.sp+2-length args, pc=cs.pc+2})
-		Nothing -> abort "undefined function\n"
+	= case mapStM expr args {cs & sp=cs.sp+1} of
+		Left e -> Left e
+		Right (iss,cs) -> case get f cs.funs of
+			Just f  -> Right
+				( [Pop (length args-1):Call f:flatten iss]
+				, {cs & sp=cs.sp+2-length args, pc=cs.pc+2}
+				)
+			Nothing -> Left ("undefined function '" +++ toString f +++ "'")
 
-compile_all :: !(Maybe CompileState) ![Function] -> CompileState
-compile_all mcs funs
-# cs = case mcs of
-	Just cs -> cs
-	Nothing -> snd bootstrap
-= foldl (flip compile) cs funs
+	mapStM :: !(a st -> m (b, st)) ![a] !st -> m ([b], st) | Monad m
+	mapStM _ [] st = pure ([], st)
+	mapStM f [x:xs] st = f x st >>= \(y,st) -> mapStM f xs st >>= \(ys,st) -> pure ([y:ys],st)
 
 generic gEncodedSize a :: !a -> Int
 gEncodedSize{|Int|} _ = 1
diff --git a/Sjit/Syntax.dcl b/Sjit/Syntax.dcl
index a289b5a..44adbfa 100644
--- a/Sjit/Syntax.dcl
+++ b/Sjit/Syntax.dcl
@@ -1,5 +1,7 @@
 definition module Sjit.Syntax
 
+from Data.Either import :: Either
+
 :: Expr
 	= Int !Int
 	| Var !String
@@ -10,3 +12,6 @@ definition module Sjit.Syntax
 	, fun_args :: ![String]
 	, fun_expr :: !Expr
 	}
+
+parse_function :: !String -> Either String Function
+parse_interactive_line :: !String -> Either String Function
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"
diff --git a/isjit.icl b/isjit.icl
index 72d95dd..561d8bd 100644
--- a/isjit.icl
+++ b/isjit.icl
@@ -1,32 +1,68 @@
 module isjit
 
 import StdEnv
-import StdMaybe
-import StdOverloadedList
 
+import Data.Either
+import Data.Maybe
 import System.CommandLine
 
 import Sjit.Compile
 import Sjit.Syntax
 import Sjit.Run
 
-import Text.GenPrint
-derive gPrint Instr
-
 Start w
+# (args,w) = getCommandLine w
+# (_,cs) = bootstrap
 # (io,w) = stdio w
-# io = Foldl (\io b -> io <<< "  " <<< printToString b <<< "\n") (io <<< "Program blocks:\n") comp_state.blocks
-# io = io <<< "Interpreted result:  " <<< interpreted_result <<< "\n"
-# io = io <<< "JIT-compiled result: " <<< jit_compiled_result <<< "\n"
+# (io,w) = case args of
+	[prog,file]
+		# (_,f,w) = fopen file FReadText w
+		# (f,io) = file_loop f io cs
+		# (_,w) = fclose f w
+		-> (io,w)
+	[prog]
+		-> (interactive_loop io cs, w)
+	[prog:_]
+		-> (io <<< "Usage: " <<< prog <<< " [FILE]\n", setReturnCode 1 w)
 # (_,w) = fclose io w
-= setReturnCode (if (interpreted_result==jit_compiled_result) 0 1) w
-where
-	interpreted_result = interpret comp_state
-	jit_compiled_result = exec comp_state
+= w
+
+interactive_loop :: !*File !CompileState -> *File
+interactive_loop io cs
+# io = io <<< "> "
+# (s,io) = freadline io
+# (s,cs) = handle_input s cs
+# io = case s of
+	Nothing -> io
+	Just s  -> io <<< s <<< "\n"
+= case cs of
+	Nothing -> io
+	Just cs -> interactive_loop io cs
+
+file_loop :: !*File !*File !CompileState -> (!*File, !*File)
+file_loop f io cs
+# (e,f) = fend f
+| e = (f,io)
+# (s,f) = freadline f
+# (s,cs) = handle_input s cs
+# io = case s of
+	Nothing -> io
+	Just s  -> io <<< s <<< "\n"
+= case cs of
+	Nothing -> (f,io)
+	Just cs -> file_loop f io cs
 
-comp_state =: compile_all Nothing
-	[ {fun_name="id",    fun_args=["x"],     fun_expr=Var "x"}
-	, {fun_name="const", fun_args=["x","y"], fun_expr=Var "x"}
-	, {fun_name="seven", fun_args=[],        fun_expr=App "const" [Int 7, Int 10]}
-	, {fun_name="main",  fun_args=[],        fun_expr=App "+" [App "seven" [], App "const" [Int 5, Int 10]]}
-	]
+handle_input :: !String !CompileState -> (!Maybe String, !Maybe CompileState)
+handle_input s cs
+| s == "" = (Just "", Nothing)
+| s == "quit\n" = (Nothing, Nothing)
+| otherwise = case parse_interactive_line s of
+	Left e
+		-> (Just e, Just cs)
+	Right fun -> case compile fun cs of
+		Left e
+			-> (Just ("\033[0;31mError:\033[0m " +++ e), Just cs)
+		Right cs
+			| fun.fun_name <> "main" -> (Nothing, Just cs)
+			# res = exec cs
+			-> (Just (toString res), Just cs)
diff --git a/test.sh b/test.sh
new file mode 100755
index 0000000..6e0ed07
--- /dev/null
+++ b/test.sh
@@ -0,0 +1,11 @@
+#!/bin/bash
+
+GREEN="\033[0;32m"
+YELLOW="\033[0;33m"
+RESET="\033[0m"
+
+for f in test/*.test
+do
+	echo -e "$YELLOW$f...$RESET"
+	diff <(./isjit $f) "${f/.test/.result}" && echo -e "${GREEN}OK$RESET"
+done
diff --git a/test/basic.result b/test/basic.result
new file mode 100644
index 0000000..b4de394
--- /dev/null
+++ b/test/basic.result
@@ -0,0 +1 @@
+11
diff --git a/test/basic.test b/test/basic.test
new file mode 100644
index 0000000..b31be57
--- /dev/null
+++ b/test/basic.test
@@ -0,0 +1,3 @@
+id x = x
+const x y = x
+const(3,5) * id(7) - const(10,2)