From bde9dfef3a80a155c83fd2e8570e782192aa8402 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Thu, 20 Dec 2018 21:46:34 +0100
Subject: Bring up to date

---
 ABC.dcl             |  3 +++
 ABC.icl             |  1 +
 Sil/Compile.icl     | 27 +++++++++++++++------------
 Sil/Parse.icl       |  1 -
 Sil/Util/Parser.dcl |  8 ++++++--
 Sil/Util/Parser.icl | 10 ++++++++--
 silc.icl            |  6 +++---
 7 files changed, 36 insertions(+), 20 deletions(-)
 create mode 100644 ABC.dcl
 create mode 100644 ABC.icl

diff --git a/ABC.dcl b/ABC.dcl
new file mode 100644
index 0000000..d02fbde
--- /dev/null
+++ b/ABC.dcl
@@ -0,0 +1,3 @@
+definition module ABC
+
+import ABC.Assembler
diff --git a/ABC.icl b/ABC.icl
new file mode 100644
index 0000000..f6d3029
--- /dev/null
+++ b/ABC.icl
@@ -0,0 +1 @@
+implementation module ABC
diff --git a/Sil/Compile.icl b/Sil/Compile.icl
index e16cdd9..5e0aec1 100644
--- a/Sil/Compile.icl
+++ b/Sil/Compile.icl
@@ -15,13 +15,13 @@ import Data.Error
 from Data.Func import $
 import Data.Functor
 import Data.List
-import qualified Data.Map as M
+import qualified Data.Map
 import Data.Maybe
 import Data.Monoid
 import Data.Tuple
 from Text import <+
 
-import qualified ABC.Assembler as ABC
+import qualified ABC
 
 import Sil.Error
 import Sil.Syntax
@@ -29,6 +29,9 @@ import Sil.Types
 import Sil.Util.Parser
 import Sil.Util.Printer
 
+instance *> (RWST r w s m) | Monad m & Monoid w
+instance <* (RWST r w s m) | Monad m & Monoid w
+
 error :: Error -> RWST r w s (MaybeError Error) a
 error e = RWST \_ _ -> Error e
 
