diff options
author | Camil Staps | 2018-12-20 21:46:34 +0100 |
---|---|---|
committer | Camil Staps | 2018-12-20 21:48:37 +0100 |
commit | bde9dfef3a80a155c83fd2e8570e782192aa8402 (patch) | |
tree | 5be65ca7d9767bfd5ba003fb9e693ea3ce5b39f3 /Sil | |
parent | Fix copy-paste in vim syntax (diff) |
Bring up to date
Diffstat (limited to 'Sil')
-rw-r--r-- | Sil/Compile.icl | 27 | ||||
-rw-r--r-- | Sil/Parse.icl | 1 | ||||
-rw-r--r-- | Sil/Util/Parser.dcl | 8 | ||||
-rw-r--r-- | Sil/Util/Parser.icl | 10 |
4 files changed, 29 insertions, 17 deletions
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 |