{- 2010-09-17 haskell syntax tools -}

{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

module HsSyntax where

import Abstract (PiSigma(..))
-- import Language.Haskell.Exts.SrcLoc (SrcLoc(..))
import Language.Haskell.Exts.Syntax ()
import qualified Language.Haskell.Exts.Syntax as H

-- noLoc :: SrcLoc
-- noLoc = SrcLoc "" 0 0

noLoc :: ()
noLoc :: ()
noLoc = ()

type Exp        = H.Exp ()
type Pat        = H.Pat ()
type Type       = H.Type ()
type Kind       = H.Kind ()
type Decl       = H.Decl ()
type Name       = H.Name ()
type QName      = H.QName ()
type Match      = H.Match ()
type Module     = H.Module ()
type ImportDecl = H.ImportDecl ()
type TyVarBind  = H.TyVarBind ()
type GadtDecl   = H.GadtDecl ()

hQual :: ModuleName () -> Name () -> QName ()
hQual         = () -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
H.Qual ()
hUnQual :: Name () -> QName ()
hUnQual       = () -> Name () -> QName ()
forall l. l -> Name l -> QName l
H.UnQual ()
hModuleName :: String -> ModuleName ()
hModuleName   = () -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
H.ModuleName ()
hIdent :: String -> Name ()
hIdent        = () -> String -> Name ()
forall l. l -> String -> Name l
H.Ident ()
hFunBind :: [Match ()] -> Decl ()
hFunBind      = () -> [Match ()] -> Decl ()
forall l. l -> [Match l] -> Decl l
H.FunBind ()
hVar :: QName () -> Exp ()
hVar          = () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
H.Var ()
hCon :: QName () -> Exp ()
hCon          = () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
H.Con ()
hLit :: Literal () -> Exp ()
hLit          = () -> Literal () -> Exp ()
forall l. l -> Literal l -> Exp l
H.Lit ()
hApp :: Exp () -> Exp () -> Exp ()
hApp          = () -> Exp () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l -> Exp l
H.App ()
hString :: String -> Literal ()
hString String
s     = () -> String -> String -> Literal ()
forall l. l -> String -> String -> Literal l
H.String () String
s String
s
hTyVar :: Name () -> Type ()
hTyVar        = () -> Name () -> Type ()
forall l. l -> Name l -> Type l
H.TyVar ()
hTyCon :: QName () -> Type ()
hTyCon        = () -> QName () -> Type ()
forall l. l -> QName l -> Type l
H.TyCon ()
hTyApp :: Type () -> Type () -> Type ()
hTyApp        = () -> Type () -> Type () -> Type ()
forall l. l -> Type l -> Type l -> Type l
H.TyApp ()
hDataType :: DataOrNew ()
hDataType     = () -> DataOrNew ()
forall l. l -> DataOrNew l
H.DataType ()
hKindFn :: Type () -> Type () -> Type ()
hKindFn       = () -> Type () -> Type () -> Type ()
forall l. l -> Type l -> Type l -> Type l
H.TyFun () -- H.KindFn ()
hTyTuple :: Boxed -> [Type ()] -> Type ()
hTyTuple      = () -> Boxed -> [Type ()] -> Type ()
forall l. l -> Boxed -> [Type l] -> Type l
H.TyTuple ()
hTyFun :: Type () -> Type () -> Type ()
hTyFun        = () -> Type () -> Type () -> Type ()
forall l. l -> Type l -> Type l -> Type l
H.TyFun ()
hTyForall :: Maybe [TyVarBind ()] -> Maybe (Context ()) -> Type () -> Type ()
hTyForall     = ()
-> Maybe [TyVarBind ()] -> Maybe (Context ()) -> Type () -> Type ()
forall l.
l -> Maybe [TyVarBind l] -> Maybe (Context l) -> Type l -> Type l
H.TyForall ()
hKindedVar :: Name () -> Type () -> TyVarBind ()
hKindedVar    = () -> Name () -> Type () -> TyVarBind ()
forall l. l -> Name l -> Kind l -> TyVarBind l
H.KindedVar ()
hTyParen :: Type () -> Type ()
hTyParen      = () -> Type () -> Type ()
forall l. l -> Type l -> Type l
H.TyParen ()
hBDecls :: [Decl ()] -> Binds ()
hBDecls       = () -> [Decl ()] -> Binds ()
forall l. l -> [Decl l] -> Binds l
H.BDecls ()
hUnGuardedRhs :: Exp () -> Rhs ()
hUnGuardedRhs = () -> Exp () -> Rhs ()
forall l. l -> Exp l -> Rhs l
H.UnGuardedRhs ()
hParen :: Exp () -> Exp ()
hParen        = () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l
H.Paren ()
hLet :: Binds () -> Exp () -> Exp ()
hLet          = () -> Binds () -> Exp () -> Exp ()
forall l. l -> Binds l -> Exp l -> Exp l
H.Let ()
hTuple :: Boxed -> [Exp ()] -> Exp ()
hTuple        = () -> Boxed -> [Exp ()] -> Exp ()
forall l. l -> Boxed -> [Exp l] -> Exp l
H.Tuple ()
hPVar :: Name () -> Pat ()
hPVar         = () -> Name () -> Pat ()
forall l. l -> Name l -> Pat l
H.PVar ()
hPApp :: QName () -> [Pat ()] -> Pat ()
hPApp         = () -> QName () -> [Pat ()] -> Pat ()
forall l. l -> QName l -> [Pat l] -> Pat l
H.PApp ()
hPTuple :: Boxed -> [Pat ()] -> Pat ()
hPTuple       = () -> Boxed -> [Pat ()] -> Pat ()
forall l. l -> Boxed -> [Pat l] -> Pat l
H.PTuple ()
hKindStar :: Type ()
hKindStar     = () -> Type ()
forall l. l -> Type l
H.TyStar () -- H.KindStar ()

main_name :: Name ()
main_name  = () -> Name ()
forall l. l -> Name l
H.main_name ()
main_mod :: ModuleName ()
main_mod   = () -> ModuleName ()
forall l. l -> ModuleName l
H.main_mod ()
unit_tycon :: Type ()
unit_tycon = () -> Type ()
forall l. l -> Type l
H.unit_tycon ()

mkQual :: String -> String -> QName
mkQual :: String -> String -> QName ()
mkQual String
m String
s = ModuleName () -> Name () -> QName ()
hQual (String -> ModuleName ()
hModuleName String
m) (String -> Name ()
hIdent String
s)

mkModule :: [Decl] -> Module
mkModule :: [Decl ()] -> Module
mkModule [Decl ()]
hs = ()
-> Maybe (ModuleHead ())
-> [ModulePragma ()]
-> [ImportDecl ()]
-> [Decl ()]
-> Module
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
H.Module ()
noLoc (ModuleHead () -> Maybe (ModuleHead ())
forall a. a -> Maybe a
Just (()
-> ModuleName ()
-> Maybe (WarningText ())
-> Maybe (ExportSpecList ())
-> ModuleHead ()
forall l.
l
-> ModuleName l
-> Maybe (WarningText l)
-> Maybe (ExportSpecList l)
-> ModuleHead l
H.ModuleHead () ModuleName ()
main_mod Maybe (WarningText ())
forall {a}. Maybe a
warning Maybe (ExportSpecList ())
forall {a}. Maybe a
exports)) [ModulePragma ()]
pragmas [ImportDecl ()]
imports [Decl ()]
decls where
  pragmas :: [ModulePragma ()]
pragmas = [ () -> [Name ()] -> ModulePragma ()
forall l. l -> [Name l] -> ModulePragma l
H.LanguagePragma ()
noLoc ([Name ()] -> ModulePragma ()) -> [Name ()] -> ModulePragma ()
forall a b. (a -> b) -> a -> b
$ (String -> Name ()) -> [String] -> [Name ()]
forall a b. (a -> b) -> [a] -> [b]
map String -> Name ()
hIdent
    [ String
"NoImplicitPrelude"
    , String
"GADTs"
    , String
"KindSignatures"
    ]]
  warning :: Maybe a
warning = Maybe a
forall {a}. Maybe a
Nothing
  exports :: Maybe a
exports = Maybe a
forall {a}. Maybe a
Nothing
  imports :: [ImportDecl ()]
imports =
    [ String -> String -> ImportDecl ()
mkQualImport String
"GHC.Show" String
"Show"
    , String -> String -> ImportDecl ()
mkQualImport String
"System.IO" String
"IO"
    , String -> String -> ImportDecl ()
mkQualImport String
"Unsafe.Coerce" String
"Coerce"
    ]
  decls :: [Decl ()]
decls   = [Decl ()]
hs [Decl ()] -> [Decl ()] -> [Decl ()]
forall a. [a] -> [a] -> [a]
++
    [ () -> [Name ()] -> Type () -> Decl ()
forall l. l -> [Name l] -> Type l -> Decl l
H.TypeSig ()
noLoc [ Name ()
main_name ] Type ()
io
    , [Match ()] -> Decl ()
hFunBind [ Name () -> [Pat ()] -> Exp () -> Match ()
mkClause Name ()
main_name [] Exp ()
rhs ]
    ] where rhs :: Exp ()
rhs  = QName () -> Exp ()
hVar (String -> String -> QName ()
mkQual String
"IO" String
"putStrLn") Exp () -> Exp () -> Exp ()
`hApp` Literal () -> Exp ()
hLit (String -> Literal ()
hString String
"Hello, world!")
            io :: Type ()
io   = QName () -> Type ()
hTyCon (String -> String -> QName ()
mkQual String
"IO" String
"IO") Type () -> Type () -> Type ()
`hTyApp` Type ()
unit_tycon

mkQualImport :: String -> String -> ImportDecl
mkQualImport :: String -> String -> ImportDecl ()
mkQualImport String
modName String
asName =
  H.ImportDecl
  { importAnn :: ()
H.importAnn       = ()
noLoc
  , importModule :: ModuleName ()
H.importModule    = String -> ModuleName ()
hModuleName String
modName
  , importQualified :: Bool
H.importQualified = Bool
True
  , importSrc :: Bool
H.importSrc       = Bool
False
  , importSafe :: Bool
H.importSafe      = Bool
False
  , importPkg :: Maybe String
H.importPkg       = Maybe String
forall {a}. Maybe a
Nothing
  , importAs :: Maybe (ModuleName ())
H.importAs        = ModuleName () -> Maybe (ModuleName ())
forall a. a -> Maybe a
Just (ModuleName () -> Maybe (ModuleName ()))
-> ModuleName () -> Maybe (ModuleName ())
forall a b. (a -> b) -> a -> b
$ String -> ModuleName ()
hModuleName String
asName
  , importSpecs :: Maybe (ImportSpecList ())
H.importSpecs     = Maybe (ImportSpecList ())
forall {a}. Maybe a
Nothing
  }

noContext :: Maybe a
noContext = Maybe a
forall {a}. Maybe a
Nothing
noDeriving :: [a]
noDeriving = []
noTyVarBind :: [a]
noTyVarBind = []
showDeriving :: Deriving ()
showDeriving = () -> Maybe (DerivStrategy ()) -> [InstRule ()] -> Deriving ()
forall l.
l -> Maybe (DerivStrategy l) -> [InstRule l] -> Deriving l
H.Deriving ()
  (DerivStrategy () -> Maybe (DerivStrategy ())
forall a. a -> Maybe a
Just (() -> DerivStrategy ()
forall l. l -> DerivStrategy l
H.DerivStock ()))
  [()
-> Maybe [TyVarBind ()]
-> Maybe (Context ())
-> InstHead ()
-> InstRule ()
forall l.
l
-> Maybe [TyVarBind l]
-> Maybe (Context l)
-> InstHead l
-> InstRule l
H.IRule () Maybe [TyVarBind ()]
forall {a}. Maybe a
Nothing Maybe (Context ())
forall {a}. Maybe a
Nothing (InstHead () -> InstRule ()) -> InstHead () -> InstRule ()
forall a b. (a -> b) -> a -> b
$ () -> QName () -> InstHead ()
forall l. l -> QName l -> InstHead l
H.IHCon () (String -> String -> QName ()
mkQual String
"Show" String
"Show")]

mkDataDecl :: Name -> [TyVarBind] -> Kind -> [GadtDecl] -> Decl
mkDataDecl :: Name () -> [TyVarBind ()] -> Type () -> [GadtDecl] -> Decl ()
mkDataDecl Name ()
n [TyVarBind ()]
tel Type ()
k [GadtDecl]
cs =
  ()
-> DataOrNew ()
-> Maybe (Context ())
-> DeclHead ()
-> Maybe (Type ())
-> [GadtDecl]
-> [Deriving ()]
-> Decl ()
forall l.
l
-> DataOrNew l
-> Maybe (Context l)
-> DeclHead l
-> Maybe (Type l)
-> [GadtDecl l]
-> [Deriving l]
-> Decl l
H.GDataDecl ()
noLoc DataOrNew ()
hDataType Maybe (Context ())
forall {a}. Maybe a
noContext
    ((DeclHead () -> TyVarBind () -> DeclHead ())
-> DeclHead () -> [TyVarBind ()] -> DeclHead ()
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (() -> DeclHead () -> TyVarBind () -> DeclHead ()
forall l. l -> DeclHead l -> TyVarBind l -> DeclHead l
H.DHApp ()) (() -> Name () -> DeclHead ()
forall l. l -> Name l -> DeclHead l
H.DHead () Name ()
n) [TyVarBind ()]
tel)
    (Type () -> Maybe (Type ())
forall a. a -> Maybe a
Just Type ()
k) [GadtDecl]
cs [Deriving ()
showDeriving]

mkConDecl :: Name -> Type -> GadtDecl
mkConDecl :: Name () -> Type () -> GadtDecl
mkConDecl Name ()
n Type ()
t = ()
-> Name ()
-> Maybe [TyVarBind ()]
-> Maybe (Context ())
-> Maybe [FieldDecl ()]
-> Type ()
-> GadtDecl
forall l.
l
-> Name l
-> Maybe [TyVarBind l]
-> Maybe (Context l)
-> Maybe [FieldDecl l]
-> Type l
-> GadtDecl l
H.GadtDecl ()
noLoc Name ()
n Maybe [TyVarBind ()]
forall {a}. Maybe a
Nothing Maybe (Context ())
forall {a}. Maybe a
Nothing Maybe [FieldDecl ()]
forall {a}. Maybe a
Nothing Type ()
t

mkKindFun :: Kind -> Kind -> Kind
mkKindFun :: Type () -> Type () -> Type ()
mkKindFun = Type () -> Type () -> Type ()
hKindFn
{-
mkKindFun k k' = parens k `KindFn` k'
      where parens H.KindStar = H.KindStar
            parens k          = H.KindParen k
-}

mkTyPiSig :: PiSigma -> Type -> Type -> Type
mkTyPiSig :: PiSigma -> Type () -> Type () -> Type ()
mkTyPiSig PiSigma
Pi    = Type () -> Type () -> Type ()
mkTyFun
mkTyPiSig PiSigma
Sigma = Type () -> Type () -> Type ()
mkTyProd

mkTyProd :: Type -> Type -> Type
mkTyProd :: Type () -> Type () -> Type ()
mkTyProd Type ()
a Type ()
b = Boxed -> [Type ()] -> Type ()
hTyTuple Boxed
H.Boxed [Type ()
a,Type ()
b]

mkTyFun :: Type -> Type -> Type
mkTyFun :: Type () -> Type () -> Type ()
mkTyFun = Type () -> Type () -> Type ()
hTyFun
-- mkTyFun a b = mkTyParen a `TyFun` b

mkForall :: Name -> Kind -> Type -> Type
mkForall :: Name () -> Type () -> Type () -> Type ()
mkForall Name ()
x Type ()
k Type ()
t = Maybe [TyVarBind ()] -> Maybe (Context ()) -> Type () -> Type ()
hTyForall ([TyVarBind ()] -> Maybe [TyVarBind ()]
forall a. a -> Maybe a
Just ([TyVarBind ()] -> Maybe [TyVarBind ()])
-> [TyVarBind ()] -> Maybe [TyVarBind ()]
forall a b. (a -> b) -> a -> b
$ [Name () -> Type () -> TyVarBind ()
hKindedVar Name ()
x Type ()
k]) Maybe (Context ())
forall {a}. Maybe a
noContext Type ()
t

mkTyParen :: Type -> Type
mkTyParen :: Type () -> Type ()
mkTyParen a :: Type ()
a@(H.TyVar{}) = Type ()
a
mkTyParen a :: Type ()
a@(H.TyCon{}) = Type ()
a
mkTyParen Type ()
a = Type () -> Type ()
hTyParen Type ()
a

mkTyApp :: Type -> Type -> Type
mkTyApp :: Type () -> Type () -> Type ()
mkTyApp Type ()
f Type ()
a = Type () -> Type () -> Type ()
hTyApp Type ()
f Type ()
a

noBinds :: Binds ()
noBinds = [Decl ()] -> Binds ()
hBDecls []

mkTypeSig :: Name -> Type -> Decl
mkTypeSig :: Name () -> Type () -> Decl ()
mkTypeSig Name ()
x Type ()
t = () -> [Name ()] -> Type () -> Decl ()
forall l. l -> [Name l] -> Type l -> Decl l
H.TypeSig ()
noLoc [Name ()
x] Type ()
t

-- create a simple function clause x = t
mkLet :: Name -> Exp -> Decl
mkLet :: Name () -> Exp () -> Decl ()
mkLet Name ()
x Exp ()
e = [Match ()] -> Decl ()
hFunBind [Name () -> [Pat ()] -> Exp () -> Match ()
mkClause Name ()
x [] Exp ()
e]

mkClause :: Name -> [Pat] -> Exp -> Match
mkClause :: Name () -> [Pat ()] -> Exp () -> Match ()
mkClause Name ()
f [Pat ()]
ps Exp ()
e = () -> Name () -> [Pat ()] -> Rhs () -> Maybe (Binds ()) -> Match ()
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
H.Match ()
noLoc Name ()
f [Pat ()]
ps (Exp () -> Rhs ()
hUnGuardedRhs Exp ()
e) Maybe (Binds ())
forall {a}. Maybe a
Nothing

mkCast :: Exp -> Exp
mkCast :: Exp () -> Exp ()
mkCast Exp ()
e = QName () -> Exp ()
hVar (String -> String -> QName ()
mkQual String
"Coerce" String
"unsafeCoerce") Exp () -> Exp () -> Exp ()
`hApp` Exp ()
e

mkCon :: Name -> Exp
mkCon :: Name () -> Exp ()
mkCon = QName () -> Exp ()
hCon (QName () -> Exp ()) -> (Name () -> QName ()) -> Name () -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name () -> QName ()
hUnQual

mkVar :: Name -> Exp
mkVar :: Name () -> Exp ()
mkVar = QName () -> Exp ()
hVar (QName () -> Exp ()) -> (Name () -> QName ()) -> Name () -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name () -> QName ()
hUnQual

mkLam :: Name -> Exp -> Exp
mkLam :: Name () -> Exp () -> Exp ()
mkLam Name ()
x (H.Lambda ()
_ [Pat ()]
ps Exp ()
e) = () -> [Pat ()] -> Exp () -> Exp ()
forall l. l -> [Pat l] -> Exp l -> Exp l
H.Lambda ()
noLoc (Name () -> Pat ()
hPVar Name ()
x Pat () -> [Pat ()] -> [Pat ()]
forall a. a -> [a] -> [a]
: [Pat ()]
ps) Exp ()
e
mkLam Name ()
x  Exp ()
e                = () -> [Pat ()] -> Exp () -> Exp ()
forall l. l -> [Pat l] -> Exp l -> Exp l
H.Lambda ()
noLoc [Name () -> Pat ()
hPVar Name ()
x] Exp ()
e

mkParen :: Exp -> Exp
mkParen :: Exp () -> Exp ()
mkParen e :: Exp ()
e@(H.Var{}) = Exp ()
e
mkParen e :: Exp ()
e@(H.Con{}) = Exp ()
e
mkParen Exp ()
e = Exp () -> Exp ()
hParen Exp ()
e

mkApp :: Exp -> Exp -> Exp
mkApp :: Exp () -> Exp () -> Exp ()
mkApp Exp ()
f Exp ()
e = Exp () -> Exp () -> Exp ()
hApp Exp ()
f Exp ()
e -- (mkParen e)

mkLLet :: Name -> Maybe Type -> Exp -> Exp -> Exp
mkLLet :: Name () -> Maybe (Type ()) -> Exp () -> Exp () -> Exp ()
mkLLet Name ()
x Maybe (Type ())
t Exp ()
e Exp ()
e' = Binds () -> Exp () -> Exp ()
hLet ([Decl ()] -> Binds ()
hBDecls [Name () -> Exp () -> Decl ()
mkLet Name ()
x Exp ()
e]) Exp ()
e'

mkPair :: Exp -> Exp -> Exp
mkPair :: Exp () -> Exp () -> Exp ()
mkPair Exp ()
e1 Exp ()
e2 = Boxed -> [Exp ()] -> Exp ()
hTuple Boxed
H.Boxed [Exp ()
e1,Exp ()
e2]

{- this is already predefined as unit_con
hsDummyExp :: HsExp
hsDummyExp = HsCon $ Special $ HsUnitCon  -- Haskell's '()'
-}