{- |
    Module      : $Header$
    Description : Utility functions for working with TypedFlatCurry.
    Copyright   : (c) 2016 - 2017 Finn Teegen
                      2018        Kai-Oliver Prott
    License     : BSD-3-clause

    Maintainer  : fte@informatik.uni-kiel.de
    Stability   : experimental
    Portability : portable

    This library provides selector functions, test and update operations
    as well as some useful auxiliary functions for TypedFlatCurry data terms.
    Most of the provided functions are based on general transformation
    functions that replace constructors with user-defined
    functions. For recursive datatypes the transformations are defined
    inductively over the term structure. This is quite usual for
    transformations on TypedFlatCurry terms,
    so the provided functions can be used to implement specific transformations
    without having to explicitly state the recursion. Essentially, the tedious
    part of such transformations - descend in fairly complex term structures -
    is abstracted away, which hopefully makes the code more clear and brief.
-}

module Curry.FlatCurry.Typed.Goodies
  ( module Curry.FlatCurry.Typed.Goodies
  , module Curry.FlatCurry.Goodies
  ) where

import Curry.FlatCurry.Goodies ( Update
                               , trType, typeName, typeVisibility, typeParams
                               , typeConsDecls, typeSyn, isTypeSyn
                               , isDataTypeDecl, isExternalType, isPublicType
                               , updType, updTypeName, updTypeVisibility
                               , updTypeParams, updTypeConsDecls, updTypeSynonym
                               , updQNamesInType
                               , trCons, consName, consArity, consVisibility
                               , isPublicCons, consArgs, updCons, updConsName
                               , updConsArity, updConsVisibility, updConsArgs
                               , updQNamesInConsDecl
                               , trNewCons, newConsName, newConsVisibility
                               , isPublicNewCons, newConsArg
                               , updNewCons, updNewConsName
                               , updNewConsVisibility, updNewConsArg
                               , updQNamesInNewConsDecl
                               , tVarIndex, domain, range, tConsName, tConsArgs
                               , trTypeExpr, isTVar, isTCons, isFuncType
                               , updTVars, updTCons, updFuncTypes, argTypes
                               , typeArity, resultType, allVarsInTypeExpr
                               , allTypeCons, rnmAllVarsInTypeExpr
                               , updQNamesInTypeExpr
                               , trOp, opName, opFixity, opPrecedence, updOp
                               , updOpName, updOpFixity, updOpPrecedence
                               , trCombType, isCombTypeFuncCall
                               , isCombTypeFuncPartCall, isCombTypeConsCall
                               , isCombTypeConsPartCall
                               , isPublic
                               )

import Curry.FlatCurry.Typed.Type

-- TProg ----------------------------------------------------------------------

-- |transform program
trTProg :: (String -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> b)
        -> TProg -> b
trTProg :: (String -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> b)
-> TProg -> b
trTProg prog :: String -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> b
prog (TProg name :: String
name imps :: [String]
imps types :: [TypeDecl]
types funcs :: [TFuncDecl]
funcs ops :: [OpDecl]
ops) = String -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> b
prog String
name [String]
imps [TypeDecl]
types [TFuncDecl]
funcs [OpDecl]
ops

-- Selectors

-- |get name from program
tProgName :: TProg -> String
tProgName :: TProg -> String
tProgName = (String
 -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> String)
-> TProg -> String
forall b.
(String -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> b)
-> TProg -> b
trTProg (\name :: String
name _ _ _ _ -> String
name)

-- |get imports from program
tProgImports :: TProg -> [String]
tProgImports :: TProg -> [String]
tProgImports = (String
 -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> [String])
-> TProg -> [String]
forall b.
(String -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> b)
-> TProg -> b
trTProg (\_ imps :: [String]
imps _ _ _ -> [String]
imps)

-- |get type declarations from program
tProgTypes :: TProg -> [TypeDecl]
tProgTypes :: TProg -> [TypeDecl]
tProgTypes = (String
 -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> [TypeDecl])
-> TProg -> [TypeDecl]
forall b.
(String -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> b)
-> TProg -> b
trTProg (\_ _ types :: [TypeDecl]
types _ _ -> [TypeDecl]
types)

-- |get functions from program
tProgTFuncs :: TProg -> [TFuncDecl]
tProgTFuncs :: TProg -> [TFuncDecl]
tProgTFuncs = (String
 -> [String]
 -> [TypeDecl]
 -> [TFuncDecl]
 -> [OpDecl]
 -> [TFuncDecl])
-> TProg -> [TFuncDecl]
forall b.
(String -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> b)
-> TProg -> b
trTProg (\_ _ _ funcs :: [TFuncDecl]
funcs _ -> [TFuncDecl]
funcs)

-- |get infix operators from program
tProgOps :: TProg -> [OpDecl]
tProgOps :: TProg -> [OpDecl]
tProgOps = (String
 -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> [OpDecl])
-> TProg -> [OpDecl]
forall b.
(String -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> b)
-> TProg -> b
trTProg (\_ _ _ _ ops :: [OpDecl]
ops -> [OpDecl]
ops)

-- Update Operations

-- |update program
updTProg :: (String -> String) ->
            ([String] -> [String]) ->
            ([TypeDecl] -> [TypeDecl]) ->
            ([TFuncDecl] -> [TFuncDecl]) ->
            ([OpDecl] -> [OpDecl]) -> TProg -> TProg
