module Generators.GenFlatCurry (genFlatCurry, genFlatInterface) where
import Curry.FlatCurry.Goodies
import Curry.FlatCurry.Type
import Curry.FlatCurry.Typed.Goodies
import Curry.FlatCurry.Typed.Type
genFlatCurry :: TProg -> Prog
genFlatCurry :: TProg -> Prog
genFlatCurry = (String
-> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> Prog)
-> TProg -> Prog
forall b.
(String -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> b)
-> TProg -> b
trTProg
(\name :: String
name imps :: [String]
imps types :: [TypeDecl]
types funcs :: [TFuncDecl]
funcs ops :: [OpDecl]
ops ->
String -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> Prog
Prog String
name [String]
imps [TypeDecl]
types ((TFuncDecl -> FuncDecl) -> [TFuncDecl] -> [FuncDecl]
forall a b. (a -> b) -> [a] -> [b]
map TFuncDecl -> FuncDecl
genFlatFuncDecl [TFuncDecl]
funcs) [OpDecl]
ops)
genFlatFuncDecl :: TFuncDecl -> FuncDecl
genFlatFuncDecl :: TFuncDecl -> FuncDecl
genFlatFuncDecl = (QName -> Int -> Visibility -> TypeExpr -> TRule -> FuncDecl)
-> TFuncDecl -> FuncDecl
forall b.
(QName -> Int -> Visibility -> TypeExpr -> TRule -> b)
-> TFuncDecl -> b
trTFunc
(\name :: QName
name arity :: Int
arity vis :: Visibility
vis ty :: TypeExpr
ty rule :: TRule
rule -> QName -> Int -> Visibility -> TypeExpr -> Rule -> FuncDecl
Func QName
name Int
arity Visibility
vis TypeExpr
ty (Rule -> FuncDecl) -> Rule -> FuncDecl
forall a b. (a -> b) -> a -> b
$ TRule -> Rule
genFlatRule TRule
rule)
genFlatRule :: TRule -> Rule
genFlatRule :: TRule -> Rule
genFlatRule = ([(Int, TypeExpr)] -> TExpr -> Rule)
-> (TypeExpr -> String -> Rule) -> TRule -> Rule
forall b.
([(Int, TypeExpr)] -> TExpr -> b)
-> (TypeExpr -> String -> b) -> TRule -> b
trTRule
(\args :: [(Int, TypeExpr)]
args e :: TExpr
e -> [Int] -> Expr -> Rule
Rule (((Int, TypeExpr) -> Int) -> [(Int, TypeExpr)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, TypeExpr) -> Int
forall a b. (a, b) -> a
fst [(Int, TypeExpr)]
args) (Expr -> Rule) -> Expr -> Rule
forall a b. (a -> b) -> a -> b
$ TExpr -> Expr
genFlatExpr TExpr
e)
((String -> Rule) -> TypeExpr -> String -> Rule
forall a b. a -> b -> a
const String -> Rule
External)
genFlatExpr :: TExpr -> Expr
genFlatExpr :: TExpr -> Expr
genFlatExpr = (TypeExpr -> Int -> Expr)
-> (TypeExpr -> Literal -> Expr)
-> (TypeExpr -> CombType -> QName -> [Expr] -> Expr)
-> ([((Int, TypeExpr), Expr)] -> Expr -> Expr)
-> ([(Int, TypeExpr)] -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> (CaseType -> Expr -> [BranchExpr] -> Expr)
-> (TPattern -> Expr -> BranchExpr)
-> (Expr -> TypeExpr -> Expr)
-> TExpr
-> Expr
forall b c.
(TypeExpr -> Int -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((Int, TypeExpr), b)] -> b -> b)
-> ([(Int, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
trTExpr
((Int -> Expr) -> TypeExpr -> Int -> Expr
forall a b. a -> b -> a
const Int -> Expr
Var)
((Literal -> Expr) -> TypeExpr -> Literal -> Expr
forall a b. a -> b -> a
const Literal -> Expr
Lit)
(\_ ct :: CombType
ct name :: QName
name args :: [Expr]
args -> CombType -> QName -> [Expr] -> Expr
Comb CombType
ct QName
name [Expr]
args)
(\bs :: [((Int, TypeExpr), Expr)]
bs e :: Expr
e -> [(Int, Expr)] -> Expr -> Expr
Let ((((Int, TypeExpr), Expr) -> (Int, Expr))
-> [((Int, TypeExpr), Expr)] -> [(Int, Expr)]
forall a b. (a -> b) -> [a] -> [b]
map (\(v :: (Int, TypeExpr)
v, e' :: Expr
e') -> ((Int, TypeExpr) -> Int
forall a b. (a, b) -> a
fst (Int, TypeExpr)
v, Expr
e')) [((Int, TypeExpr), Expr)]
bs) Expr
e)
(\vs :: [(Int, TypeExpr)]
vs e :: Expr
e -> [Int] -> Expr -> Expr
Free (((Int, TypeExpr) -> Int) -> [(Int, TypeExpr)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, TypeExpr) -> Int
forall a b. (a, b) -> a
fst [(Int, TypeExpr)]
vs) Expr
e)
Expr -> Expr -> Expr
Or
CaseType -> Expr -> [BranchExpr] -> Expr
Case
(\pat :: TPattern
pat e :: Expr
e -> Pattern -> Expr -> BranchExpr
Branch (TPattern -> Pattern
genFlatPattern TPattern
pat) Expr
e)
Expr -> TypeExpr -> Expr
Typed
genFlatPattern :: TPattern -> Pattern
genFlatPattern :: TPattern -> Pattern
genFlatPattern = (TypeExpr -> QName -> [(Int, TypeExpr)] -> Pattern)
-> (TypeExpr -> Literal -> Pattern) -> TPattern -> Pattern
forall b.
(TypeExpr -> QName -> [(Int, TypeExpr)] -> b)
-> (TypeExpr -> Literal -> b) -> TPattern -> b
trTPattern
(\_ name :: QName
name args :: [(Int, TypeExpr)]
args -> QName -> [Int] -> Pattern
Pattern QName
name ([Int] -> Pattern) -> [Int] -> Pattern
forall a b. (a -> b) -> a -> b
$ ((Int, TypeExpr) -> Int) -> [(Int, TypeExpr)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, TypeExpr) -> Int
forall a b. (a, b) -> a
fst [(Int, TypeExpr)]
args)
((Literal -> Pattern) -> TypeExpr -> Literal -> Pattern
forall a b. a -> b -> a
const Literal -> Pattern
LPattern)
genFlatInterface :: Prog -> Prog
genFlatInterface :: Prog -> Prog
genFlatInterface =
Update Prog [FuncDecl]
updProgFuncs Update Prog [FuncDecl] -> Update Prog [FuncDecl]
forall a b. (a -> b) -> a -> b
$ (FuncDecl -> FuncDecl) -> [FuncDecl] -> [FuncDecl]
forall a b. (a -> b) -> [a] -> [b]
map ((FuncDecl -> FuncDecl) -> [FuncDecl] -> [FuncDecl])
-> (FuncDecl -> FuncDecl) -> [FuncDecl] -> [FuncDecl]
forall a b. (a -> b) -> a -> b
$ Update FuncDecl Rule
updFuncRule Update FuncDecl Rule -> Update FuncDecl Rule
forall a b. (a -> b) -> a -> b
$ Rule -> Rule -> Rule
forall a b. a -> b -> a
const (Rule -> Rule -> Rule) -> Rule -> Rule -> Rule
forall a b. (a -> b) -> a -> b
$ [Int] -> Expr -> Rule
Rule [] (Expr -> Rule) -> Expr -> Rule
forall a b. (a -> b) -> a -> b
$ Int -> Expr
Var 0