{-# LANGUAGE CPP #-}
module Generators.GenTypedFlatCurry (genTypedFlatCurry) where
import Curry.FlatCurry.Annotated.Type
import Curry.FlatCurry.Annotated.Goodies
import Curry.FlatCurry.Typed.Type
genTypedFlatCurry :: AProg TypeExpr -> TProg
genTypedFlatCurry :: AProg TypeExpr -> TProg
genTypedFlatCurry = (String
-> [String]
-> [TypeDecl]
-> [AFuncDecl TypeExpr]
-> [OpDecl]
-> TProg)
-> AProg TypeExpr -> TProg
forall a b.
(String
-> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> b)
-> AProg a -> b
trAProg
(\name :: String
name imps :: [String]
imps types :: [TypeDecl]
types funcs :: [AFuncDecl TypeExpr]
funcs ops :: [OpDecl]
ops ->
String
-> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> TProg
TProg String
name [String]
imps [TypeDecl]
types ((AFuncDecl TypeExpr -> TFuncDecl)
-> [AFuncDecl TypeExpr] -> [TFuncDecl]
forall a b. (a -> b) -> [a] -> [b]
map AFuncDecl TypeExpr -> TFuncDecl
genTypedFuncDecl [AFuncDecl TypeExpr]
funcs) [OpDecl]
ops)
genTypedFuncDecl :: AFuncDecl TypeExpr -> TFuncDecl
genTypedFuncDecl :: AFuncDecl TypeExpr -> TFuncDecl
genTypedFuncDecl = (QName
-> Int -> Visibility -> TypeExpr -> ARule TypeExpr -> TFuncDecl)
-> AFuncDecl TypeExpr -> TFuncDecl
forall a b.
(QName -> Int -> Visibility -> TypeExpr -> ARule a -> b)
-> AFuncDecl a -> b
trAFunc
(\name :: QName
name arity :: Int
arity vis :: Visibility
vis ty :: TypeExpr
ty rule :: ARule TypeExpr
rule -> QName -> Int -> Visibility -> TypeExpr -> TRule -> TFuncDecl
TFunc QName
name Int
arity Visibility
vis TypeExpr
ty (TRule -> TFuncDecl) -> TRule -> TFuncDecl
forall a b. (a -> b) -> a -> b
$ ARule TypeExpr -> TRule
genTypedRule ARule TypeExpr
rule)
genTypedRule :: ARule TypeExpr -> TRule
genTypedRule :: ARule TypeExpr -> TRule
genTypedRule = (TypeExpr -> [(Int, TypeExpr)] -> AExpr TypeExpr -> TRule)
-> (TypeExpr -> String -> TRule) -> ARule TypeExpr -> TRule
forall a b.
(a -> [(Int, a)] -> AExpr a -> b)
-> (a -> String -> b) -> ARule a -> b
trARule
(\_ args :: [(Int, TypeExpr)]
args e :: AExpr TypeExpr
e -> [(Int, TypeExpr)] -> TExpr -> TRule
TRule [(Int, TypeExpr)]
args (TExpr -> TRule) -> TExpr -> TRule
forall a b. (a -> b) -> a -> b
$ AExpr TypeExpr -> TExpr
genTypedExpr AExpr TypeExpr
e)
TypeExpr -> String -> TRule
TExternal
genTypedExpr :: AExpr TypeExpr -> TExpr
genTypedExpr :: AExpr TypeExpr -> TExpr
genTypedExpr = (TypeExpr -> Int -> TExpr)
-> (TypeExpr -> Literal -> TExpr)
-> (TypeExpr -> CombType -> (QName, TypeExpr) -> [TExpr] -> TExpr)
-> (TypeExpr -> [((Int, TypeExpr), TExpr)] -> TExpr -> TExpr)
-> (TypeExpr -> [(Int, TypeExpr)] -> TExpr -> TExpr)
-> (TypeExpr -> TExpr -> TExpr -> TExpr)
-> (TypeExpr -> CaseType -> TExpr -> [TBranchExpr] -> TExpr)
-> (APattern TypeExpr -> TExpr -> TBranchExpr)
-> (TypeExpr -> TExpr -> TypeExpr -> TExpr)
-> AExpr TypeExpr
-> TExpr
forall a b c.
(a -> Int -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((Int, a), b)] -> b -> b)
-> (a -> [(Int, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
trAExpr
TypeExpr -> Int -> TExpr
TVarE
TypeExpr -> Literal -> TExpr
TLit
(\ty :: TypeExpr
ty ct :: CombType
ct (name :: QName
name, _) args :: [TExpr]
args -> TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
TComb TypeExpr
ty CombType
ct QName
name [TExpr]
args)
(([((Int, TypeExpr), TExpr)] -> TExpr -> TExpr)
-> TypeExpr -> [((Int, TypeExpr), TExpr)] -> TExpr -> TExpr
forall a b. a -> b -> a
const [((Int, TypeExpr), TExpr)] -> TExpr -> TExpr
TLet)
(([(Int, TypeExpr)] -> TExpr -> TExpr)
-> TypeExpr -> [(Int, TypeExpr)] -> TExpr -> TExpr
forall a b. a -> b -> a
const [(Int, TypeExpr)] -> TExpr -> TExpr
TFree)
((TExpr -> TExpr -> TExpr) -> TypeExpr -> TExpr -> TExpr -> TExpr
forall a b. a -> b -> a
const TExpr -> TExpr -> TExpr
TOr)
((CaseType -> TExpr -> [TBranchExpr] -> TExpr)
-> TypeExpr -> CaseType -> TExpr -> [TBranchExpr] -> TExpr
forall a b. a -> b -> a
const CaseType -> TExpr -> [TBranchExpr] -> TExpr
TCase)
(TPattern -> TExpr -> TBranchExpr
TBranch (TPattern -> TExpr -> TBranchExpr)
-> (APattern TypeExpr -> TPattern)
-> APattern TypeExpr
-> TExpr
-> TBranchExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APattern TypeExpr -> TPattern
genTypedPattern)
((TExpr -> TypeExpr -> TExpr)
-> TypeExpr -> TExpr -> TypeExpr -> TExpr
forall a b. a -> b -> a
const TExpr -> TypeExpr -> TExpr
TTyped)
genTypedPattern :: APattern TypeExpr -> TPattern
genTypedPattern :: APattern TypeExpr -> TPattern
genTypedPattern = (TypeExpr -> (QName, TypeExpr) -> [(Int, TypeExpr)] -> TPattern)
-> (TypeExpr -> Literal -> TPattern)
-> APattern TypeExpr
-> TPattern
forall a b.
(a -> (QName, a) -> [(Int, a)] -> b)
-> (a -> Literal -> b) -> APattern a -> b
trAPattern
(\ty :: TypeExpr
ty (name :: QName
name, _) args :: [(Int, TypeExpr)]
args -> TypeExpr -> QName -> [(Int, TypeExpr)] -> TPattern
TPattern TypeExpr
ty QName
name [(Int, TypeExpr)]
args)
TypeExpr -> Literal -> TPattern
TLPattern