From 9f95fa78463d7e6b047485bdce28f1a970a45fd2 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Mon, 17 Jul 2017 21:48:37 +0000
Subject: Initial commit

---
 .gitignore           |   2 +
 .gitmodules          |   3 +
 ABCMachine           |   1 +
 Makefile             |  18 ++++++
 Sil/Compile.dcl      |  20 +++++++
 Sil/Compile.icl      | 109 ++++++++++++++++++++++++++++++++++
 Sil/Parse.dcl        |  37 ++++++++++++
 Sil/Parse.icl        | 161 +++++++++++++++++++++++++++++++++++++++++++++++++++
 Sil/Parse/Parser.dcl |  33 +++++++++++
 Sil/Parse/Parser.icl |  93 +++++++++++++++++++++++++++++
 Sil/Syntax.dcl       |  52 +++++++++++++++++
 Sil/Syntax.icl       |   3 +
 Sil/Util.dcl         |  26 +++++++++
 Sil/Util.icl         | 116 +++++++++++++++++++++++++++++++++++++
 sil.icl              |  87 ++++++++++++++++++++++++++++
 test.sil             |   5 ++
 16 files changed, 766 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 .gitmodules
 create mode 160000 ABCMachine
 create mode 100644 Makefile
 create mode 100644 Sil/Compile.dcl
 create mode 100644 Sil/Compile.icl
 create mode 100644 Sil/Parse.dcl
 create mode 100644 Sil/Parse.icl
 create mode 100644 Sil/Parse/Parser.dcl
 create mode 100644 Sil/Parse/Parser.icl
 create mode 100644 Sil/Syntax.dcl
 create mode 100644 Sil/Syntax.icl
 create mode 100644 Sil/Util.dcl
 create mode 100644 Sil/Util.icl
 create mode 100644 sil.icl
 create mode 100644 test.sil

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..6fec853
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+Clean System Files/
+sil
diff --git a/.gitmodules b/.gitmodules
new file mode 100644
index 0000000..b761d0f
--- /dev/null
+++ b/.gitmodules
@@ -0,0 +1,3 @@
+[submodule "ABCMachine"]
+	path = ABCMachine
+	url = https://github.com/camilstaps/ABCMachine
diff --git a/ABCMachine b/ABCMachine
new file mode 160000
index 0000000..c83e5d3
--- /dev/null
+++ b/ABCMachine
@@ -0,0 +1 @@
+Subproject commit c83e5d354b9c66491e707f3d6580709fd68a11ca
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..5291f81
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,18 @@
+BIN:=sil
+CLM:=clm
+CLMFLAGS:=-nt -nr\
+	-I $$CLEAN_HOME/lib/Generics\
+	-I $$CLEAN_HOME/lib/Platform\
+	-I ABCMachine
+
+.PHONY: all clean
+
+all: $(BIN)
+
+$(BIN): .FORCE
+	$(CLM) $(CLMFLAGS) $@ -o $@
+
+clean:
+	$(RM) -r 'Clean System Files' $(BIN)
+
+.FORCE:
diff --git a/Sil/Compile.dcl b/Sil/Compile.dcl
new file mode 100644
index 0000000..6407b67
--- /dev/null
+++ b/Sil/Compile.dcl
@@ -0,0 +1,20 @@
+definition module Sil.Compile
+
+from StdFile import class <<<
+from StdOverloaded import class toString
+
+from Data.Error import :: MaybeError
+
+from ABC.Assembler import :: Assembler, :: Statement, instance <<< Assembler
+
+from Sil.Syntax import :: Program, :: Name
+
+:: CompileError
+	= UndefinedName Name
+	| VariableLabel
+	| FunctionOnStack
+	| UnknownError
+
+instance toString CompileError
+
+compile :: Program -> MaybeError CompileError Assembler
diff --git a/Sil/Compile.icl b/Sil/Compile.icl
new file mode 100644
index 0000000..4313c0e
--- /dev/null
+++ b/Sil/Compile.icl
@@ -0,0 +1,109 @@
+implementation module Sil.Compile
+
+import StdList
+import StdString
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.RWST
+import Control.Monad.Trans
+import Data.Error
+from Data.Func import $
+import qualified Data.Map as M
+import Data.Maybe
+import Data.Monoid
+from Text import <+
+
+import qualified ABC.Assembler as ABC
+
+import Sil.Syntax
+
+instance toString CompileError
+where
+	toString (UndefinedName n) = "Undefined name '" <+ n <+ "'."
+	toString VariableLabel     = "Variable stored at label."
+	toString FunctionOnStack   = "Function stored on the stack."
+	toString UnknownError      = "Unknown error."
+
+compile :: Program -> MaybeError CompileError 'ABC'.Assembler
+compile prog = case evalRWST start () zero of
+	Error e  -> Error e
+	Ok (_,p) -> Ok p
+where
+	start = mapM_ gen prog.p_funs
+
+:: Address
+	= LabelAddr String
+	| StackAddr Int
+
+:: CompileState =
+	{ labels    :: ['ABC'.Label]
+	, addresses :: 'M'.Map Name Address
+	}
+
+instance zero CompileState
+where
+	zero =
+		{ labels    = ["_l" <+ i \\ i <- [0..]]
+		, addresses = 'M'.newMap
+		}
+
+labels :: CompileState -> ['ABC'.Label]
+labels cs = cs.labels
+
+addresses :: CompileState -> 'M'.Map Name Address
+addresses cs = cs.addresses
+
+:: Gen a :== RWST () 'ABC'.Assembler CompileState (MaybeError CompileError) a
+
+fresh :: Gen 'ABC'.Label
+fresh = gets labels
+	>>= \labs -> modify (\cs -> {cs & labels=tl labs})
+	*> pure (hd labs)
+
+reserveVar :: Int Name -> Gen Int
+reserveVar i n = modify (\cs -> {cs & addresses='M'.put n (StackAddr i) cs.addresses}) *> pure (i + 1)
+
+class gen a :: a -> Gen ()
+
+instance gen Function
+where
+	gen f = tell ['ABC'.Label f.f_name] *> gen f.f_code
+
+instance gen CodeBlock
+where
+	gen cb = foldM reserveVar 1 [i.init_name \\ i <- cb.cb_init] *>
+		mapM_ gen cb.cb_init *>
+		mapM_ gen cb.cb_content
+
+instance gen Initialisation
+where
+	gen init = comment ("Initialise " <+ init.init_name) *> tell ['ABC'.Create]
+
+instance gen Statement
+where
+	gen (Declaration n app) = gets addresses >>= \addrs -> case 'M'.get n addrs of
+		Just (StackAddr i) -> comment "Declaration" *> gen app *> tell ['ABC'.Fill_a 0 i]
+		Just (LabelAddr _) -> liftT $ Error VariableLabel
+		_                  -> liftT $ Error $ UndefinedName n
+	gen (Application app)   = comment "Application" *> gen app
+	gen (Return (Just app)) = comment "Return" *> gen app *> tell ['ABC'.Rtn]
+	gen (Return Nothing)    = comment "Return" *> tell ['ABC'.Rtn]
+
+instance gen Application
+where
+	gen (Name n) = gets addresses >>= \addrs -> case 'M'.get n addrs of
+		Just (StackAddr i) -> comment "Retrieve name" *> tell ['ABC'.Push_a i]
+		Just (LabelAddr _) -> liftT $ Error VariableLabel
+		_                  -> liftT $ Error $ UndefinedName n
+	gen (Literal (BLit b)) = comment "Literal" *> tell ['ABC'.Create, 'ABC'.FillB b 0]
+	gen (Literal (ILit i)) = comment "Literal" *> tell ['ABC'.Create, 'ABC'.FillI i 0]
+	gen (App n args) = gets addresses >>= \addrs -> case 'M'.get n addrs of
+		Just (LabelAddr l) ->
+			comment "Retrieve arguments" *> mapM gen args *>
+			comment "Apply function" *> tell ['ABC'.Jsr l]
+		Just (StackAddr _) -> liftT $ Error FunctionOnStack
+		_                  -> liftT $ Error $ UndefinedName n
+
+comment :: String -> Gen ()
+comment s = tell ['ABC'.Comment s]
diff --git a/Sil/Parse.dcl b/Sil/Parse.dcl
new file mode 100644
index 0000000..b48fdbc
--- /dev/null
+++ b/Sil/Parse.dcl
@@ -0,0 +1,37 @@
+definition module Sil.Parse
+
+from StdOverloaded import class ==, class toString
+
+from Data.Error import :: MaybeError
+
+from Sil.Parse.Parser import class name
+from Sil.Syntax import :: Program, :: Literal
+
+:: Token
+	= TParenOpen   //* (
+	| TParenClose  //* )
+	| TBraceOpen   //* {
+	| TBraceClose  //* }
+	| TComma       //* ,
+	| TSemicolon   //* ;
+	| TAssign      //* :=
+	| TLit Literal //* True; False; integers
+	| TIf          //* if
+	| TWhile       //* while
+	| TReturn      //* return
+	| TName String //* a string
+
+instance == Token
+instance toString Token
+instance name Token
+
+:: ParseError
+	= E.a: Invalid String a & toString a
+	| Expected String
+	| UnknownError
+
+instance toString ParseError
+
+tokenise :: [Char] -> MaybeError ParseError [Token]
+
+parse :: ([Token] -> MaybeError ParseError Program)
diff --git a/Sil/Parse.icl b/Sil/Parse.icl
new file mode 100644
index 0000000..a9d733d
--- /dev/null
+++ b/Sil/Parse.icl
@@ -0,0 +1,161 @@
+implementation module Sil.Parse
+
+import StdBool
+import StdChar
+from StdFunc import o
+import StdInt
+import StdList
+import StdString
+import StdTuple
+
+import Control.Applicative
+import Control.Monad
+import Data.Error
+from Data.Func import $
+import Data.Functor
+import Data.Maybe
+from Text import <+
+
+import GenEq
+
+import Sil.Parse.Parser
+import Sil.Syntax
+import Sil.Util
+
+derive gEq Token, Literal
+instance == Token where == a b = gEq{|*|} a b
+
+instance toString Token
+where
+	toString TParenOpen  = "("
+	toString TParenClose = ")"
+	toString TBraceOpen  = "{"
+	toString TBraceClose = "}"
+	toString TComma      = ","
+	toString TSemicolon  = ";"
+	toString TAssign     = ":="
+	toString (TLit l)    = toString l
+	toString TIf         = "if"
+	toString TWhile      = "while"
+	toString TReturn     = "return"
+	toString (TName s)   = s
+
+instance name Token
+where
+	name (TLit _)  = "literal"
+	name (TName _) = "name"
+	name t         = toString t
+
+instance toString ParseError
+where
+	toString (Invalid loc sym)       = "Invalid token '" <+ sym <+ "' while parsing a " <+ loc <+ "."
+	toString (Expected s)            = "Expected " <+ s <+ "."
+	toString UnknownError            = "Unknown error."
+
+tokenise :: [Char] -> MaybeError ParseError [Token]
+tokenise cs = reverse <$> tks cs []
+where
+	tks :: [Char] [Token] -> MaybeError ParseError [Token]
+	tks [] t = pure t
+	tks ['(':r] t = tks r [TParenOpen :t]
+	tks [')':r] t = tks r [TParenClose:t]
+	tks ['{':r] t = tks r [TBraceOpen :t]
+	tks ['}':r] t = tks r [TBraceClose:t]
+	tks [',':r] t = tks r [TComma     :t]
+	tks [';':r] t = tks r [TSemicolon :t]
+	tks [':':'=':r] t = tks r [TAssign    :t]
+	tks ['i':'f'                :s:r] t | isSpace s = tks r [TIf    :t]
+	tks ['w':'h':'i':'l':'e'    :s:r] t | isSpace s = tks r [TWhile :t]
+	tks ['r':'e':'t':'u':'r':'n':s:r] t | isSpace s = tks r [TReturn:t]
+	tks ['T':'r':'u':'e'        :s:r] t | isSpace s = tks r [TLit $ BLit True:t]
+	tks ['F':'a':'l':'s':'e'    :s:r] t | isSpace s = tks r [TLit $ BLit False:t]
+	tks cs=:[h:_] t
+	| isSpace h          = tks (dropWhile isSpace cs) t
+	| isDigit h          = tks numrest [TLit $ ILit $ toInt $ toString num:t]
+	| not (isNameChar h) = Error $ Invalid "name" h
+	| otherwise          = tks namerest [TName $ toString name:t]
+	where
+		(name,namerest) = span isNameChar cs
+		(num,numrest)   = span isDigit cs
+
+	isNameChar :: (Char -> Bool)
+	isNameChar = isAlpha
+
+parse :: ([Token] -> MaybeError ParseError Program)
+parse = fst o runParser program
+
+program :: Parser Token Program
+program = (\fs -> {p_funs=fs}) <$> some function <* eof
+
+function :: Parser Token Function
+function =
+	type >>= \t ->
+	name >>= \n ->
+	item TParenOpen >>= \_ ->
+	seplist TComma arg >>= \args ->
+	item TParenClose >>= \_ ->
+	item TBraceOpen >>= \_ ->
+	codeblock >>= \cb ->
+	item TBraceClose >>= \_ -> pure
+		{ f_type = t
+		, f_name = n
+		, f_args = args
+		, f_code = cb
+		}
+
+codeblock :: Parser Token CodeBlock
+codeblock = many initialisation >>= \i ->
+	many statement >>= \s ->
+	pure {cb_init=i, cb_content=s}
+
+initialisation :: Parser Token Initialisation
+initialisation =
+	type >>= \t ->
+	name >>= \n ->
+	item TSemicolon >>= \_ ->
+	pure {init_type=t, init_name=n}
+
+statement :: Parser Token Statement
+statement = (declaration
+	<|> liftM Application application
+	<|> return
+/*	<|> if`
+	<|> while*/) <* item TSemicolon
+where
+	declaration :: Parser Token Statement
+	declaration = liftM2 Declaration name (item TAssign *> application)
+
+	application :: Parser Token Application
+	application
+		=   liftM2 App name (item TParenOpen *> seplist TComma application <* item TParenClose)
+		<|> liftM Literal literal
+		<|> liftM Name name
+
+	return :: Parser Token Statement
+	return = liftM Return (item TReturn *> optional application)
+
+name :: Parser Token Name
+name = liftM (\(TName s) -> s) $ satisfy isName <?> Expected "name"
+where
+	isName (TName _) = True
+	isName _         = False
+
+arg :: Parser Token Arg
+arg = (type >>= \type -> name >>= \name -> pure {arg_type=type, arg_name=name})
+	<?> Expected "argument"
+
+type :: Parser Token Type
+type
+	=   type "Bool" TBool
+	<|> type "Int"  TInt
+	<|> type "Void" TVoid
+	<?> Expected "type"
+where
+	type s t = item (TName s) *> pure t
+
+literal :: Parser Token Literal
+literal = satisfy isLit >>= \(TLit lit) -> pure lit
+where
+	isLit :: Token -> Bool
+	isLit (TLit _) = True
+	isLit _        = False
diff --git a/Sil/Parse/Parser.dcl b/Sil/Parse/Parser.dcl
new file mode 100644
index 0000000..cdeaf49
--- /dev/null
+++ b/Sil/Parse/Parser.dcl
@@ -0,0 +1,33 @@
+definition module Sil.Parse.Parser
+
+from StdOverloaded import class ==
+
+from Control.Applicative import class Applicative, class Alternative
+from Control.Monad import class Monad
+from Data.Error import :: MaybeError
+from Data.Functor import class Functor
+
+from Sil.Parse import :: ParseError
+
+:: Parser a b = Parser ([a] -> (MaybeError ParseError b, [a]))
+
+instance Functor (Parser a)
+instance Applicative (Parser a) 
+instance Monad (Parser a)
+instance Alternative (Parser a)
+
+class name a :: a -> String
+instance name String
+
+runParser :: (Parser a b) [a] -> (MaybeError ParseError b, [a])
+(<?>) :: (Parser a b) ParseError -> Parser a b
+fail :: Parser a b
+top :: Parser a a
+peek :: Parser a a
+satisfy :: (a -> Bool) -> Parser a a
+check :: (a -> Bool) -> Parser a a
+(until) infix 2 :: (Parser a b) (Parser a c) -> Parser a [b]
+item :: a -> Parser a a | ==, name a
+list :: [a] -> Parser a [a] | ==, name a
+seplist :: a (Parser a b) -> Parser a [b] | ==, name a
+eof :: Parser a ()
diff --git a/Sil/Parse/Parser.icl b/Sil/Parse/Parser.icl
new file mode 100644
index 0000000..52956a3
--- /dev/null
+++ b/Sil/Parse/Parser.icl
@@ -0,0 +1,93 @@
+implementation module Sil.Parse.Parser
+
+import StdList
+import StdOverloaded
+
+import Control.Applicative
+import Control.Monad
+import Data.Error
+from Data.Func import $
+import Data.Functor
+import Data.List
+
+import Sil.Parse
+
+instance Functor (Parser a) where
+	fmap f m = liftM f m
+
+instance Applicative (Parser a) where
+	pure a     = Parser \i -> (Ok a, i)
+	(<*>) sf p = ap sf p
+
+instance Monad (Parser a) where
+	bind p f = Parser \i -> case runParser p i of
+		(Ok r, rest) -> runParser (f r) rest
+		(Error e, _) -> (Error e, i)
+
+instance Alternative (Parser a) where
+	empty       = Parser \i -> (Error UnknownError, i)
+	(<|>) p1 p2 = Parser \i -> case runParser p1 i of
+		(Ok r, rest)     -> (Ok r, rest)
+		(Error e1, rest) -> case runParser p2 i of
+			(Error e2, rest) -> (Error e2, i)
+			(Ok r, rest)     -> (Ok r, rest)
+
+instance name String where name s = s
+
+runParser :: (Parser a b) [a] -> (MaybeError ParseError b, [a])
+runParser (Parser f) i = f i
+
+(<?>) :: (Parser a b) ParseError -> Parser a b
+(<?>) p e = Parser \i -> case runParser p i of
+	(Error _, rest) -> (Error e, rest)
+	o               -> o
+
+fail :: Parser a b
+fail = empty
+
+top :: Parser a a
+top = Parser \i -> case i of
+	[]     = (Error UnknownError, [])
+	[x:xs] = (Ok x, xs)
+
+peek :: Parser a a
+peek = Parser \i -> case i of
+	[]     = (Error UnknownError, [])
+	[x:xs] = (Ok x, [x:xs])
+
+satisfy :: (a -> Bool) -> Parser a a
+satisfy f = top >>= \r -> if (f r) (pure r) fail
+
+check :: (a -> Bool) -> Parser a a
+check f = peek >>= \r -> if (f r) (pure r) fail
+
+(until) infix 2 :: (Parser a b) (Parser a c) -> Parser a [b]
+(until) p guard = try $ until` p guard [] 
+where
+	until` :: (Parser a b) (Parser a c) [b] -> Parser a [b]
+	until` p guard acc = Parser \i -> case runParser guard i of
+		(Ok _, rest) -> (Ok acc, rest)
+		(Error _, _) -> case runParser p i of
+			(Ok r, rest) -> runParser (until` p guard [r:acc]) rest
+			(Error e, _) -> (Error e, i)
+
+	try :: (Parser a b) -> Parser a b
+	try p = Parser \i -> case runParser p i of
+		(Error e, _) -> (Error e, i)
+		(Ok r, rest) -> (Ok r, rest)
+
+item :: a -> Parser a a | ==, name a
+item a  = satisfy ((==) a) <?> Expected (name a)
+
+list :: [a] -> Parser a [a] | ==, name a
+list as = mapM item as
+
+seplist :: a (Parser a b) -> Parser a [b] | ==, name a
+seplist sep p = liftM2 (\es e-> es ++ [e]) (some (p <* item sep)) p
+	<|> liftM pure p
+	<|> pure empty
+
+eof :: Parser a ()
+eof = Parser \i -> case i of
+	[] = (Ok (), [])
+	_  = (Error $ Expected "eof", i)
diff --git a/Sil/Syntax.dcl b/Sil/Syntax.dcl
new file mode 100644
index 0000000..01b7ff6
--- /dev/null
+++ b/Sil/Syntax.dcl
@@ -0,0 +1,52 @@
+definition module Sil.Syntax
+
+from Data.Maybe import :: Maybe
+
+:: Program =
+	{ p_funs :: [Function]
+	}
+
+:: Function =
+	{ f_type :: Type
+	, f_name :: Name
+	, f_args :: [Arg]
+	, f_code :: CodeBlock
+	}
+
+:: CodeBlock =
+	{ cb_init    :: [Initialisation]
+	, cb_content :: [Statement]
+	}
+
+:: Arg =
+	{ arg_type :: Type
+	, arg_name :: Name
+	}
+
+:: Initialisation =
+	{ init_type :: Type
+	, init_name :: Name
+	}
+
+:: Statement
+	= Declaration Name Application
+	| Application Application
+	| Return (Maybe Application)
+	| If Application CodeBlock (Maybe CodeBlock)
+	| While Application CodeBlock
+
+:: Application
+	= Name Name
+	| Literal Literal
+	| App Name [Application]
+
+:: Type
+	= TBool
+	| TInt
+	| TVoid
+
+:: Literal
+	= BLit Bool
+	| ILit Int
+
+:: Name :== String
diff --git a/Sil/Syntax.icl b/Sil/Syntax.icl
new file mode 100644
index 0000000..522412b
--- /dev/null
+++ b/Sil/Syntax.icl
@@ -0,0 +1,3 @@
+implementation module Sil.Syntax
+
+
diff --git a/Sil/Util.dcl b/Sil/Util.dcl
new file mode 100644
index 0000000..f3d6803
--- /dev/null
+++ b/Sil/Util.dcl
@@ -0,0 +1,26 @@
+definition module Sil.Util
+
+from StdOverloaded import class toString, class zero
+
+from Sil.Parse import :: Token
+from Sil.Syntax import :: Program, :: Function, :: CodeBlock,
+	:: Initialisation, :: Statement, :: Type, :: Application, :: Literal
+
+:: PrintState
+
+instance zero PrintState
+
+class PrettyPrinter t where
+	print :: PrintState t -> String
+
+instance PrettyPrinter [Token]
+
+instance PrettyPrinter Program
+instance PrettyPrinter Function
+instance PrettyPrinter CodeBlock
+instance PrettyPrinter Initialisation
+instance PrettyPrinter Statement
+
+instance toString Type
+instance toString Application
+instance toString Literal
diff --git a/Sil/Util.icl b/Sil/Util.icl
new file mode 100644
index 0000000..68d8928
--- /dev/null
+++ b/Sil/Util.icl
@@ -0,0 +1,116 @@
+implementation module Sil.Util
+
+import _SystemArray
+import StdEnum
+from StdFunc import id
+import StdInt
+import StdList
+import StdOverloaded
+import StdString
+
+from Data.Func import $
+import Data.List
+import Data.Maybe
+import Text
+
+import Sil.Parse
+import Sil.Syntax
+
+:: PrintState =
+	{ indent :: Int
+	}
+
+instance zero PrintState where zero = {indent=0}
+
+instance toString PrintState where toString st = {'\t' \\ _ <- [1..st.indent]}
+
+instance PrettyPrinter [Token]
+where
+	print st []             = ""
+	print st [t]            = toString t
+	print st [t:ts=:[t`:_]] = toString t +++ spaceBetween t t` +++ print st` ts
+	where
+		st` = {st & indent=indent`}
+		indent` = newIndent t t` st.indent
+
+		spaceBetween :: Token Token -> String
+		spaceBetween _           TBraceClose = newline
+		spaceBetween TParenOpen  _           = ""
+		spaceBetween TParenClose TBraceOpen  = space
+		spaceBetween TParenClose _           = ""
+		spaceBetween TBraceOpen  _           = newline
+		spaceBetween TBraceClose _           = newline
+		spaceBetween TComma      _           = space
+		spaceBetween TSemicolon  _           = newline
+		spaceBetween TAssign     _           = space
+		spaceBetween (TLit _)    _           = space
+		spaceBetween TIf         _           = space
+		spaceBetween TWhile      _           = space
+		spaceBetween TReturn     _           = space
+		spaceBetween (TName _)   TParenClose = ""
+		spaceBetween (TName _)   TSemicolon  = ""
+		spaceBetween (TName _)   _           = space
+
+		newline = "\r\n" +++ {'\t' \\ _ <- [1..indent`]}
+		space = " "
+
+		newIndent :: Token Token -> Int -> Int
+		newIndent TBraceOpen  _           = inc
+		newIndent _           TBraceClose = dec
+		newIndent _           _           = id
+
+instance PrettyPrinter Program
+where
+	print st prog = p st prog.p_funs
+	where
+		p :: PrintState [Function] -> String
+		p _  []     = ""
+		p st [f]    = print st f
+		p st [f:fs] = print st f <+ "\r\n\r\n" <+ p st fs
+
+instance PrettyPrinter Function
+where
+	print st f = st <+ f.f_type <+ " " <+ f.f_name
+		<+ "(" <+ printersperse ", " f.f_args <+ ") {\r\n"
+		<+ print {st & indent=st.indent+1} f.f_code <+ "\r\n" <+ st <+ "}"
+
+instance PrettyPrinter CodeBlock
+where
+	print st cb = concat $ intersperse "\r\n" $
+		[print st x \\ x <- cb.cb_init] ++ [print st x \\ x <- cb.cb_content]
+
+instance PrettyPrinter Initialisation
+where
+	print st init = st <+ init.init_type <+ " " <+ init.init_name <+ ";"
+
+instance PrettyPrinter Statement
+where
+	print st (Declaration n a) = st <+ n <+ " " <+ TAssign <+ " " <+ a <+ ";"
+	print st (Application app) = st <+ app <+ ";"
+	print st (Return Nothing)  = st <+ "return;"
+	print st (Return (Just a)) = st <+ "return " <+ a <+ ";"
+	print st _                 = st <+ "<<unimplemented Statement>>"
+
+instance toString Type
+where
+	toString TBool = "Bool"
+	toString TInt  = "Int"
+	toString TVoid = "Void"
+
+instance toString Arg where toString arg = arg.arg_type <+ " " <+ arg.arg_name
+
+instance toString Application
+where
+	toString (Name n)      = n
+	toString (Literal lit) = toString lit
+	toString (App n args)  = n <+ "(" <+ printersperse ", " args <+ ")"
+
+instance toString Literal
+where
+	toString (BLit b) = toString b
+	toString (ILit i) = toString i
+
+printersperse :: a [b] -> String | toString a & toString b
+printersperse _ []     = ""
+printersperse _ [x]    = toString x
+printersperse g [x:xs] = x <+ g <+ printersperse g xs
diff --git a/sil.icl b/sil.icl
new file mode 100644
index 0000000..1ca0c81
--- /dev/null
+++ b/sil.icl
@@ -0,0 +1,87 @@
+module sil
+
+import StdBool
+import StdChar
+import StdFile
+from StdFunc import o, seq
+import StdList
+import StdOverloaded
+import StdString
+
+import Control.Applicative
+import Control.Monad
+import Data.Error
+from Data.Func import $
+import Data.Functor
+import System.CommandLine
+import System.File
+
+import ABC.Assembler
+
+import qualified Sil.Compile as SC
+from Sil.Compile import :: CompileError, instance toString CompileError
+import Sil.Parse
+import Sil.Parse.Parser
+from Sil.Syntax import :: Program
+from Sil.Util import :: PrintState, instance zero PrintState,
+	class PrettyPrinter(..), instance PrettyPrinter Program
+
+:: CLI =
+	{ prettyprint :: Bool
+	, compile     :: Bool
+	, inputfile   :: String
+	}
+
+instance zero CLI
+where
+	zero =
+		{ prettyprint = False
+		, compile     = False
+		, inputfile   = ""
+		}
+
+Start w
+# (io,w) = stdio w
+# (cmd,w)  = getCommandLine w
+# (args,_) = runParser (arg until eof) $ tl cmd
+| isError args
+	# io = io <<< toString (fromError args) <<< "\r\n"
+	# (_,w) = fclose io w
+	= w
+# args = seq (fromOk args) zero
+# (file,w) = readFile args.inputfile w
+| isError file
+	# io = io <<< "Could not open '" <<< args.inputfile <<< "'.\r\n"
+	# (_,w) = fclose io w
+	= w
+# prog = tokenise (fromString $ fromOk file) >>= parse
+| isError prog
+	# io = io <<< toString (fromError prog) <<< "\r\n"
+	# (_,w) = fclose io w
+	= w
+# io = if args.prettyprint
+	(io <<< print zero (fromOk prog) <<< "\r\n")
+	io
+# io = if args.compile
+	(io <<< ('SC'.compile (fromOk prog)) <<< "\r\n")
+	io
+# (_,w) = fclose io w
+= w
+where
+	arg :: Parser String (CLI -> CLI)
+	arg = peek >>= \opt ->
+		(   item "--pretty-print" *> pure (\cli -> {cli & prettyprint=True})
+		<|> item "--compile" *> pure (\cli -> {cli & compile=True})
+		<|> (satisfy isFilename >>= \name -> pure (\cli -> {cli & inputfile=name}))
+		<?> Invalid "command line argument" opt
+		)
+
+	isFilename :: (String -> Bool)
+	isFilename = all (\c -> isAlphanum c || isMember c ['.']) o fromString
+
+instance <<< (MaybeError e a) | <<< e & <<< a
+where
+	<<< f (Ok a) = f <<< a
+	<<< f (Error e) = f <<< e
+
+instance <<< CompileError where <<< f e = f <<< toString e
diff --git a/test.sil b/test.sil
new file mode 100644
index 0000000..8f6b371
--- /dev/null
+++ b/test.sil
@@ -0,0 +1,5 @@
+Int main () {
+	Int x;
+	x := 100;
+	return x;
+}
-- 
cgit v1.2.3