aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCamil Staps2018-12-20 21:46:34 +0100
committerCamil Staps2018-12-20 21:48:37 +0100
commitbde9dfef3a80a155c83fd2e8570e782192aa8402 (patch)
tree5be65ca7d9767bfd5ba003fb9e693ea3ce5b39f3
parentFix copy-paste in vim syntax (diff)
Bring up to date
-rw-r--r--ABC.dcl3
-rw-r--r--ABC.icl1
-rw-r--r--Sil/Compile.icl27
-rw-r--r--Sil/Parse.icl1
-rw-r--r--Sil/Util/Parser.dcl8
-rw-r--r--Sil/Util/Parser.icl10
-rw-r--r--silc.icl6
7 files changed, 36 insertions, 20 deletions
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