@@ -97,8 +100,8 @@ where
 
 :: CompileState =
 	{ labels        :: ['ABC'.Label]
-	, addresses     :: 'M'.Map Name Address
-	, symbols       :: 'M'.Map Name FunctionSymbol
+	, addresses     :: 'Data.Map'.Map Name Address
+	, symbols       :: 'Data.Map'.Map Name FunctionSymbol
 	, returns       :: ['ABC'.Assembler]
 	, returnType    :: Type
 	, stackoffsets  :: (Int, Int) // A and B stack
@@ -111,8 +114,8 @@ instance zero CompileState
 where
 	zero =
 		{ labels        = ["_l" <+ i \\ i <- [0..]]
-		, addresses     = 'M'.newMap
-		, symbols       = 'M'.newMap
+		, addresses     = 'Data.Map'.newMap
+		, symbols       = 'Data.Map'.newMap
 		, returns       = []
 		, returnType    = TVoid
 		, stackoffsets  = (0, 0)
@@ -124,10 +127,10 @@ where
 labels :: CompileState -> ['ABC'.Label]
 labels cs = cs.labels
 
-addresses :: CompileState -> 'M'.Map Name Address
+addresses :: CompileState -> 'Data.Map'.Map Name Address
 addresses cs = cs.addresses
 
-symbols :: CompileState -> 'M'.Map Name FunctionSymbol
+symbols :: CompileState -> 'Data.Map'.Map Name FunctionSymbol
 symbols cs = cs.symbols
 
 peekReturn :: CompileState -> 'ABC'.Assembler
@@ -190,7 +193,7 @@ reserveVar (n,t) = gets stackoffsets >>= put
 where
 	put :: (Int, Int) -> Gen Address
 	put (aso, bso) =
-		modify (\cs -> {cs & addresses='M'.put n addr cs.addresses, stackoffsets=so`}) *>
+		modify (\cs -> {cs & addresses='Data.Map'.put n addr cs.addresses, stackoffsets=so`}) *>
 		comment ("Reserved " <+ addr <+ " for " <+ n) $>
 		addr
 	where
@@ -200,13 +203,13 @@ where
 
 findVar :: ParsePosition Name -> Gen Address
 findVar p n = gets stackoffsets >>= \(aso, bso) ->
-	gets addresses >>= \addr -> case 'M'.get n addr of
+	gets addresses >>= \addr -> case 'Data.Map'.get n addr of
 		Just (AAddr i) -> comment (n <+ " is on AStack at " <+ i <+ ", with aso " <+ aso <+ " so " <+ (aso-i)) $> AAddr (aso - i)
 		Just (BAddr i) -> comment (n <+ " is on BStack at " <+ i <+ ", with bso " <+ bso <+ " so " <+ (bso-i)) $> BAddr (bso - i)
 		Nothing        -> error $ C_UndefinedName (errpos p) n
 
 addFunction :: Function -> Gen ()
-addFunction f = modify (\cs -> {cs & symbols='M'.put f.f_name fs cs.symbols})
+addFunction f = modify (\cs -> {cs & symbols='Data.Map'.put f.f_name fs cs.symbols})
 where
 	fs = { fs_arity    = length f.f_args
 	     , fs_argtypes = [a.arg_type \\ a <- f.f_args]
@@ -488,7 +491,7 @@ where
 	gen (Literal _ (ILit i)) =
 		tell ['ABC'.PushI i] *>
 		growStack {zero & bsize=1,btypes=['ABC'.BT_Int]}
-	gen (App p n args) = gets symbols >>= \syms -> case 'M'.get n syms of
+	gen (App p n args) = gets symbols >>= \syms -> case 'Data.Map'.get n syms of
 		Just fs ->
 			comment "Retrieve arguments" *>
 			mapM gen args *>
diff --git a/Sil/Parse.icl b/Sil/Parse.icl
index 2593a48..ed53d9e 100644
--- a/Sil/Parse.icl
+++ b/Sil/Parse.icl
@@ -15,7 +15,6 @@ from Data.Func import $
 import Data.Functor
 import Data.List
 import Data.Maybe
-import qualified Text as T
 from Text import <+, class Text, instance Text String
 
 import Sil.Error
diff --git a/Sil/Util/Parser.dcl b/Sil/Util/Parser.dcl
index e0046fa..2c34d83 100644
--- a/Sil/Util/Parser.dcl
+++ b/Sil/Util/Parser.dcl
@@ -2,7 +2,8 @@ definition module Sil.Util.Parser
 
 from StdOverloaded import class ==, class toString
 
-from Control.Applicative import class Applicative, class Alternative
+from Control.Applicative import class pure, class <*>, class Applicative,
+	class *>, class <*, class Alternative
 from Control.Monad import class Monad
 from Data.Error import :: MaybeError
 from Data.Functor import class Functor
@@ -29,7 +30,10 @@ makeParseState :: [ParseInput a] -> ParseState a
 :: Parser a b = Parser (*(ParseState a) -> *(MaybeError Error b, *ParseState a))
 
 instance Functor (Parser a)
-instance Applicative (Parser a) 
+instance pure (Parser a)
+instance <*> (Parser a)
+instance <* (Parser a)
+instance *> (Parser a)
 instance Monad (Parser a)
 instance Alternative (Parser a)
 
diff --git a/Sil/Util/Parser.icl b/Sil/Util/Parser.icl
index eb90408..95b0813 100644
--- a/Sil/Util/Parser.icl
+++ b/Sil/Util/Parser.icl
@@ -62,11 +62,17 @@ instance Functor (Parser a)
 where
 	fmap f m = liftM f m
 
-instance Applicative (Parser a)
+instance pure (Parser a)
+where
+	pure a = Parser \st -> (Ok a, st)
+
+instance <*> (Parser a)
 where
-	pure a     = Parser \st -> (Ok a, st)
 	(<*>) sf p = ap sf p
 
+instance <* (Parser a)
+instance *> (Parser a)
+
 instance Monad (Parser a)
 where
 	bind p f = Parser \st -> case runParser p (commit st) of
diff --git a/silc.icl b/silc.icl
index 4861d3c..7308914 100644
--- a/silc.icl
+++ b/silc.icl
@@ -24,7 +24,7 @@ import System.Process
 import ABC.Assembler
 
 from Sil.Check import checkProgram
-import qualified Sil.Compile as SC
+import Sil.Compile
 import Sil.Error
 import Sil.Parse
 from Sil.Syntax import :: Program
@@ -108,7 +108,7 @@ Start w
 | not ok
 	# err = err <<< "Could not open '" <<< abcfile <<< "' for writing\r\n"
 	= finish 1 io err w
-#! prog = 'SC'.compile prog
+#! prog = compile prog
 | isError prog
 	# err = err <<< fromError prog
 	= finish 1 io err w
@@ -116,7 +116,7 @@ Start w
 #! (_,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
+#! (p,w) = callProcess "/opt/clean/bin/clm" [module, "-o", module] (Just dir) w
 | isError p
 	# err = err <<< snd (fromError p) <<< "\r\n"
 	= finish 1 io err w
-- 
cgit v1.2.3