From bb762e08e950b4d6d16bf0782c3e8d689f28c5dc Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Sun, 13 Aug 2017 19:21:43 +0200
Subject: Improved compiler interface (#8)

Specifically:
- --check, --compile and --generate are implicit, there are --no-*
  options to disable.
- --help added.
- --run removed.
- Renamed to silc (sil compiler).
- Output files are relative to input file.
---
 .gitignore          |   6 +-
 Makefile            |   2 +-
 Sil/Util/Parser.dcl |   1 +
 Sil/Util/Parser.icl |   5 +-
 sil.icl             | 134 ---------------------------------------------
 silc.icl            | 155 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 164 insertions(+), 139 deletions(-)
 delete mode 100644 sil.icl
 create mode 100644 silc.icl

diff --git a/.gitignore b/.gitignore
index c8e7bf9..75943a9 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,4 @@
 Clean System Files/
-sil
-sil_compiled
-sil_compiled.dcl
+silc
+examples/
+!examples/*.sil
diff --git a/Makefile b/Makefile
index a9a1741..c9d5edb 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-BIN:=sil
+BIN:=silc
 CLM:=clm
 CLMFLAGS:=-nt -nr\
 	-l -no-pie\
diff --git a/Sil/Util/Parser.dcl b/Sil/Util/Parser.dcl
index 14dc022..e0046fa 100644
--- a/Sil/Util/Parser.dcl
+++ b/Sil/Util/Parser.dcl
@@ -47,6 +47,7 @@ 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, toString a
+anyItem :: ([a] -> Parser a a) | ==, name, toString a
 list :: [a] -> Parser a [a] | ==, name, toString a
 seplist :: a (Parser a b) -> Parser a [b] | ==, name, toString a
 seplistUntil :: a a (Parser a b) -> Parser a [b] | ==, name, toString a
diff --git a/Sil/Util/Parser.icl b/Sil/Util/Parser.icl
index e730313..154a989 100644
--- a/Sil/Util/Parser.icl
+++ b/Sil/Util/Parser.icl
@@ -1,6 +1,6 @@
 implementation module Sil.Util.Parser
 
-from StdFunc import iter
+from StdFunc import iter, o
 import StdList
 import StdOverloaded
 
@@ -140,6 +140,9 @@ where
 item :: a -> Parser a a | ==, name, toString a
 item a = satisfy ((==) a) <#> name a
 
+anyItem :: ([a] -> Parser a a) | ==, name, toString a
+anyItem = foldr (<|>) empty o map item
+
 list :: [a] -> Parser a [a] | ==, name, toString a
 list as = mapM item as
 
diff --git a/sil.icl b/sil.icl
deleted file mode 100644
index 945faaa..0000000
--- a/sil.icl
+++ /dev/null
@@ -1,134 +0,0 @@
-module sil
-
-import StdBool
-import StdChar
-import StdFile
-from StdFunc import o, seq
-import StdList
-import StdOverloaded
-import StdString
-import StdTuple
-
-import Control.Applicative
-import Control.Monad
-import Data.Error
-from Data.Func import $
-import Data.Functor
-import Data.Tuple
-import System.CommandLine
-import System.File
-import System.Process
-
-import ABC.Assembler
-
-from Sil.Check import checkProgram
-import qualified Sil.Compile as SC
-import Sil.Error
-import Sil.Parse
-from Sil.Syntax import :: Program
-import Sil.Util.Parser
-from Sil.Util.Printer import :: PrintState, instance zero PrintState,
-	class PrettyPrinter(..), instance PrettyPrinter Program
-
-:: CLI =
-	{ prettyprint :: Bool
-	, check       :: Bool
-	, compile     :: Bool
-	, generate    :: Bool
-	, run         :: Bool
-	, inputfile   :: String
-	}
-
-instance zero CLI
-where
-	zero =
-		{ prettyprint = False
-		, check       = False
-		, compile     = False
-		, generate    = False
-		, run         = False
-		, inputfile   = ""
-		}
-
-Start w
-#! (io,w) = stdio w
-#! err = stderr
-#! (cmd,w)  = getCommandLine w
-#! (args,_) = runParser (arg until eof) $ makeParseState $ map PI_Token $ tl cmd
-| isError args
-	# err = err <<< toString (fromError args) <<< "\r\n"
-	= finish 1 io err w
-#! args = seq (fromOk args) zero
-#! (file,w) = readFile args.inputfile w
-| isError file
-	# err = err <<< "Could not open '" <<< args.inputfile <<< "' for reading.\r\n"
-	= finish 1 io err w
-#! prog = tokenise (fromString $ fromOk file) >>= parse
-| isError prog
-	# err = err <<< toString (fromError prog) <<< "\r\n"
-	= finish 1 io err w
-#! prog = fromOk prog
-#! io = if args.prettyprint
-	(io <<< print zero prog <<< "\r\n")
-	io
-#! (errs, err) = if args.check
-	(appSnd fromJust $ checkProgram (Just err) prog)
-	([], err)
-| not (isEmpty errs)
-	= finish 1 io err w
-| not args.compile
-	= finish 0 io err w
-#! (ok,f,w) = fopen "sil_compiled.dcl" FWriteText w
-| not ok
-	# err = err <<< "Could not open 'sil_compiled.dcl' for writing\r\n"
-	= finish 1 io err w
-#! f = f <<< "definition module sil_compiled"
-#! (_,w) = fclose f w
-#! (_,w) = sleep 1 w
-#! (ok,f,w) = fopen "Clean System Files/sil_compiled.abc" FWriteText w
-| not ok
-	# err = err <<< "Could not open 'sil_compiled.abc' for writing\r\n"
-	= finish 1 io err w
-#! prog = 'SC'.compile prog
-| isError prog
-	# err = err <<< fromError prog
-	= finish 1 io err w
-#! f = f <<< fromOk prog
-#! (_,w) = fclose f w
-| not args.generate
-	= finish 0 io err w
-#! (p,w) = callProcess "/opt/clean/bin/clm" ["-l", "-no-pie", "sil_compiled", "-o", "sil_compiled"] Nothing w
-| isError p
-	# err = err <<< snd (fromError p) <<< "\r\n"
-	= finish 1 io err w
-| fromOk p <> 0
-	= finish (fromOk p) io err w
-| not args.run
-	= finish 0 io err w
-#! (p,w) = callProcess "./sil_compiled" [] Nothing w
-| isError p
-	# err = err <<< snd (fromError p) <<< "\r\n"
-	= finish 1 io err w
-= finish 0 io err w
-where
-	arg :: Parser String (CLI -> CLI)
-	arg = peek >>= \opt ->
-		(   (\     cli -> {cli & prettyprint=True}) <$  item "--pretty-print"
-		<|> (\     cli -> {cli & check=True})       <$  item "--check"
-		<|> (\     cli -> {cli & compile=True})     <$  item "--compile"
-		<|> (\     cli -> {cli & generate=True})    <$  item "--generate"
-		<|> (\     cli -> {cli & run=True})         <$  item "--run"
-		<|> (\name cli -> {cli & inputfile=name})   <$> satisfy isFilename
-		<?> P_Invalid "command line argument" opt
-		)
-
-	isFilename :: (String -> Bool)
-	isFilename = all (\c -> isAlphanum c || isMember c ['./-']) o fromString
-
-	finish :: !Int !*File !*File -> *(*World -> *World)
-	finish ret io err = setReturnCode ret o snd o fclose err o snd o fclose io
-
-	sleep :: !Int !*World -> *(!Int, !*World)
-	sleep i w = code inline {
-		ccall sleep "I:I:A"
-	}
diff --git a/silc.icl b/silc.icl
new file mode 100644
index 0000000..4861d3c
--- /dev/null
+++ b/silc.icl
@@ -0,0 +1,155 @@
+module silc
+
+import StdBool
+import StdChar
+import StdFile
+from StdFunc import o, seq
+import StdList
+import StdOverloaded
+import StdString
+import StdTuple
+
+import Control.Applicative
+import Control.Monad
+import Data.Error
+from Data.Func import $
+import Data.Functor
+import Data.Tuple
+import System.CommandLine
+import System.Directory
+import System.File
+import System.FilePath
+import System.Process
+
+import ABC.Assembler
+
+from Sil.Check import checkProgram
+import qualified Sil.Compile as SC
+import Sil.Error
+import Sil.Parse
+from Sil.Syntax import :: Program
+import Sil.Util.Parser
+from Sil.Util.Printer import :: PrintState, instance zero PrintState,
+	class PrettyPrinter(..), instance PrettyPrinter Program
+
+:: CLI =
+	{ prettyprint :: Bool
+	, check       :: Bool
+	, compile     :: Bool
+	, generate    :: Bool
+	, help        :: Bool
+	, inputfile   :: Maybe String
+	}
+
+instance zero CLI
+where
+	zero =
+		{ prettyprint = False
+		, check       = True
+		, compile     = True
+		, generate    = True
+		, help        = False
+		, inputfile   = Nothing
+		}
+
+Start w
+#! (io,w) = stdio w
+#! err = stderr
+#! (cmd,w)  = getCommandLine w
+#! (args,_) = runParser (arg until eof) $ makeParseState $ map PI_Token $ tl cmd
+| isError args
+	# err = err <<< toString (fromError args) <<< "\r\n"
+	= finish 1 io err w
+#! args = seq (fromOk args) zero
+| args.help
+	# io = io <<< HELP
+	= finish 0 io err w
+| isNothing args.inputfile
+	# err = err <<< "No input file given.\r\n"
+	= finish 1 io err w
+# infile = fromJust args.inputfile
+# (dir, module, dclfile, sysfiles, abcfile) =
+	( dir
+	, name
+	, dir </> addExtension name "dcl"
+	, dir </> "Clean System Files"
+	, dir </> "Clean System Files" </> addExtension name "abc")
+	with
+		(dir, name) = splitFileName $ if (ext == "sil") base` infile
+		(base`, ext) = splitExtension infile
+#! (file,w) = readFile infile w
+| isError file
+	# err = err <<< "Could not open '" <<< infile <<< "' for reading.\r\n"
+	= finish 1 io err w
+#! prog = tokenise (fromString $ fromOk file) >>= parse
+| isError prog
+	# err = err <<< toString (fromError prog) <<< "\r\n"
+	= finish 1 io err w
+#! prog = fromOk prog
+#! io = if args.prettyprint
+	(io <<< print zero prog <<< "\r\n")
+	io
+#! (errs, err) = if args.check
+	(appSnd fromJust $ checkProgram (Just err) prog)
+	([], err)
+| not (isEmpty errs)
+	= finish 1 io err w
+| not args.compile
+	= finish 0 io err w
+#! (ok,f,w) = fopen dclfile FWriteText w
+| not ok
+	# err = err <<< "Could not open '" <<< dclfile <<< "' for writing\r\n"
+	= finish 1 io err w
+#! f = f <<< "definition module " <<< module
+#! (_,w) = fclose f w
+#! (_,w) = sleep 1 w
+#! (_,w) = createDirectory sysfiles w
+#! (ok,f,w) = fopen abcfile FWriteText w
+| not ok
+	# err = err <<< "Could not open '" <<< abcfile <<< "' for writing\r\n"
+	= finish 1 io err w
+#! prog = 'SC'.compile prog
+| isError prog
+	# err = err <<< fromError prog
+	= finish 1 io err w
+#! f = f <<< fromOk prog
+#! (_,w) = fclose f w
+| not args.generate
+	= finish 0 io err w
+#! (p,w) = callProcess "/opt/clean/bin/clm" ["-l", "-no-pie", module, "-o", module] (Just dir) w
+| isError p
+	# err = err <<< snd (fromError p) <<< "\r\n"
+	= finish 1 io err w
+| fromOk p <> 0
+	= finish (fromOk p) io err w
+= finish 0 io err w
+where
+	arg :: Parser String (CLI -> CLI)
+	arg = peek >>= \opt ->
+		(   (\     cli -> {cli & prettyprint=True}) <$  anyItem ["-p", "--pretty-print"]
+		<|> (\     cli -> {cli & check=False})      <$  item     "--no-check"
+		<|> (\     cli -> {cli & compile=False})    <$  item     "--no-compile"
+		<|> (\     cli -> {cli & generate=False})   <$  item     "--no-generate"
+		<|> (\     cli -> {cli & help=True})        <$  anyItem ["-h", "--help"]
+		<|> (\name cli -> {cli & inputfile=Just name}) <$> satisfy isFilename
+		<?> P_Invalid "command line argument" opt
+		)
+
+	HELP = "silc: simple imperative language compiler\r\n\r\n" +++
+		"Usage: silc [-p|--pretty-print] [--no-check] [--no-compile] [--no-generate] [-h|--help] [FILE]\r\n\r\n" +++
+		"\t-p, --pretty-print  Pretty-print program\r\n" +++
+		"\t--no-check          Do not check program for common errors\r\n" +++
+		"\t--no-compile        Do not compile program to ABC-code\r\n" +++
+		"\t--no-generate       Do not generate machine code from ABC-code\r\n" +++
+		"\t-h, --help          Print this help\r\n"
+
+	isFilename :: (String -> Bool)
+	isFilename = all (\c -> isAlphanum c || isMember c ['./-']) o fromString
+
+	finish :: !Int !*File !*File -> *(*World -> *World)
+	finish ret io err = setReturnCode ret o snd o fclose err o snd o fclose io
+
+	sleep :: !Int !*World -> *(!Int, !*World)
+	sleep i w = code inline {
+		ccall sleep "I:I:A"
+	}
-- 
cgit v1.2.3