updTProg :: (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([TFuncDecl] -> [TFuncDecl])
-> ([OpDecl] -> [OpDecl])
-> TProg
-> TProg
updTProg fn :: String -> String
fn fi :: [String] -> [String]
fi ft :: [TypeDecl] -> [TypeDecl]
ft ff :: [TFuncDecl] -> [TFuncDecl]
ff fo :: [OpDecl] -> [OpDecl]
fo = (String
 -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> TProg)
-> TProg -> TProg
forall b.
(String -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> b)
-> TProg -> b
trTProg String
-> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> TProg
prog
 where
  prog :: String
-> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> TProg
prog name :: String
name imps :: [String]
imps types :: [TypeDecl]
types funcs :: [TFuncDecl]
funcs ops :: [OpDecl]
ops
    = String
-> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> TProg
TProg (String -> String
fn String
name) ([String] -> [String]
fi [String]
imps) ([TypeDecl] -> [TypeDecl]
ft [TypeDecl]
types) ([TFuncDecl] -> [TFuncDecl]
ff [TFuncDecl]
funcs) ([OpDecl] -> [OpDecl]
fo [OpDecl]
ops)

-- |update name of program
updTProgName :: Update TProg String
updTProgName :: Update TProg String
updTProgName f :: String -> String
f = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([TFuncDecl] -> [TFuncDecl])
-> ([OpDecl] -> [OpDecl])
-> TProg
-> TProg
updTProg String -> String
f [String] -> [String]
forall a. a -> a
id [TypeDecl] -> [TypeDecl]
forall a. a -> a
id [TFuncDecl] -> [TFuncDecl]
forall a. a -> a
id [OpDecl] -> [OpDecl]
forall a. a -> a
id

-- |update imports of program
updTProgImports :: Update TProg [String]
updTProgImports :: Update TProg [String]
updTProgImports f :: [String] -> [String]
f = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([TFuncDecl] -> [TFuncDecl])
-> ([OpDecl] -> [OpDecl])
-> TProg
-> TProg
updTProg String -> String
forall a. a -> a
id [String] -> [String]
f [TypeDecl] -> [TypeDecl]
forall a. a -> a
id [TFuncDecl] -> [TFuncDecl]
forall a. a -> a
id [OpDecl] -> [OpDecl]
forall a. a -> a
id

-- |update type declarations of program
updTProgTypes :: Update TProg [TypeDecl]
updTProgTypes :: Update TProg [TypeDecl]
updTProgTypes f :: [TypeDecl] -> [TypeDecl]
f = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([TFuncDecl] -> [TFuncDecl])
-> ([OpDecl] -> [OpDecl])
-> TProg
-> TProg
updTProg String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id [TypeDecl] -> [TypeDecl]
f [TFuncDecl] -> [TFuncDecl]
forall a. a -> a
id [OpDecl] -> [OpDecl]
forall a. a -> a
id

-- |update functions of program
updTProgTFuncs :: Update TProg [TFuncDecl]
updTProgTFuncs :: Update TProg [TFuncDecl]
updTProgTFuncs f :: [TFuncDecl] -> [TFuncDecl]
f = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([TFuncDecl] -> [TFuncDecl])
-> ([OpDecl] -> [OpDecl])
-> TProg
-> TProg
updTProg String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id [TypeDecl] -> [TypeDecl]
forall a. a -> a
id [TFuncDecl] -> [TFuncDecl]
f [OpDecl] -> [OpDecl]
forall a. a -> a
id

-- |update infix operators of program
updTProgOps :: Update TProg [OpDecl]
updTProgOps :: ([OpDecl] -> [OpDecl]) -> TProg -> TProg
updTProgOps = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([TFuncDecl] -> [TFuncDecl])
-> ([OpDecl] -> [OpDecl])
-> TProg
-> TProg
updTProg String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id [TypeDecl] -> [TypeDecl]
forall a. a -> a
id [TFuncDecl] -> [TFuncDecl]
forall a. a -> a
id

-- Auxiliary Functions

-- |get all program variables (also from patterns)
allVarsInTProg :: TProg -> [(VarIndex, TypeExpr)]
allVarsInTProg :: TProg -> [(VarIndex, TypeExpr)]
allVarsInTProg = (TFuncDecl -> [(VarIndex, TypeExpr)])
-> [TFuncDecl] -> [(VarIndex, TypeExpr)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TFuncDecl -> [(VarIndex, TypeExpr)]
allVarsInTFunc ([TFuncDecl] -> [(VarIndex, TypeExpr)])
-> (TProg -> [TFuncDecl]) -> TProg -> [(VarIndex, TypeExpr)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TProg -> [TFuncDecl]
tProgTFuncs

-- |lift transformation on expressions to program
updTProgTExps :: Update TProg TExpr
updTProgTExps :: Update TProg TExpr
updTProgTExps = Update TProg [TFuncDecl]
updTProgTFuncs Update TProg [TFuncDecl]
-> ((TExpr -> TExpr) -> [TFuncDecl] -> [TFuncDecl])
-> Update TProg TExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TFuncDecl -> TFuncDecl) -> [TFuncDecl] -> [TFuncDecl]
forall a b. (a -> b) -> [a] -> [b]
map ((TFuncDecl -> TFuncDecl) -> [TFuncDecl] -> [TFuncDecl])
-> ((TExpr -> TExpr) -> TFuncDecl -> TFuncDecl)
-> (TExpr -> TExpr)
-> [TFuncDecl]
-> [TFuncDecl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TExpr -> TExpr) -> TFuncDecl -> TFuncDecl
updTFuncBody

-- |rename programs variables
rnmAllVarsInTProg :: Update TProg VarIndex
rnmAllVarsInTProg :: Update TProg VarIndex
rnmAllVarsInTProg = Update TProg [TFuncDecl]
updTProgTFuncs Update TProg [TFuncDecl]
-> ((VarIndex -> VarIndex) -> [TFuncDecl] -> [TFuncDecl])
-> Update TProg VarIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TFuncDecl -> TFuncDecl) -> [TFuncDecl] -> [TFuncDecl]
forall a b. (a -> b) -> [a] -> [b]
map ((TFuncDecl -> TFuncDecl) -> [TFuncDecl] -> [TFuncDecl])
-> ((VarIndex -> VarIndex) -> TFuncDecl -> TFuncDecl)
-> (VarIndex -> VarIndex)
-> [TFuncDecl]
-> [TFuncDecl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarIndex -> VarIndex) -> TFuncDecl -> TFuncDecl
rnmAllVarsInTFunc

-- |update all qualified names in program
updQNamesInTProg :: Update TProg QName
updQNamesInTProg :: Update TProg QName
updQNamesInTProg f :: QName -> QName
f = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([TFuncDecl] -> [TFuncDecl])
-> ([OpDecl] -> [OpDecl])
-> TProg
-> TProg
updTProg String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id
  ((TypeDecl -> TypeDecl) -> [TypeDecl] -> [TypeDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Update TypeDecl QName
updQNamesInType QName -> QName
f)) ((TFuncDecl -> TFuncDecl) -> [TFuncDecl] -> [TFuncDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Update TFuncDecl QName
updQNamesInTFunc QName -> QName
f)) ((OpDecl -> OpDecl) -> [OpDecl] -> [OpDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Update OpDecl QName
updOpName QName -> QName
f))

-- |rename program (update name of and all qualified names in program)
rnmTProg :: String -> TProg -> TProg
rnmTProg :: String -> TProg -> TProg
rnmTProg name :: String
name p :: TProg
p = Update TProg String
updTProgName (String -> String -> String
forall a b. a -> b -> a
const String
name) (Update TProg QName
updQNamesInTProg QName -> QName
forall b. (String, b) -> (String, b)
rnm TProg
p)
 where
  rnm :: (String, b) -> (String, b)
rnm (m :: String
m, n :: b
n) | String
m String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== TProg -> String
tProgName TProg
p = (String
name, b
n)
             | Bool
otherwise = (String
m, b
n)

-- TFuncDecl ------------------------------------------------------------------

-- |transform function
trTFunc :: (QName -> Int -> Visibility -> TypeExpr -> TRule -> b) -> TFuncDecl -> b
trTFunc :: (QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> b)
-> TFuncDecl -> b
trTFunc func :: QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> b
func (TFunc name :: QName
name arity :: VarIndex
arity vis :: Visibility
vis t :: TypeExpr
t rule :: TRule
rule) = QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> b
func QName
name VarIndex
arity Visibility
vis TypeExpr
t TRule
rule

-- Selectors

-- |get name of function
tFuncName :: TFuncDecl -> QName
tFuncName :: TFuncDecl -> QName
tFuncName = (QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> QName)
-> TFuncDecl -> QName
forall b.
(QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> b)
-> TFuncDecl -> b
trTFunc (\name :: QName
name _ _ _ _ -> QName
name)

-- |get arity of function
tFuncArity :: TFuncDecl -> Int
tFuncArity :: TFuncDecl -> VarIndex
tFuncArity = (QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> VarIndex)
-> TFuncDecl -> VarIndex
forall b.
(QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> b)
-> TFuncDecl -> b
trTFunc (\_ arity :: VarIndex
arity _ _ _ -> VarIndex
arity)

-- |get visibility of function
tFuncVisibility :: TFuncDecl -> Visibility
tFuncVisibility :: TFuncDecl -> Visibility
tFuncVisibility = (QName
 -> VarIndex -> Visibility -> TypeExpr -> TRule -> Visibility)
-> TFuncDecl -> Visibility
forall b.
(QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> b)
-> TFuncDecl -> b
trTFunc (\_ _ vis :: Visibility
vis _ _ -> Visibility
vis)

-- |get type of function
tFuncType :: TFuncDecl -> TypeExpr
tFuncType :: TFuncDecl -> TypeExpr
tFuncType = (QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> TypeExpr)
-> TFuncDecl -> TypeExpr
forall b.
(QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> b)
-> TFuncDecl -> b
trTFunc (\_ _ _ t :: TypeExpr
t _ -> TypeExpr
t)

-- |get rule of function
tFuncTRule :: TFuncDecl -> TRule
tFuncTRule :: TFuncDecl -> TRule
tFuncTRule = (QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> TRule)
-> TFuncDecl -> TRule
forall b.
(QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> b)
-> TFuncDecl -> b
trTFunc (\_ _ _ _ rule :: TRule
rule -> TRule
rule)

-- Update Operations

-- |update function
updTFunc :: (QName -> QName) ->
            (Int -> Int) ->
            (Visibility -> Visibility) ->
            (TypeExpr -> TypeExpr) ->
            (TRule -> TRule) -> TFuncDecl -> TFuncDecl
updTFunc :: (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (TRule -> TRule)
-> TFuncDecl
-> TFuncDecl
updTFunc fn :: QName -> QName
fn fa :: VarIndex -> VarIndex
fa fv :: Visibility -> Visibility
fv ft :: TypeExpr -> TypeExpr
ft fr :: TRule -> TRule
fr = (QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> TFuncDecl)
-> TFuncDecl -> TFuncDecl
forall b.
(QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> b)
-> TFuncDecl -> b
trTFunc QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> TFuncDecl
func
 where
  func :: QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> TFuncDecl
func name :: QName
name arity :: VarIndex
arity vis :: Visibility
vis t :: TypeExpr
t rule :: TRule
rule
    = QName -> VarIndex -> Visibility -> TypeExpr -> TRule -> TFuncDecl
TFunc (QName -> QName
fn QName
name) (VarIndex -> VarIndex
fa VarIndex
arity) (Visibility -> Visibility
fv Visibility
vis) (TypeExpr -> TypeExpr
ft TypeExpr
t) (TRule -> TRule
fr TRule
rule)

-- |update name of function
updTFuncName :: Update TFuncDecl QName
updTFuncName :: Update TFuncDecl QName
updTFuncName f :: QName -> QName
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (TRule -> TRule)
-> TFuncDecl
-> TFuncDecl
updTFunc QName -> QName
f VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
forall a. a -> a
id TypeExpr -> TypeExpr
forall a. a -> a
id TRule -> TRule
forall a. a -> a
id

-- |update arity of function
updTFuncArity :: Update TFuncDecl Int
updTFuncArity :: (VarIndex -> VarIndex) -> TFuncDecl -> TFuncDecl
updTFuncArity f :: VarIndex -> VarIndex
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (TRule -> TRule)
-> TFuncDecl
-> TFuncDecl
updTFunc QName -> QName
forall a. a -> a
id VarIndex -> VarIndex
f Visibility -> Visibility
forall a. a -> a
id TypeExpr -> TypeExpr
forall a. a -> a
id TRule -> TRule
forall a. a -> a
id

-- |update visibility of function
updTFuncVisibility :: Update TFuncDecl Visibility
updTFuncVisibility :: Update TFuncDecl Visibility
updTFuncVisibility f :: Visibility -> Visibility
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (TRule -> TRule)
-> TFuncDecl
-> TFuncDecl
updTFunc QName -> QName
forall a. a -> a
id VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
f TypeExpr -> TypeExpr
forall a. a -> a
id TRule -> TRule
forall a. a -> a
id

-- |update type of function
updFuncType :: Update TFuncDecl TypeExpr
updFuncType :: Update TFuncDecl TypeExpr
updFuncType f :: TypeExpr -> TypeExpr
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (TRule -> TRule)
-> TFuncDecl
-> TFuncDecl
updTFunc QName -> QName
forall a. a -> a
id VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
forall a. a -> a
id TypeExpr -> TypeExpr
f TRule -> TRule
forall a. a -> a
id

-- |update rule of function
updTFuncTRule :: Update TFuncDecl TRule
updTFuncTRule :: (TRule -> TRule) -> TFuncDecl -> TFuncDecl
updTFuncTRule = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (TRule -> TRule)
-> TFuncDecl
-> TFuncDecl
updTFunc QName -> QName
forall a. a -> a
id VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
forall a. a -> a
id TypeExpr -> TypeExpr
forall a. a -> a
id

-- Auxiliary Functions

-- |is function public?
isPublicTFunc :: TFuncDecl -> Bool
isPublicTFunc :: TFuncDecl -> Bool
isPublicTFunc = Visibility -> Bool
isPublic (Visibility -> Bool)
-> (TFuncDecl -> Visibility) -> TFuncDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TFuncDecl -> Visibility
tFuncVisibility

-- |is function externally defined?
isExternal :: TFuncDecl -> Bool
isExternal :: TFuncDecl -> Bool
isExternal = TRule -> Bool
isTRuleExternal (TRule -> Bool) -> (TFuncDecl -> TRule) -> TFuncDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TFuncDecl -> TRule
tFuncTRule

-- |get variable names in a function declaration
allVarsInTFunc :: TFuncDecl -> [(VarIndex, TypeExpr)]
allVarsInTFunc :: TFuncDecl -> [(VarIndex, TypeExpr)]
allVarsInTFunc = TRule -> [(VarIndex, TypeExpr)]
allVarsInTRule (TRule -> [(VarIndex, TypeExpr)])
-> (TFuncDecl -> TRule) -> TFuncDecl -> [(VarIndex, TypeExpr)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TFuncDecl -> TRule
tFuncTRule

-- |get arguments of function, if not externally defined
tFuncArgs :: TFuncDecl -> [(VarIndex, TypeExpr)]
tFuncArgs :: TFuncDecl -> [(VarIndex, TypeExpr)]
tFuncArgs = TRule -> [(VarIndex, TypeExpr)]
tRuleArgs (TRule -> [(VarIndex, TypeExpr)])
-> (TFuncDecl -> TRule) -> TFuncDecl -> [(VarIndex, TypeExpr)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TFuncDecl -> TRule
tFuncTRule

-- |get body of function, if not externally defined
tFuncBody :: TFuncDecl -> TExpr
tFuncBody :: TFuncDecl -> TExpr
tFuncBody = TRule -> TExpr
tRuleBody (TRule -> TExpr) -> (TFuncDecl -> TRule) -> TFuncDecl -> TExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TFuncDecl -> TRule
tFuncTRule

-- |get the right-hand-sides of a 'FuncDecl'
tFuncRHS :: TFuncDecl -> [TExpr]
tFuncRHS :: TFuncDecl -> [TExpr]
tFuncRHS f :: TFuncDecl
f | Bool -> Bool
not (TFuncDecl -> Bool
isExternal TFuncDecl
f) = TExpr -> [TExpr]
orCase (TFuncDecl -> TExpr
tFuncBody TFuncDecl
f)
           | Bool
otherwise = []
 where
  orCase :: TExpr -> [TExpr]
orCase e :: TExpr
e
    | TExpr -> Bool
isTOr TExpr
e = (TExpr -> [TExpr]) -> [TExpr] -> [TExpr]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TExpr -> [TExpr]
orCase (TExpr -> [TExpr]
orExps TExpr
e)
    | TExpr -> Bool
isTCase TExpr
e = (TBranchExpr -> [TExpr]) -> [TBranchExpr] -> [TExpr]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (TExpr -> [TExpr]
orCase (TExpr -> [TExpr])
-> (TBranchExpr -> TExpr) -> TBranchExpr -> [TExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TBranchExpr -> TExpr
tBranchTExpr) (TExpr -> [TBranchExpr]
caseBranches TExpr
e)
    | Bool
otherwise = [TExpr
e]

-- |rename all variables in function
rnmAllVarsInTFunc :: Update TFuncDecl VarIndex
rnmAllVarsInTFunc :: (VarIndex -> VarIndex) -> TFuncDecl -> TFuncDecl
rnmAllVarsInTFunc = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (TRule -> TRule)
-> TFuncDecl
-> TFuncDecl
updTFunc QName -> QName
forall a. a -> a
id VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
forall a. a -> a
id TypeExpr -> TypeExpr
forall a. a -> a
id ((TRule -> TRule) -> TFuncDecl -> TFuncDecl)
-> ((VarIndex -> VarIndex) -> TRule -> TRule)
-> (VarIndex -> VarIndex)
-> TFuncDecl
-> TFuncDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarIndex -> VarIndex) -> TRule -> TRule
rnmAllVarsInTRule

-- |update all qualified names in function
updQNamesInTFunc :: Update TFuncDecl QName
updQNamesInTFunc :: Update TFuncDecl QName
updQNamesInTFunc f :: QName -> QName
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (TRule -> TRule)
-> TFuncDecl
-> TFuncDecl
updTFunc QName -> QName
f VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
forall a. a -> a
id ((QName -> QName) -> TypeExpr -> TypeExpr
updQNamesInTypeExpr QName -> QName
f) (Update TRule QName
updQNamesInTRule QName -> QName
f)

-- |update arguments of function, if not externally defined
updTFuncArgs :: Update TFuncDecl [(VarIndex, TypeExpr)]
updTFuncArgs :: Update TFuncDecl [(VarIndex, TypeExpr)]
updTFuncArgs = (TRule -> TRule) -> TFuncDecl -> TFuncDecl
updTFuncTRule ((TRule -> TRule) -> TFuncDecl -> TFuncDecl)
-> (([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
    -> TRule -> TRule)
-> Update TFuncDecl [(VarIndex, TypeExpr)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> TRule -> TRule
updTRuleArgs

-- |update body of function, if not externally defined
updTFuncBody :: Update TFuncDecl TExpr
updTFuncBody :: (TExpr -> TExpr) -> TFuncDecl -> TFuncDecl
updTFuncBody = (TRule -> TRule) -> TFuncDecl -> TFuncDecl
updTFuncTRule ((TRule -> TRule) -> TFuncDecl -> TFuncDecl)
-> ((TExpr -> TExpr) -> TRule -> TRule)
-> (TExpr -> TExpr)
-> TFuncDecl
-> TFuncDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TExpr -> TExpr) -> TRule -> TRule
updTRuleBody

-- TRule ----------------------------------------------------------------------

-- |transform rule
trTRule :: ([(VarIndex, TypeExpr)] -> TExpr -> b) -> (TypeExpr -> String -> b) -> TRule -> b
trTRule :: ([(VarIndex, TypeExpr)] -> TExpr -> b)
-> (TypeExpr -> String -> b) -> TRule -> b
trTRule rule :: [(VarIndex, TypeExpr)] -> TExpr -> b
rule _ (TRule args :: [(VarIndex, TypeExpr)]
args e :: TExpr
e) = [(VarIndex, TypeExpr)] -> TExpr -> b
rule [(VarIndex, TypeExpr)]
args TExpr
e
trTRule _ ext :: TypeExpr -> String -> b
ext (TExternal ty :: TypeExpr
ty s :: String
s) = TypeExpr -> String -> b
ext TypeExpr
ty String
s

-- Selectors

-- |get rules arguments if it's not external
tRuleArgs :: TRule -> [(VarIndex, TypeExpr)]
tRuleArgs :: TRule -> [(VarIndex, TypeExpr)]
tRuleArgs = ([(VarIndex, TypeExpr)] -> TExpr -> [(VarIndex, TypeExpr)])
-> (TypeExpr -> String -> [(VarIndex, TypeExpr)])
-> TRule
-> [(VarIndex, TypeExpr)]
forall b.
([(VarIndex, TypeExpr)] -> TExpr -> b)
-> (TypeExpr -> String -> b) -> TRule -> b
trTRule [(VarIndex, TypeExpr)] -> TExpr -> [(VarIndex, TypeExpr)]
forall a b. a -> b -> a
const TypeExpr -> String -> [(VarIndex, TypeExpr)]
forall a. HasCallStack => a
undefined

-- |get rules body if it's not external
tRuleBody :: TRule -> TExpr
tRuleBody :: TRule -> TExpr
tRuleBody = ([(VarIndex, TypeExpr)] -> TExpr -> TExpr)
-> (TypeExpr -> String -> TExpr) -> TRule -> TExpr
forall b.
([(VarIndex, TypeExpr)] -> TExpr -> b)
-> (TypeExpr -> String -> b) -> TRule -> b
trTRule (\_ e :: TExpr
e -> TExpr
e) TypeExpr -> String -> TExpr
forall a. HasCallStack => a
undefined

-- |get rules external declaration
tRuleExtDecl :: TRule -> String
tRuleExtDecl :: TRule -> String
tRuleExtDecl = ([(VarIndex, TypeExpr)] -> TExpr -> String)
-> (TypeExpr -> String -> String) -> TRule -> String
forall b.
([(VarIndex, TypeExpr)] -> TExpr -> b)
-> (TypeExpr -> String -> b) -> TRule -> b
trTRule [(VarIndex, TypeExpr)] -> TExpr -> String
forall a. HasCallStack => a
undefined (\_ s :: String
s -> String
s)

-- Test Operations

-- |is rule external?
isTRuleExternal :: TRule -> Bool
isTRuleExternal :: TRule -> Bool
isTRuleExternal = ([(VarIndex, TypeExpr)] -> TExpr -> Bool)
-> (TypeExpr -> String -> Bool) -> TRule -> Bool
forall b.
([(VarIndex, TypeExpr)] -> TExpr -> b)
-> (TypeExpr -> String -> b) -> TRule -> b
trTRule (\_ _ -> Bool
False) (\_ _ -> Bool
True)

-- Update Operations

-- |update rule
updTRule :: (TypeExpr -> TypeExpr) ->
            ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]) ->
            (TExpr -> TExpr) ->
            (String -> String) -> TRule -> TRule
updTRule :: (TypeExpr -> TypeExpr)
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> (TExpr -> TExpr)
-> (String -> String)
-> TRule
-> TRule
updTRule fannot :: TypeExpr -> TypeExpr
fannot fa :: [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
fa fe :: TExpr -> TExpr
fe fs :: String -> String
fs = ([(VarIndex, TypeExpr)] -> TExpr -> TRule)
-> (TypeExpr -> String -> TRule) -> TRule -> TRule
forall b.
([(VarIndex, TypeExpr)] -> TExpr -> b)
-> (TypeExpr -> String -> b) -> TRule -> b
trTRule [(VarIndex, TypeExpr)] -> TExpr -> TRule
rule TypeExpr -> String -> TRule
ext
 where
  rule :: [(VarIndex, TypeExpr)] -> TExpr -> TRule
rule args :: [(VarIndex, TypeExpr)]
args e :: TExpr
e = [(VarIndex, TypeExpr)] -> TExpr -> TRule
TRule ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
fa [(VarIndex, TypeExpr)]
args) (TExpr -> TExpr
fe TExpr
e)
  ext :: TypeExpr -> String -> TRule
ext ty :: TypeExpr
ty s :: String
s = TypeExpr -> String -> TRule
TExternal (TypeExpr -> TypeExpr
fannot TypeExpr
ty) (String -> String
fs String
s)

-- |update rules TypeExpr
updTRuleType :: Update TRule TypeExpr
updTRuleType :: Update TRule TypeExpr
updTRuleType f :: TypeExpr -> TypeExpr
f = (TypeExpr -> TypeExpr)
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> (TExpr -> TExpr)
-> (String -> String)
-> TRule
-> TRule
updTRule TypeExpr -> TypeExpr
f [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
forall a. a -> a
id TExpr -> TExpr
forall a. a -> a
id String -> String
forall a. a -> a
id

-- |update rules arguments
updTRuleArgs :: Update TRule [(VarIndex, TypeExpr)]
updTRuleArgs :: ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> TRule -> TRule
updTRuleArgs f :: [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
f = (TypeExpr -> TypeExpr)
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> (TExpr -> TExpr)
-> (String -> String)
-> TRule
-> TRule
updTRule TypeExpr -> TypeExpr
forall a. a -> a
id [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
f TExpr -> TExpr
forall a. a -> a
id String -> String
forall a. a -> a
id

-- |update rules body
updTRuleBody :: Update TRule TExpr
updTRuleBody :: (TExpr -> TExpr) -> TRule -> TRule
updTRuleBody f :: TExpr -> TExpr
f = (TypeExpr -> TypeExpr)
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> (TExpr -> TExpr)
-> (String -> String)
-> TRule
-> TRule
updTRule TypeExpr -> TypeExpr
forall a. a -> a
id [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
forall a. a -> a
id TExpr -> TExpr
f String -> String
forall a. a -> a
id

-- |update rules external declaration
updTRuleExtDecl :: Update TRule String
updTRuleExtDecl :: (String -> String) -> TRule -> TRule
updTRuleExtDecl = (TypeExpr -> TypeExpr)
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> (TExpr -> TExpr)
-> (String -> String)
-> TRule
-> TRule
updTRule TypeExpr -> TypeExpr
forall a. a -> a
id [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
forall a. a -> a
id TExpr -> TExpr
forall a. a -> a
id

-- Auxiliary Functions

-- |get variable names in a functions rule
allVarsInTRule :: TRule -> [(VarIndex, TypeExpr)]
allVarsInTRule :: TRule -> [(VarIndex, TypeExpr)]
allVarsInTRule = ([(VarIndex, TypeExpr)] -> TExpr -> [(VarIndex, TypeExpr)])
-> (TypeExpr -> String -> [(VarIndex, TypeExpr)])
-> TRule
-> [(VarIndex, TypeExpr)]
forall b.
([(VarIndex, TypeExpr)] -> TExpr -> b)
-> (TypeExpr -> String -> b) -> TRule -> b
trTRule (\args :: [(VarIndex, TypeExpr)]
args body :: TExpr
body -> [(VarIndex, TypeExpr)]
args [(VarIndex, TypeExpr)]
-> [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
forall a. [a] -> [a] -> [a]
++ TExpr -> [(VarIndex, TypeExpr)]
allVars TExpr
body) (\_ _ -> [])

-- |rename all variables in rule
rnmAllVarsInTRule :: Update TRule VarIndex
rnmAllVarsInTRule :: (VarIndex -> VarIndex) -> TRule -> TRule
rnmAllVarsInTRule f :: VarIndex -> VarIndex
f = (TypeExpr -> TypeExpr)
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> (TExpr -> TExpr)
-> (String -> String)
-> TRule
-> TRule
updTRule TypeExpr -> TypeExpr
forall a. a -> a
id (((VarIndex, TypeExpr) -> (VarIndex, TypeExpr))
-> [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: VarIndex
a, b :: TypeExpr
b) -> (VarIndex -> VarIndex
f VarIndex
a, TypeExpr
b))) (Update TExpr VarIndex
rnmAllVars VarIndex -> VarIndex
f) String -> String
forall a. a -> a
id

-- |update all qualified names in rule
updQNamesInTRule :: Update TRule QName
updQNamesInTRule :: Update TRule QName
updQNamesInTRule = (TExpr -> TExpr) -> TRule -> TRule
updTRuleBody ((TExpr -> TExpr) -> TRule -> TRule)
-> ((QName -> QName) -> TExpr -> TExpr) -> Update TRule QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> QName) -> TExpr -> TExpr
updQNames

-- TExpr ----------------------------------------------------------------------

-- Selectors

-- |get internal number of variable
varNr :: TExpr -> VarIndex
varNr :: TExpr -> VarIndex
varNr (TVarE _ n :: VarIndex
n) = VarIndex
n
varNr _           = String -> VarIndex
forall a. HasCallStack => String -> a
error "Curry.FlatCurry.Typed.Goodies.varNr: no variable"

-- |get literal if expression is literal expression
literal :: TExpr -> Literal
literal :: TExpr -> Literal
literal (TLit _ l :: Literal
l) = Literal
l
literal _          = String -> Literal
forall a. HasCallStack => String -> a
error "Curry.FlatCurry.Typed.Goodies.literal: no literal"

-- |get combination type of a combined expression
combType :: TExpr -> CombType
combType :: TExpr -> CombType
combType (TComb _ ct :: CombType
ct _ _) = CombType
ct
combType _                = String -> CombType
forall a. HasCallStack => String -> a
error (String -> CombType) -> String -> CombType
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Typed.Goodies.combType: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                    "no combined expression"

-- |get name of a combined expression
combName :: TExpr -> QName
combName :: TExpr -> QName
combName (TComb _ _ name :: QName
name _) = QName
name
combName _                  = String -> QName
forall a. HasCallStack => String -> a
error (String -> QName) -> String -> QName
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Typed.Goodies.combName: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                      "no combined expression"

-- |get arguments of a combined expression
combArgs :: TExpr -> [TExpr]
combArgs :: TExpr -> [TExpr]
combArgs (TComb _ _ _ args :: [TExpr]
args) = [TExpr]
args
combArgs _                  = String -> [TExpr]
forall a. HasCallStack => String -> a
error (String -> [TExpr]) -> String -> [TExpr]
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Typed.Goodies.combArgs: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                      "no combined expression"

-- |get number of missing arguments if expression is combined
missingCombArgs :: TExpr -> Int
missingCombArgs :: TExpr -> VarIndex
missingCombArgs = CombType -> VarIndex
missingArgs (CombType -> VarIndex) -> (TExpr -> CombType) -> TExpr -> VarIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TExpr -> CombType
combType
  where
  missingArgs :: CombType -> Int
  missingArgs :: CombType -> VarIndex
missingArgs = VarIndex
-> (VarIndex -> VarIndex)
-> VarIndex
-> (VarIndex -> VarIndex)
-> CombType
-> VarIndex
forall a.
a -> (VarIndex -> a) -> a -> (VarIndex -> a) -> CombType -> a
trCombType 0 VarIndex -> VarIndex
forall a. a -> a
id 0 VarIndex -> VarIndex
forall a. a -> a
id

-- |get indices of variables in let declaration
letBinds :: TExpr -> [((VarIndex, TypeExpr), TExpr)]
letBinds :: TExpr -> [((VarIndex, TypeExpr), TExpr)]
letBinds (TLet vs :: [((VarIndex, TypeExpr), TExpr)]
vs _) = [((VarIndex, TypeExpr), TExpr)]
vs
letBinds _           = String -> [((VarIndex, TypeExpr), TExpr)]
forall a. HasCallStack => String -> a
error (String -> [((VarIndex, TypeExpr), TExpr)])
-> String -> [((VarIndex, TypeExpr), TExpr)]
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Typed.Goodies.letBinds: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                               "no let expression"

-- |get body of let declaration
letBody :: TExpr -> TExpr
letBody :: TExpr -> TExpr
letBody (TLet _ e :: TExpr
e) = TExpr
e
letBody _          = String -> TExpr
forall a. HasCallStack => String -> a
error (String -> TExpr) -> String -> TExpr
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Typed.Goodies.letBody: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                             "no let expression"

-- |get variable indices from declaration of free variables
freeVars :: TExpr -> [(VarIndex, TypeExpr)]
freeVars :: TExpr -> [(VarIndex, TypeExpr)]
freeVars (TFree vs :: [(VarIndex, TypeExpr)]
vs _) = [(VarIndex, TypeExpr)]
vs
freeVars _            = String -> [(VarIndex, TypeExpr)]
forall a. HasCallStack => String -> a
error (String -> [(VarIndex, TypeExpr)])
-> String -> [(VarIndex, TypeExpr)]
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Typed.Goodies.freeVars: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                "no declaration of free variables"

-- |get expression from declaration of free variables
freeExpr :: TExpr -> TExpr
freeExpr :: TExpr -> TExpr
freeExpr (TFree _ e :: TExpr
e) = TExpr
e
freeExpr _           = String -> TExpr
forall a. HasCallStack => String -> a
error (String -> TExpr) -> String -> TExpr
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Typed.Goodies.freeExpr: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                               "no declaration of free variables"

-- |get expressions from or-expression
orExps :: TExpr -> [TExpr]
orExps :: TExpr -> [TExpr]
orExps (TOr e1 :: TExpr
e1 e2 :: TExpr
e2) = [TExpr
e1, TExpr
e2]
orExps _           = String -> [TExpr]
forall a. HasCallStack => String -> a
error (String -> [TExpr]) -> String -> [TExpr]
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Typed.Goodies.orExps: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                             "no or expression"

-- |get case-type of case expression
caseType :: TExpr -> CaseType
caseType :: TExpr -> CaseType
caseType (TCase ct :: CaseType
ct _ _) = CaseType
ct
caseType _              = String -> CaseType
forall a. HasCallStack => String -> a
error (String -> CaseType) -> String -> CaseType
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Typed.Goodies.caseType: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                  "no case expression"

-- |get scrutinee of case expression
caseExpr :: TExpr -> TExpr
caseExpr :: TExpr -> TExpr
caseExpr (TCase _ e :: TExpr
e _) = TExpr
e
caseExpr _             = String -> TExpr
forall a. HasCallStack => String -> a
error (String -> TExpr) -> String -> TExpr
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Typed.Goodies.caseExpr: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                   "no case expression"


-- |get branch expressions from case expression
caseBranches :: TExpr -> [TBranchExpr]
caseBranches :: TExpr -> [TBranchExpr]
caseBranches (TCase _ _ bs :: [TBranchExpr]
bs) = [TBranchExpr]
bs
caseBranches _              = String -> [TBranchExpr]
forall a. HasCallStack => String -> a
error "Curry.FlatCurry.Typed.Goodies.caseBranches: no case expression"

-- Test Operations

-- |is expression a variable?
isTVarE :: TExpr -> Bool
isTVarE :: TExpr -> Bool
isTVarE e :: TExpr
e = case TExpr
e of
  TVarE _ _ -> Bool
True
  _ -> Bool
False

-- |is expression a literal expression?
isTLit :: TExpr -> Bool
isTLit :: TExpr -> Bool
isTLit e :: TExpr
e = case TExpr
e of
  TLit _ _ -> Bool
True
  _ -> Bool
False

-- |is expression combined?
isTComb :: TExpr -> Bool
isTComb :: TExpr -> Bool
isTComb e :: TExpr
e = case TExpr
e of
  TComb _ _ _ _ -> Bool
True
  _ -> Bool
False

-- |is expression a let expression?
isTLet :: TExpr -> Bool
isTLet :: TExpr -> Bool
isTLet e :: TExpr
e = case TExpr
e of
  TLet _ _ -> Bool
True
  _ -> Bool
False

-- |is expression a declaration of free variables?
isTFree :: TExpr -> Bool
isTFree :: TExpr -> Bool
isTFree e :: TExpr
e = case TExpr
e of
  TFree _ _ -> Bool
True
  _ -> Bool
False

-- |is expression an or-expression?
isTOr :: TExpr -> Bool
isTOr :: TExpr -> Bool
isTOr e :: TExpr
e = case TExpr
e of
  TOr _ _ -> Bool
True
  _ -> Bool
False

-- |is expression a case expression?
isTCase :: TExpr -> Bool
isTCase :: TExpr -> Bool
isTCase e :: TExpr
e = case TExpr
e of
  TCase _ _ _ -> Bool
True
  _ -> Bool
False

-- |transform expression
trTExpr  :: (TypeExpr -> VarIndex -> b)
         -> (TypeExpr -> Literal -> b)
         -> (TypeExpr -> CombType -> QName -> [b] -> b)
         -> ([((VarIndex, TypeExpr), b)] -> b -> b)
         -> ([(VarIndex, TypeExpr)] -> b -> b)
         -> (b -> b -> b)
         -> (CaseType -> b -> [c] -> b)
         -> (TPattern -> b -> c)
         -> (b -> TypeExpr -> b)
         -> TExpr
         -> b
trTExpr :: (TypeExpr -> VarIndex -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((VarIndex, TypeExpr), b)] -> b -> b)
-> ([(VarIndex, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
trTExpr var :: TypeExpr -> VarIndex -> b
var lit :: TypeExpr -> Literal -> b
lit comb :: TypeExpr -> CombType -> QName -> [b] -> b
comb lt :: [((VarIndex, TypeExpr), b)] -> b -> b
lt fr :: [(VarIndex, TypeExpr)] -> b -> b
fr oR :: b -> b -> b
oR cas :: CaseType -> b -> [c] -> b
cas branch :: TPattern -> b -> c
branch typed :: b -> TypeExpr -> b
typed expr :: TExpr
expr = case TExpr
expr of
  TVarE ty :: TypeExpr
ty n :: VarIndex
n            -> TypeExpr -> VarIndex -> b
var TypeExpr
ty VarIndex
n
  TLit ty :: TypeExpr
ty l :: Literal
l             -> TypeExpr -> Literal -> b
lit TypeExpr
ty Literal
l
  TComb ty :: TypeExpr
ty ct :: CombType
ct name :: QName
name args :: [TExpr]
args -> TypeExpr -> CombType -> QName -> [b] -> b
comb TypeExpr
ty CombType
ct QName
name ((TExpr -> b) -> [TExpr] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map TExpr -> b
f [TExpr]
args)
  TLet bs :: [((VarIndex, TypeExpr), TExpr)]
bs e :: TExpr
e             -> [((VarIndex, TypeExpr), b)] -> b -> b
lt ((((VarIndex, TypeExpr), TExpr) -> ((VarIndex, TypeExpr), b))
-> [((VarIndex, TypeExpr), TExpr)] -> [((VarIndex, TypeExpr), b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(v :: (VarIndex, TypeExpr)
v, x :: TExpr
x) -> ((VarIndex, TypeExpr)
v, TExpr -> b
f TExpr
x)) [((VarIndex, TypeExpr), TExpr)]
bs) (TExpr -> b
f TExpr
e)
  TFree vs :: [(VarIndex, TypeExpr)]
vs e :: TExpr
e            -> [(VarIndex, TypeExpr)] -> b -> b
fr [(VarIndex, TypeExpr)]
vs (TExpr -> b
f TExpr
e)
  TOr e1 :: TExpr
e1 e2 :: TExpr
e2             -> b -> b -> b
oR (TExpr -> b
f TExpr
e1) (TExpr -> b
f TExpr
e2)
  TCase ct :: CaseType
ct e :: TExpr
e bs :: [TBranchExpr]
bs         -> CaseType -> b -> [c] -> b
cas CaseType
ct (TExpr -> b
f TExpr
e) ((TBranchExpr -> c) -> [TBranchExpr] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map (\ (TBranch p :: TPattern
p e' :: TExpr
e') -> TPattern -> b -> c
branch TPattern
p (TExpr -> b
f TExpr
e')) [TBranchExpr]
bs)
  TTyped e :: TExpr
e ty :: TypeExpr
ty           -> b -> TypeExpr -> b
typed (TExpr -> b
f TExpr
e) TypeExpr
ty
  where
  f :: TExpr -> b
f = (TypeExpr -> VarIndex -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((VarIndex, TypeExpr), b)] -> b -> b)
-> ([(VarIndex, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
forall b c.
(TypeExpr -> VarIndex -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((VarIndex, TypeExpr), b)] -> b -> b)
-> ([(VarIndex, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
trTExpr TypeExpr -> VarIndex -> b
var TypeExpr -> Literal -> b
lit TypeExpr -> CombType -> QName -> [b] -> b
comb [((VarIndex, TypeExpr), b)] -> b -> b
lt [(VarIndex, TypeExpr)] -> b -> b
fr b -> b -> b
oR CaseType -> b -> [c] -> b
cas TPattern -> b -> c
branch b -> TypeExpr -> b
typed

-- |update all variables in given expression
updVars :: (TypeExpr -> VarIndex -> TExpr) -> TExpr -> TExpr
updVars :: (TypeExpr -> VarIndex -> TExpr) -> TExpr -> TExpr
updVars var :: TypeExpr -> VarIndex -> TExpr
var = (TypeExpr -> VarIndex -> TExpr)
-> (TypeExpr -> Literal -> TExpr)
-> (TypeExpr -> CombType -> QName -> [TExpr] -> TExpr)
-> ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr)
-> ([(VarIndex, TypeExpr)] -> TExpr -> TExpr)
-> (TExpr -> TExpr -> TExpr)
-> (CaseType -> TExpr -> [TBranchExpr] -> TExpr)
-> (TPattern -> TExpr -> TBranchExpr)
-> (TExpr -> TypeExpr -> TExpr)
-> TExpr
-> TExpr
forall b c.
(TypeExpr -> VarIndex -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((VarIndex, TypeExpr), b)] -> b -> b)
-> ([(VarIndex, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
trTExpr TypeExpr -> VarIndex -> TExpr
var TypeExpr -> Literal -> TExpr
TLit TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
TComb [((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr
TLet [(VarIndex, TypeExpr)] -> TExpr -> TExpr
TFree TExpr -> TExpr -> TExpr
TOr CaseType -> TExpr -> [TBranchExpr] -> TExpr
TCase TPattern -> TExpr -> TBranchExpr
TBranch TExpr -> TypeExpr -> TExpr
TTyped

-- |update all literals in given expression
updLiterals :: (TypeExpr -> Literal -> TExpr) -> TExpr -> TExpr
updLiterals :: (TypeExpr -> Literal -> TExpr) -> TExpr -> TExpr
updLiterals lit :: TypeExpr -> Literal -> TExpr
lit = (TypeExpr -> VarIndex -> TExpr)
-> (TypeExpr -> Literal -> TExpr)
-> (TypeExpr -> CombType -> QName -> [TExpr] -> TExpr)
-> ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr)
-> ([(VarIndex, TypeExpr)] -> TExpr -> TExpr)
-> (TExpr -> TExpr -> TExpr)
-> (CaseType -> TExpr -> [TBranchExpr] -> TExpr)
-> (TPattern -> TExpr -> TBranchExpr)
-> (TExpr -> TypeExpr -> TExpr)
-> TExpr
-> TExpr
forall b c.
(TypeExpr -> VarIndex -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((VarIndex, TypeExpr), b)] -> b -> b)
-> ([(VarIndex, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
trTExpr TypeExpr -> VarIndex -> TExpr
TVarE TypeExpr -> Literal -> TExpr
lit TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
TComb [((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr
TLet [(VarIndex, TypeExpr)] -> TExpr -> TExpr
TFree TExpr -> TExpr -> TExpr
TOr CaseType -> TExpr -> [TBranchExpr] -> TExpr
TCase TPattern -> TExpr -> TBranchExpr
TBranch TExpr -> TypeExpr -> TExpr
TTyped

-- |update all combined expressions in given expression
updCombs :: (TypeExpr -> CombType -> QName -> [TExpr] -> TExpr) -> TExpr -> TExpr
updCombs :: (TypeExpr -> CombType -> QName -> [TExpr] -> TExpr)
-> TExpr -> TExpr
updCombs comb :: TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
comb = (TypeExpr -> VarIndex -> TExpr)
-> (TypeExpr -> Literal -> TExpr)
-> (TypeExpr -> CombType -> QName -> [TExpr] -> TExpr)
-> ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr)
-> ([(VarIndex, TypeExpr)] -> TExpr -> TExpr)
-> (TExpr -> TExpr -> TExpr)
-> (CaseType -> TExpr -> [TBranchExpr] -> TExpr)
-> (TPattern -> TExpr -> TBranchExpr)
-> (TExpr -> TypeExpr -> TExpr)
-> TExpr
-> TExpr
forall b c.
(TypeExpr -> VarIndex -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((VarIndex, TypeExpr), b)] -> b -> b)
-> ([(VarIndex, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
trTExpr TypeExpr -> VarIndex -> TExpr
TVarE TypeExpr -> Literal -> TExpr
TLit TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
comb [((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr
TLet [(VarIndex, TypeExpr)] -> TExpr -> TExpr
TFree TExpr -> TExpr -> TExpr
TOr CaseType -> TExpr -> [TBranchExpr] -> TExpr
TCase TPattern -> TExpr -> TBranchExpr
TBranch TExpr -> TypeExpr -> TExpr
TTyped

-- |update all let expressions in given expression
updLets :: ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr) -> TExpr -> TExpr
updLets :: ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr)
-> TExpr -> TExpr
updLets lt :: [((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr
lt = (TypeExpr -> VarIndex -> TExpr)
-> (TypeExpr -> Literal -> TExpr)
-> (TypeExpr -> CombType -> QName -> [TExpr] -> TExpr)
-> ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr)
-> ([(VarIndex, TypeExpr)] -> TExpr -> TExpr)
-> (TExpr -> TExpr -> TExpr)
-> (CaseType -> TExpr -> [TBranchExpr] -> TExpr)
-> (TPattern -> TExpr -> TBranchExpr)
-> (TExpr -> TypeExpr -> TExpr)
-> TExpr
-> TExpr
forall b c.
(TypeExpr -> VarIndex -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((VarIndex, TypeExpr), b)] -> b -> b)
-> ([(VarIndex, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
trTExpr TypeExpr -> VarIndex -> TExpr
TVarE TypeExpr -> Literal -> TExpr
TLit TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
TComb [((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr
lt [(VarIndex, TypeExpr)] -> TExpr -> TExpr
TFree TExpr -> TExpr -> TExpr
TOr CaseType -> TExpr -> [TBranchExpr] -> TExpr
TCase TPattern -> TExpr -> TBranchExpr
TBranch TExpr -> TypeExpr -> TExpr
TTyped

-- |update all free declarations in given expression
updFrees :: ([(VarIndex, TypeExpr)] -> TExpr -> TExpr) -> TExpr -> TExpr
updFrees :: ([(VarIndex, TypeExpr)] -> TExpr -> TExpr) -> TExpr -> TExpr
updFrees fr :: [(VarIndex, TypeExpr)] -> TExpr -> TExpr
fr = (TypeExpr -> VarIndex -> TExpr)
-> (TypeExpr -> Literal -> TExpr)
-> (TypeExpr -> CombType -> QName -> [TExpr] -> TExpr)
-> ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr)
-> ([(VarIndex, TypeExpr)] -> TExpr -> TExpr)
-> (TExpr -> TExpr -> TExpr)
-> (CaseType -> TExpr -> [TBranchExpr] -> TExpr)
-> (TPattern -> TExpr -> TBranchExpr)
-> (TExpr -> TypeExpr -> TExpr)
-> TExpr
-> TExpr
forall b c.
(TypeExpr -> VarIndex -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((VarIndex, TypeExpr), b)] -> b -> b)
-> ([(VarIndex, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
trTExpr TypeExpr -> VarIndex -> TExpr
TVarE TypeExpr -> Literal -> TExpr
TLit TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
TComb [((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr
TLet [(VarIndex, TypeExpr)] -> TExpr -> TExpr
fr TExpr -> TExpr -> TExpr
TOr CaseType -> TExpr -> [TBranchExpr] -> TExpr
TCase TPattern -> TExpr -> TBranchExpr
TBranch TExpr -> TypeExpr -> TExpr
TTyped

-- |update all or expressions in given expression
updOrs :: (TExpr -> TExpr -> TExpr) -> TExpr -> TExpr
updOrs :: (TExpr -> TExpr -> TExpr) -> TExpr -> TExpr
updOrs oR :: TExpr -> TExpr -> TExpr
oR = (TypeExpr -> VarIndex -> TExpr)
-> (TypeExpr -> Literal -> TExpr)
-> (TypeExpr -> CombType -> QName -> [TExpr] -> TExpr)
-> ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr)
-> ([(VarIndex, TypeExpr)] -> TExpr -> TExpr)
-> (TExpr -> TExpr -> TExpr)
-> (CaseType -> TExpr -> [TBranchExpr] -> TExpr)
-> (TPattern -> TExpr -> TBranchExpr)
-> (TExpr -> TypeExpr -> TExpr)
-> TExpr
-> TExpr
forall b c.
(TypeExpr -> VarIndex -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((VarIndex, TypeExpr), b)] -> b -> b)
-> ([(VarIndex, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
trTExpr TypeExpr -> VarIndex -> TExpr
TVarE TypeExpr -> Literal -> TExpr
TLit TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
TComb [((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr
TLet [(VarIndex, TypeExpr)] -> TExpr -> TExpr
TFree TExpr -> TExpr -> TExpr
oR CaseType -> TExpr -> [TBranchExpr] -> TExpr
TCase TPattern -> TExpr -> TBranchExpr
TBranch TExpr -> TypeExpr -> TExpr
TTyped

-- |update all case expressions in given expression
updCases :: (CaseType -> TExpr -> [TBranchExpr] -> TExpr) -> TExpr -> TExpr
updCases :: (CaseType -> TExpr -> [TBranchExpr] -> TExpr) -> TExpr -> TExpr
updCases cas :: CaseType -> TExpr -> [TBranchExpr] -> TExpr
cas = (TypeExpr -> VarIndex -> TExpr)
-> (TypeExpr -> Literal -> TExpr)
-> (TypeExpr -> CombType -> QName -> [TExpr] -> TExpr)
-> ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr)
-> ([(VarIndex, TypeExpr)] -> TExpr -> TExpr)
-> (TExpr -> TExpr -> TExpr)
-> (CaseType -> TExpr -> [TBranchExpr] -> TExpr)
-> (TPattern -> TExpr -> TBranchExpr)
-> (TExpr -> TypeExpr -> TExpr)
-> TExpr
-> TExpr
forall b c.
(TypeExpr -> VarIndex -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((VarIndex, TypeExpr), b)] -> b -> b)
-> ([(VarIndex, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
trTExpr TypeExpr -> VarIndex -> TExpr
TVarE TypeExpr -> Literal -> TExpr
TLit TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
TComb [((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr
TLet [(VarIndex, TypeExpr)] -> TExpr -> TExpr
TFree TExpr -> TExpr -> TExpr
TOr CaseType -> TExpr -> [TBranchExpr] -> TExpr
cas TPattern -> TExpr -> TBranchExpr
TBranch TExpr -> TypeExpr -> TExpr
TTyped

-- |update all case branches in given expression
updBranches :: (TPattern -> TExpr -> TBranchExpr) -> TExpr -> TExpr
updBranches :: (TPattern -> TExpr -> TBranchExpr) -> TExpr -> TExpr
updBranches branch :: TPattern -> TExpr -> TBranchExpr
branch = (TypeExpr -> VarIndex -> TExpr)
-> (TypeExpr -> Literal -> TExpr)
-> (TypeExpr -> CombType -> QName -> [TExpr] -> TExpr)
-> ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr)
-> ([(VarIndex, TypeExpr)] -> TExpr -> TExpr)
-> (TExpr -> TExpr -> TExpr)
-> (CaseType -> TExpr -> [TBranchExpr] -> TExpr)
-> (TPattern -> TExpr -> TBranchExpr)
-> (TExpr -> TypeExpr -> TExpr)
-> TExpr
-> TExpr
forall b c.
(TypeExpr -> VarIndex -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((VarIndex, TypeExpr), b)] -> b -> b)
-> ([(VarIndex, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
trTExpr TypeExpr -> VarIndex -> TExpr
TVarE TypeExpr -> Literal -> TExpr
TLit TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
TComb [((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr
TLet [(VarIndex, TypeExpr)] -> TExpr -> TExpr
TFree TExpr -> TExpr -> TExpr
TOr CaseType -> TExpr -> [TBranchExpr] -> TExpr
TCase TPattern -> TExpr -> TBranchExpr
branch TExpr -> TypeExpr -> TExpr
TTyped

-- |update all typed expressions in given expression
updTypeds :: (TExpr -> TypeExpr -> TExpr) -> TExpr -> TExpr
updTypeds :: (TExpr -> TypeExpr -> TExpr) -> TExpr -> TExpr
updTypeds = (TypeExpr -> VarIndex -> TExpr)
-> (TypeExpr -> Literal -> TExpr)
-> (TypeExpr -> CombType -> QName -> [TExpr] -> TExpr)
-> ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr)
-> ([(VarIndex, TypeExpr)] -> TExpr -> TExpr)
-> (TExpr -> TExpr -> TExpr)
-> (CaseType -> TExpr -> [TBranchExpr] -> TExpr)
-> (TPattern -> TExpr -> TBranchExpr)
-> (TExpr -> TypeExpr -> TExpr)
-> TExpr
-> TExpr
forall b c.
(TypeExpr -> VarIndex -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((VarIndex, TypeExpr), b)] -> b -> b)
-> ([(VarIndex, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
trTExpr TypeExpr -> VarIndex -> TExpr
TVarE TypeExpr -> Literal -> TExpr
TLit TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
TComb [((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr
TLet [(VarIndex, TypeExpr)] -> TExpr -> TExpr
TFree TExpr -> TExpr -> TExpr
TOr CaseType -> TExpr -> [TBranchExpr] -> TExpr
TCase TPattern -> TExpr -> TBranchExpr
TBranch

-- Auxiliary Functions

-- |is expression a call of a function where all arguments are provided?
isFuncCall :: TExpr -> Bool
isFuncCall :: TExpr -> Bool
isFuncCall e :: TExpr
e = TExpr -> Bool
isTComb TExpr
e Bool -> Bool -> Bool
&& CombType -> Bool
isCombTypeFuncCall (TExpr -> CombType
combType TExpr
e)

-- |is expression a partial function call?
isFuncPartCall :: TExpr -> Bool
isFuncPartCall :: TExpr -> Bool
isFuncPartCall e :: TExpr
e = TExpr -> Bool
isTComb TExpr
e Bool -> Bool -> Bool
&& CombType -> Bool
isCombTypeFuncPartCall (TExpr -> CombType
combType TExpr
e)

-- |is expression a call of a constructor?
isConsCall :: TExpr -> Bool
isConsCall :: TExpr -> Bool
isConsCall e :: TExpr
e = TExpr -> Bool
isTComb TExpr
e Bool -> Bool -> Bool
&& CombType -> Bool
isCombTypeConsCall (TExpr -> CombType
combType TExpr
e)

-- |is expression a partial constructor call?
isConsPartCall :: TExpr -> Bool
isConsPartCall :: TExpr -> Bool
isConsPartCall e :: TExpr
e = TExpr -> Bool
isTComb TExpr
e Bool -> Bool -> Bool
&& CombType -> Bool
isCombTypeConsPartCall (TExpr -> CombType
combType TExpr
e)

-- |is expression fully evaluated?
isGround :: TExpr -> Bool
isGround :: TExpr -> Bool
isGround e :: TExpr
e
  = case TExpr
e of
      TComb _ ConsCall _ args :: [TExpr]
args -> (TExpr -> Bool) -> [TExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TExpr -> Bool
isGround [TExpr]
args
      _ -> TExpr -> Bool
isTLit TExpr
e

-- |get all variables (also pattern variables) in expression
allVars :: TExpr -> [(VarIndex, TypeExpr)]
allVars :: TExpr -> [(VarIndex, TypeExpr)]
allVars e :: TExpr
e = (TypeExpr
 -> VarIndex -> [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> (TypeExpr
    -> Literal -> [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> (TypeExpr
    -> CombType
    -> QName
    -> [[(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]]
    -> [(VarIndex, TypeExpr)]
    -> [(VarIndex, TypeExpr)])
-> ([((VarIndex, TypeExpr),
      [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])]
    -> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
    -> [(VarIndex, TypeExpr)]
    -> [(VarIndex, TypeExpr)])
-> ([(VarIndex, TypeExpr)]
    -> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
    -> [(VarIndex, TypeExpr)]
    -> [(VarIndex, TypeExpr)])
-> (([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
    -> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
    -> [(VarIndex, TypeExpr)]
    -> [(VarIndex, TypeExpr)])
-> (CaseType
    -> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
    -> [[(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]]
    -> [(VarIndex, TypeExpr)]
    -> [(VarIndex, TypeExpr)])
-> (TPattern
    -> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
    -> [(VarIndex, TypeExpr)]
    -> [(VarIndex, TypeExpr)])
-> (([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
    -> TypeExpr -> [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> TExpr
-> [(VarIndex, TypeExpr)]
-> [(VarIndex, TypeExpr)]
forall b c.
(TypeExpr -> VarIndex -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((VarIndex, TypeExpr), b)] -> b -> b)
-> ([(VarIndex, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
trTExpr TypeExpr
-> VarIndex -> [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
forall b a. b -> a -> [(a, b)] -> [(a, b)]
var TypeExpr
-> Literal -> [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
forall b b a. b -> b -> a -> a
lit TypeExpr
-> CombType
-> QName
-> [[(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]]
-> [(VarIndex, TypeExpr)]
-> [(VarIndex, TypeExpr)]
forall (t :: * -> *) p p p b.
Foldable t =>
p -> p -> p -> t (b -> b) -> b -> b
comb [((VarIndex, TypeExpr),
  [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])]
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> [(VarIndex, TypeExpr)]
-> [(VarIndex, TypeExpr)]
forall a c. [(a, [a] -> [a])] -> ([a] -> c) -> [a] -> c
lt [(VarIndex, TypeExpr)]
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> [(VarIndex, TypeExpr)]
-> [(VarIndex, TypeExpr)]
forall a a. [a] -> (a -> [a]) -> a -> [a]
fr ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> [(VarIndex, TypeExpr)]
-> [(VarIndex, TypeExpr)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) CaseType
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> [[(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]]
-> [(VarIndex, TypeExpr)]
-> [(VarIndex, TypeExpr)]
forall (t :: * -> *) p b c.
Foldable t =>
p -> (b -> c) -> t (b -> b) -> b -> c
cas TPattern
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> [(VarIndex, TypeExpr)]
-> [(VarIndex, TypeExpr)]
forall a.
TPattern
-> (a -> [(VarIndex, TypeExpr)]) -> a -> [(VarIndex, TypeExpr)]
branch ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> TypeExpr -> [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
forall a b. a -> b -> a
typ TExpr
e []
 where
  var :: b -> a -> [(a, b)] -> [(a, b)]
var a :: b
a v :: a
v = (:) (a
v, b
a)
  lit :: b -> b -> a -> a
lit = (b -> a -> a) -> b -> b -> a -> a
forall a b. a -> b -> a
const ((a -> a) -> b -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id)
  comb :: p -> p -> p -> t (b -> b) -> b -> b
comb _ _ _ = ((b -> b) -> (b -> b) -> b -> b)
-> (b -> b) -> t (b -> b) -> b -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) b -> b
forall a. a -> a
id
  lt :: [(a, [a] -> [a])] -> ([a] -> c) -> [a] -> c
lt bs :: [(a, [a] -> [a])]
bs e' :: [a] -> c
e' = [a] -> c
e' ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a])
-> ([a] -> [a]) -> [[a] -> [a]] -> [a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) [a] -> [a]
forall a. a -> a
id (((a, [a] -> [a]) -> [a] -> [a])
-> [(a, [a] -> [a])] -> [[a] -> [a]]
forall a b. (a -> b) -> [a] -> [b]
map (\(n :: a
n,ns :: [a] -> [a]
ns) -> (a
na -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
ns) [(a, [a] -> [a])]
bs)
  fr :: [a] -> (a -> [a]) -> a -> [a]
fr vs :: [a]
vs e' :: a -> [a]
e' = ([a]
vs[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) ([a] -> [a]) -> (a -> [a]) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
e'
  cas :: p -> (b -> c) -> t (b -> b) -> b -> c
cas _ e' :: b -> c
e' bs :: t (b -> b)
bs = b -> c
e' (b -> c) -> (b -> b) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b -> b) -> (b -> b) -> b -> b)
-> (b -> b) -> t (b -> b) -> b -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) b -> b
forall a. a -> a
id t (b -> b)
bs
  branch :: TPattern
-> (a -> [(VarIndex, TypeExpr)]) -> a -> [(VarIndex, TypeExpr)]
branch pat :: TPattern
pat e' :: a -> [(VarIndex, TypeExpr)]
e' = (TPattern -> [(VarIndex, TypeExpr)]
args TPattern
pat [(VarIndex, TypeExpr)]
-> [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
forall a. [a] -> [a] -> [a]
++) ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> (a -> [(VarIndex, TypeExpr)]) -> a -> [(VarIndex, TypeExpr)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [(VarIndex, TypeExpr)]
e'
  typ :: a -> b -> a
typ = a -> b -> a
forall a b. a -> b -> a
const
  args :: TPattern -> [(VarIndex, TypeExpr)]
args pat :: TPattern
pat | TPattern -> Bool
isConsPattern TPattern
pat = TPattern -> [(VarIndex, TypeExpr)]
tPatArgs TPattern
pat
           | Bool
otherwise = []

-- |rename all variables (also in patterns) in expression
rnmAllVars :: Update TExpr VarIndex
rnmAllVars :: Update TExpr VarIndex
rnmAllVars f :: VarIndex -> VarIndex
f = (TypeExpr -> VarIndex -> TExpr)
-> (TypeExpr -> Literal -> TExpr)
-> (TypeExpr -> CombType -> QName -> [TExpr] -> TExpr)
-> ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr)
-> ([(VarIndex, TypeExpr)] -> TExpr -> TExpr)
-> (TExpr -> TExpr -> TExpr)
-> (CaseType -> TExpr -> [TBranchExpr] -> TExpr)
-> (TPattern -> TExpr -> TBranchExpr)
-> (TExpr -> TypeExpr -> TExpr)
-> TExpr
-> TExpr
forall b c.
(TypeExpr -> VarIndex -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((VarIndex, TypeExpr), b)] -> b -> b)
-> ([(VarIndex, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
trTExpr TypeExpr -> VarIndex -> TExpr
var TypeExpr -> Literal -> TExpr
TLit TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
TComb [((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr
lt [(VarIndex, TypeExpr)] -> TExpr -> TExpr
fr TExpr -> TExpr -> TExpr
TOr CaseType -> TExpr -> [TBranchExpr] -> TExpr
TCase TPattern -> TExpr -> TBranchExpr
branch TExpr -> TypeExpr -> TExpr
TTyped
 where
   var :: TypeExpr -> VarIndex -> TExpr
var a :: TypeExpr
a = TypeExpr -> VarIndex -> TExpr
TVarE TypeExpr
a (VarIndex -> TExpr) -> (VarIndex -> VarIndex) -> VarIndex -> TExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarIndex -> VarIndex
f
   lt :: [((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr
lt = [((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr
TLet ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr)
-> ([((VarIndex, TypeExpr), TExpr)]
    -> [((VarIndex, TypeExpr), TExpr)])
-> [((VarIndex, TypeExpr), TExpr)]
-> TExpr
-> TExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((VarIndex, TypeExpr), TExpr) -> ((VarIndex, TypeExpr), TExpr))
-> [((VarIndex, TypeExpr), TExpr)]
-> [((VarIndex, TypeExpr), TExpr)]
forall a b. (a -> b) -> [a] -> [b]
map (\((n :: VarIndex
n, b :: TypeExpr
b), e :: TExpr
e) -> ((VarIndex -> VarIndex
f VarIndex
n, TypeExpr
b), TExpr
e))
   fr :: [(VarIndex, TypeExpr)] -> TExpr -> TExpr
fr = [(VarIndex, TypeExpr)] -> TExpr -> TExpr
TFree ([(VarIndex, TypeExpr)] -> TExpr -> TExpr)
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> [(VarIndex, TypeExpr)]
-> TExpr
-> TExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VarIndex, TypeExpr) -> (VarIndex, TypeExpr))
-> [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
forall a b. (a -> b) -> [a] -> [b]
map (\(b :: VarIndex
b, c :: TypeExpr
c) -> (VarIndex -> VarIndex
f VarIndex
b, TypeExpr
c))
   branch :: TPattern -> TExpr -> TBranchExpr
branch = TPattern -> TExpr -> TBranchExpr
TBranch (TPattern -> TExpr -> TBranchExpr)
-> (TPattern -> TPattern) -> TPattern -> TExpr -> TBranchExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> TPattern -> TPattern
updTPatArgs (((VarIndex, TypeExpr) -> (VarIndex, TypeExpr))
-> [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: VarIndex
a, b :: TypeExpr
b) -> (VarIndex -> VarIndex
f VarIndex
a, TypeExpr
b)))

-- |update all qualified names in expression
updQNames :: Update TExpr QName
updQNames :: (QName -> QName) -> TExpr -> TExpr
updQNames f :: QName -> QName
f = (TypeExpr -> VarIndex -> TExpr)
-> (TypeExpr -> Literal -> TExpr)
-> (TypeExpr -> CombType -> QName -> [TExpr] -> TExpr)
-> ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr)
-> ([(VarIndex, TypeExpr)] -> TExpr -> TExpr)
-> (TExpr -> TExpr -> TExpr)
-> (CaseType -> TExpr -> [TBranchExpr] -> TExpr)
-> (TPattern -> TExpr -> TBranchExpr)
-> (TExpr -> TypeExpr -> TExpr)
-> TExpr
-> TExpr
forall b c.
(TypeExpr -> VarIndex -> b)
-> (TypeExpr -> Literal -> b)
-> (TypeExpr -> CombType -> QName -> [b] -> b)
-> ([((VarIndex, TypeExpr), b)] -> b -> b)
-> ([(VarIndex, TypeExpr)] -> b -> b)
-> (b -> b -> b)
-> (CaseType -> b -> [c] -> b)
-> (TPattern -> b -> c)
-> (b -> TypeExpr -> b)
-> TExpr
-> b
trTExpr TypeExpr -> VarIndex -> TExpr
TVarE TypeExpr -> Literal -> TExpr
TLit TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
comb [((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr
TLet [(VarIndex, TypeExpr)] -> TExpr -> TExpr
TFree TExpr -> TExpr -> TExpr
TOr CaseType -> TExpr -> [TBranchExpr] -> TExpr
TCase TPattern -> TExpr -> TBranchExpr
branch TExpr -> TypeExpr -> TExpr
TTyped
 where
  comb :: TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
comb ty :: TypeExpr
ty ct :: CombType
ct name :: QName
name args :: [TExpr]
args = TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
TComb TypeExpr
ty CombType
ct (QName -> QName
f QName
name) [TExpr]
args
  branch :: TPattern -> TExpr -> TBranchExpr
branch = TPattern -> TExpr -> TBranchExpr
TBranch (TPattern -> TExpr -> TBranchExpr)
-> (TPattern -> TPattern) -> TPattern -> TExpr -> TBranchExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> QName) -> TPattern -> TPattern
updTPatCons QName -> QName
f

-- TBranchExpr ----------------------------------------------------------------

-- |transform branch expression
trTBranch :: (TPattern -> TExpr -> b) -> TBranchExpr -> b
trTBranch :: (TPattern -> TExpr -> b) -> TBranchExpr -> b
trTBranch branch :: TPattern -> TExpr -> b
branch (TBranch pat :: TPattern
pat e :: TExpr
e) = TPattern -> TExpr -> b
branch TPattern
pat TExpr
e

-- Selectors

-- |get pattern from branch expression
tBranchTPattern :: TBranchExpr -> TPattern
tBranchTPattern :: TBranchExpr -> TPattern
tBranchTPattern = (TPattern -> TExpr -> TPattern) -> TBranchExpr -> TPattern
forall b. (TPattern -> TExpr -> b) -> TBranchExpr -> b
trTBranch TPattern -> TExpr -> TPattern
forall a b. a -> b -> a
const

-- |get expression from branch expression
tBranchTExpr :: TBranchExpr -> TExpr
tBranchTExpr :: TBranchExpr -> TExpr
tBranchTExpr = (TPattern -> TExpr -> TExpr) -> TBranchExpr -> TExpr
forall b. (TPattern -> TExpr -> b) -> TBranchExpr -> b
trTBranch (\_ e :: TExpr
e -> TExpr
e)

-- Update Operations

-- |update branch expression
updTBranch :: (TPattern -> TPattern) -> (TExpr -> TExpr) -> TBranchExpr -> TBranchExpr
updTBranch :: (TPattern -> TPattern)
-> (TExpr -> TExpr) -> TBranchExpr -> TBranchExpr
updTBranch fp :: TPattern -> TPattern
fp fe :: TExpr -> TExpr
fe = (TPattern -> TExpr -> TBranchExpr) -> TBranchExpr -> TBranchExpr
forall b. (TPattern -> TExpr -> b) -> TBranchExpr -> b
trTBranch TPattern -> TExpr -> TBranchExpr
branch
 where
  branch :: TPattern -> TExpr -> TBranchExpr
branch pat :: TPattern
pat e :: TExpr
e = TPattern -> TExpr -> TBranchExpr
TBranch (TPattern -> TPattern
fp TPattern
pat) (TExpr -> TExpr
fe TExpr
e)

-- |update pattern of branch expression
updTBranchTPattern :: Update TBranchExpr TPattern
updTBranchTPattern :: Update TBranchExpr TPattern
updTBranchTPattern f :: TPattern -> TPattern
f = (TPattern -> TPattern)
-> (TExpr -> TExpr) -> TBranchExpr -> TBranchExpr
updTBranch TPattern -> TPattern
f TExpr -> TExpr
forall a. a -> a
id

-- |update expression of branch expression
updTBranchTExpr :: Update TBranchExpr TExpr
updTBranchTExpr :: (TExpr -> TExpr) -> TBranchExpr -> TBranchExpr
updTBranchTExpr = (TPattern -> TPattern)
-> (TExpr -> TExpr) -> TBranchExpr -> TBranchExpr
updTBranch TPattern -> TPattern
forall a. a -> a
id

-- TPattern -------------------------------------------------------------------

-- |transform pattern
trTPattern :: (TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> b) -> (TypeExpr -> Literal -> b) -> TPattern -> b
trTPattern :: (TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> b)
-> (TypeExpr -> Literal -> b) -> TPattern -> b
trTPattern pat :: TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> b
pat _ (TPattern ty :: TypeExpr
ty name :: QName
name args :: [(VarIndex, TypeExpr)]
args) = TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> b
pat TypeExpr
ty QName
name [(VarIndex, TypeExpr)]
args
trTPattern _ lpat :: TypeExpr -> Literal -> b
lpat (TLPattern a :: TypeExpr
a l :: Literal
l) = TypeExpr -> Literal -> b
lpat TypeExpr
a Literal
l

-- Selectors

-- |get name from constructor pattern
tPatCons :: TPattern -> QName
tPatCons :: TPattern -> QName
tPatCons = (TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> QName)
-> (TypeExpr -> Literal -> QName) -> TPattern -> QName
forall b.
(TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> b)
-> (TypeExpr -> Literal -> b) -> TPattern -> b
trTPattern (\_ name :: QName
name _ -> QName
name) TypeExpr -> Literal -> QName
forall a. HasCallStack => a
undefined

-- |get arguments from constructor pattern
tPatArgs :: TPattern -> [(VarIndex, TypeExpr)]
tPatArgs :: TPattern -> [(VarIndex, TypeExpr)]
tPatArgs = (TypeExpr
 -> QName -> [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> (TypeExpr -> Literal -> [(VarIndex, TypeExpr)])
-> TPattern
-> [(VarIndex, TypeExpr)]
forall b.
(TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> b)
-> (TypeExpr -> Literal -> b) -> TPattern -> b
trTPattern (\_ _ args :: [(VarIndex, TypeExpr)]
args -> [(VarIndex, TypeExpr)]
args) TypeExpr -> Literal -> [(VarIndex, TypeExpr)]
forall a. HasCallStack => a
undefined

-- |get literal from literal pattern
tPatLiteral :: TPattern -> Literal
tPatLiteral :: TPattern -> Literal
tPatLiteral = (TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> Literal)
-> (TypeExpr -> Literal -> Literal) -> TPattern -> Literal
forall b.
(TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> b)
-> (TypeExpr -> Literal -> b) -> TPattern -> b
trTPattern TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> Literal
forall a. HasCallStack => a
undefined ((Literal -> Literal) -> TypeExpr -> Literal -> Literal
forall a b. a -> b -> a
const Literal -> Literal
forall a. a -> a
id)

-- Test Operations

-- |is pattern a constructor pattern?
isConsPattern :: TPattern -> Bool
isConsPattern :: TPattern -> Bool
isConsPattern = (TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> Bool)
-> (TypeExpr -> Literal -> Bool) -> TPattern -> Bool
forall b.
(TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> b)
-> (TypeExpr -> Literal -> b) -> TPattern -> b
trTPattern (\_ _ _ -> Bool
True) (\_ _ -> Bool
False)

-- Update Operations

-- |update pattern
updTPattern :: (TypeExpr -> TypeExpr) ->
               (QName -> QName) ->
               ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]) ->
               (Literal -> Literal) -> TPattern -> TPattern
updTPattern :: (TypeExpr -> TypeExpr)
-> (QName -> QName)
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> (Literal -> Literal)
-> TPattern
-> TPattern
updTPattern fannot :: TypeExpr -> TypeExpr
fannot fn :: QName -> QName
fn fa :: [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
fa fl :: Literal -> Literal
fl = (TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> TPattern)
-> (TypeExpr -> Literal -> TPattern) -> TPattern -> TPattern
forall b.
(TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> b)
-> (TypeExpr -> Literal -> b) -> TPattern -> b
trTPattern TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> TPattern
pattern TypeExpr -> Literal -> TPattern
lpattern
 where
  pattern :: TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> TPattern
pattern ty :: TypeExpr
ty name :: QName
name args :: [(VarIndex, TypeExpr)]
args = TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> TPattern
TPattern (TypeExpr -> TypeExpr
fannot TypeExpr
ty) (QName -> QName
fn QName
name) ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
fa [(VarIndex, TypeExpr)]
args)
  lpattern :: TypeExpr -> Literal -> TPattern
lpattern ty :: TypeExpr
ty l :: Literal
l = TypeExpr -> Literal -> TPattern
TLPattern (TypeExpr -> TypeExpr
fannot TypeExpr
ty) (Literal -> Literal
fl Literal
l)

-- |update TypeExpr of pattern
updTPatType :: (TypeExpr -> TypeExpr) -> TPattern -> TPattern
updTPatType :: (TypeExpr -> TypeExpr) -> TPattern -> TPattern
updTPatType f :: TypeExpr -> TypeExpr
f = (TypeExpr -> TypeExpr)
-> (QName -> QName)
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> (Literal -> Literal)
-> TPattern
-> TPattern
updTPattern TypeExpr -> TypeExpr
f QName -> QName
forall a. a -> a
id [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
forall a. a -> a
id Literal -> Literal
forall a. a -> a
id

-- |update constructors name of pattern
updTPatCons :: (QName -> QName) -> TPattern -> TPattern
updTPatCons :: (QName -> QName) -> TPattern -> TPattern
updTPatCons f :: QName -> QName
f = (TypeExpr -> TypeExpr)
-> (QName -> QName)
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> (Literal -> Literal)
-> TPattern
-> TPattern
updTPattern TypeExpr -> TypeExpr
forall a. a -> a
id QName -> QName
f [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
forall a. a -> a
id Literal -> Literal
forall a. a -> a
id

-- |update arguments of constructor pattern
updTPatArgs :: ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]) -> TPattern -> TPattern
updTPatArgs :: ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> TPattern -> TPattern
updTPatArgs f :: [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
f = (TypeExpr -> TypeExpr)
-> (QName -> QName)
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> (Literal -> Literal)
-> TPattern
-> TPattern
updTPattern TypeExpr -> TypeExpr
forall a. a -> a
id QName -> QName
forall a. a -> a
id [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
f Literal -> Literal
forall a. a -> a
id

-- |update literal of pattern
updTPatLiteral :: (Literal -> Literal) -> TPattern -> TPattern
updTPatLiteral :: (Literal -> Literal) -> TPattern -> TPattern
updTPatLiteral = (TypeExpr -> TypeExpr)
-> (QName -> QName)
-> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)])
-> (Literal -> Literal)
-> TPattern
-> TPattern
updTPattern TypeExpr -> TypeExpr
forall a. a -> a
id QName -> QName
forall a. a -> a
id [(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]
forall a. a -> a
id

-- Auxiliary Functions

-- |build expression from pattern
tPatExpr :: TPattern -> TExpr
tPatExpr :: TPattern -> TExpr
tPatExpr = (TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> TExpr)
-> (TypeExpr -> Literal -> TExpr) -> TPattern -> TExpr
forall b.
(TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> b)
-> (TypeExpr -> Literal -> b) -> TPattern -> b
trTPattern (\ty :: TypeExpr
ty name :: QName
name -> TypeExpr -> CombType -> QName -> [TExpr] -> TExpr
TComb TypeExpr
ty CombType
ConsCall QName
name ([TExpr] -> TExpr)
-> ([(VarIndex, TypeExpr)] -> [TExpr])
-> [(VarIndex, TypeExpr)]
-> TExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VarIndex, TypeExpr) -> TExpr)
-> [(VarIndex, TypeExpr)] -> [TExpr]
forall a b. (a -> b) -> [a] -> [b]
map ((VarIndex -> TypeExpr -> TExpr) -> (VarIndex, TypeExpr) -> TExpr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((TypeExpr -> VarIndex -> TExpr) -> VarIndex -> TypeExpr -> TExpr
forall a b c. (a -> b -> c) -> b -> a -> c
flip TypeExpr -> VarIndex -> TExpr
TVarE))) TypeExpr -> Literal -> TExpr
TLit