module Agda.Compiler.JS.Syntax where
import Data.Typeable ( Typeable )
import Data.Map ( Map, fold )
import Data.Set ( Set, empty, singleton, union )
import Agda.Syntax.Common ( Nat )
data Exp =
Self |
Local LocalId |
Global GlobalId |
Undefined |
String String |
Char Char |
Integer Integer |
Double Double |
Lambda Nat Exp |
Object (Map MemberId Exp) |
Apply Exp [Exp] |
Lookup Exp MemberId |
If Exp Exp Exp |
BinOp Exp String Exp |
PreOp String Exp |
Const String
deriving (Typeable, Show)
newtype LocalId = LocalId Nat
deriving (Typeable, Eq, Ord, Show)
newtype GlobalId = GlobalId [String]
deriving (Typeable, Eq, Ord, Show)
newtype MemberId = MemberId String
deriving (Typeable, Eq, Ord, Show)
data Export = Export { expName :: [MemberId], defn :: Exp }
deriving (Typeable, Show)
data Module = Module { modName :: GlobalId, exports :: [Export] }
deriving (Typeable, Show)
class Uses a where
uses :: a -> Set [MemberId]
instance Uses a => Uses [a] where
uses = foldr (union . uses) empty
instance Uses a => Uses (Map k a) where
uses = fold (union . uses) empty
instance Uses Exp where
uses (Object o) = fold (union . uses) empty o
uses (Apply e es) = foldr (union . uses) (uses e) es
uses (Lookup e l) = uses' e [l] where
uses' Self ls = singleton ls
uses' (Lookup e l) ls = uses' e (l : ls)
uses' e ls = uses e
uses (If e f g) = uses e `union` uses f `union` uses g
uses (BinOp e op f) = uses e `union` uses f
uses (PreOp op e) = uses e
uses e = empty
instance Uses Export where
uses (Export ls e) = uses e
class Globals a where
globals :: a -> Set GlobalId
instance Globals a => Globals [a] where
globals = foldr (union . globals) empty
instance Globals a => Globals (Map k a) where
globals = fold (union . globals) empty
instance Globals Exp where
globals (Global i) = singleton i
globals (Lambda n e) = globals e
globals (Object o) = globals o
globals (Apply e es) = globals e `union` globals es
globals (Lookup e l) = globals e
globals (If e f g) = globals e `union` globals f `union` globals g
globals (BinOp e op f) = globals e `union` globals f
globals (PreOp op e) = globals e
globals _ = empty
instance Globals Export where
globals (Export ls e) = globals e
instance Globals Module where
globals (Module m es) = globals es