f728b91a8a
nightmare breaking changes. never listening to the "i'll do it later if i REALLY need it" part of my brain again. add annotation param to Expr
124 lines
2.9 KiB
Haskell
124 lines
2.9 KiB
Haskell
{-|
|
|
Module : Core.Syntax
|
|
Description : Core ASTs and the like
|
|
-}
|
|
{-# LANGUAGE PatternSynonyms, OverloadedStrings #-}
|
|
module Core.Syntax
|
|
( Expr(..)
|
|
, Id(..)
|
|
, Literal(..)
|
|
, pattern (:$)
|
|
, Binding(..)
|
|
, AltCon(..)
|
|
, pattern (:=)
|
|
, Rec(..)
|
|
, Alter(..)
|
|
, Name
|
|
, Tag
|
|
, ScDef(..)
|
|
, Module(..)
|
|
, Program(..)
|
|
, CoreProgram
|
|
, bindersOf
|
|
, rhssOf
|
|
, isAtomic
|
|
, insertModule
|
|
, extractProgram
|
|
)
|
|
where
|
|
----------------------------------------------------------------------------------
|
|
import Data.Coerce
|
|
import Data.Pretty
|
|
import Data.List (intersperse)
|
|
import Data.Function ((&))
|
|
import Data.String
|
|
import Language.Haskell.TH.Syntax (Lift)
|
|
----------------------------------------------------------------------------------
|
|
|
|
data Expr b = Var Id
|
|
| Con Tag Int -- Con Tag Arity
|
|
| Case (Expr b) [Alter b]
|
|
| Lam [b] (Expr b)
|
|
| Let Rec [Binding b] (Expr b)
|
|
| App (Expr b) (Expr b)
|
|
| LitE Literal
|
|
deriving (Show, Read, Lift)
|
|
|
|
data Id = Name Name
|
|
deriving (Show, Read, Lift)
|
|
|
|
infixl 2 :$
|
|
pattern (:$) :: Expr b -> Expr b -> Expr b
|
|
pattern f :$ x = App f x
|
|
|
|
{-# COMPLETE Binding :: Binding #-}
|
|
{-# COMPLETE (:=) :: Binding #-}
|
|
data Binding b = Binding b (Expr b)
|
|
deriving (Show, Read, Lift)
|
|
|
|
infixl 1 :=
|
|
pattern (:=) :: b -> (Expr b) -> (Binding b)
|
|
pattern k := v = Binding k v
|
|
data Alter b = Alter AltCon [b] (Expr b)
|
|
deriving (Show, Read, Lift)
|
|
|
|
data Rec = Rec
|
|
| NonRec
|
|
deriving (Show, Read, Eq, Lift)
|
|
|
|
data AltCon = AltData Tag
|
|
| AltLiteral Literal
|
|
| Default
|
|
deriving (Show, Read, Lift)
|
|
|
|
data Literal = IntL Int
|
|
deriving (Show, Read, Lift)
|
|
|
|
type Name = String
|
|
type Tag = Int
|
|
|
|
data ScDef b = ScDef b [b] (Expr b)
|
|
deriving (Show, Lift)
|
|
|
|
data Module b = Module (Maybe (Name, [Name])) (Program b)
|
|
deriving (Show, Lift)
|
|
|
|
newtype Program b = Program [ScDef b]
|
|
deriving (Show, Lift)
|
|
|
|
type CoreProgram = Program Name
|
|
|
|
instance IsString (Expr b) where
|
|
fromString = Var . Name
|
|
|
|
----------------------------------------------------------------------------------
|
|
|
|
instance Semigroup (Program b) where
|
|
(<>) = coerce $ (<>) @[ScDef b]
|
|
|
|
instance Monoid (Program b) where
|
|
mempty = Program []
|
|
|
|
----------------------------------------------------------------------------------
|
|
|
|
bindersOf :: [(Name, b)] -> [Name]
|
|
bindersOf = fmap fst
|
|
|
|
rhssOf :: [(Name, b)] -> [b]
|
|
rhssOf = fmap snd
|
|
|
|
isAtomic :: Expr b -> Bool
|
|
isAtomic (Var _) = True
|
|
isAtomic (LitE _) = True
|
|
isAtomic _ = False
|
|
|
|
----------------------------------------------------------------------------------
|
|
|
|
-- TODO: export list awareness
|
|
insertModule :: (Module b) -> (Program b) -> (Program b)
|
|
insertModule (Module _ m) p = p <> m
|
|
|
|
extractProgram :: (Module b) -> (Program b)
|
|
extractProgram (Module _ p) = p
|
|
|