Skip to content

Commit 4b61b28

Browse files
committed
Cosmetic changes that needed by the idris-grin front end.
1 parent 3551221 commit 4b61b28

File tree

3 files changed

+11
-2
lines changed

3 files changed

+11
-2
lines changed

grin/src/Grin/ExtendedSyntax/Syntax.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -87,7 +87,6 @@ data CPat
8787
-- * Binding pattern
8888
data BPat
8989
= VarPat { _bPatVar :: Name }
90-
-- TODO: swap the fields so that it is consistent with the concrete syntax
9190
| AsPat { _bPatTag :: Tag
9291
, _bPatFields :: [Name]
9392
, _bPatVar :: Name

grin/src/Reducer/LLVM/PrimOps.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -74,6 +74,7 @@ codeGenPrimOp name [opA, opB] = pure $ case name of
7474
"_prim_bool_ne" -> I cgBool $ ICmp {iPredicate=I.NE, operand0=opA, operand1=opB, metadata=[]}
7575

7676
_ -> error $ "unknown primop: " ++ show name
77+
codeGenPrimOp name ops = error $ "Non supported primitive opts argument combination:" ++ show (name, ops)
7778

7879
codeGenFFI :: Grin.External -> [Operand] -> CG Result
7980
codeGenFFI e ops = do

grin/src/Transformations/ExtendedSyntax/Names.hs

Lines changed: 10 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ import qualified Data.Foldable
1414
import Text.Printf
1515

1616
import Control.Monad
17-
import Control.Monad.State
17+
import Control.Monad.State.Strict
1818

1919
import Grin.ExtendedSyntax.Grin
2020
import Transformations.ExtendedSyntax.Util
@@ -27,6 +27,12 @@ data NameEnv
2727
, nameSet :: Set Name
2828
}
2929

30+
instance Semigroup NameEnv where
31+
(NameEnv np1 ns1) <> (NameEnv np2 ns2) = NameEnv (np1 <> np2) (ns1 <> ns2)
32+
33+
instance Monoid NameEnv where
34+
mempty = NameEnv mempty mempty
35+
3036
type NameM = State NameEnv
3137

3238
mkNameEnv :: Exp -> NameEnv
@@ -73,6 +79,9 @@ data ExpChanges
7379
evalNameM :: Exp -> NameM a -> (a, ExpChanges)
7480
evalNameM e m = second (boolTF NoChange NewNames . Map.null . namePool) $ runState m (mkNameEnv e)
7581

82+
runEvalNameM :: NameM a -> a
83+
runEvalNameM m = evalState m mempty
84+
7685
-- refresh names
7786

7887
type FreshM = StateT (Map Name Name) NameM

0 commit comments

Comments
 (0)