{- |
    Module      : $Header$
    Description : Utility functions for working with FlatCurry.
    Copyright   : (c) Sebastian Fischer 2006
                      Björn Peemöller 2011
    License     : BSD-3-clause

    Maintainer  : bjp@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 FlatCurry 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 FlatCurry
    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.Goodies where

import Curry.FlatCurry.Type

-- |Update of a type's component
type Update a b = (b -> b) -> a -> a

-- Prog ----------------------------------------------------------------------

-- |transform program
trProg :: (String -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> a)
          -> Prog -> a
trProg :: (String -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> a)
-> Prog -> a
trProg prog :: String -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> a
prog (Prog name :: String
name imps :: [String]
imps types :: [TypeDecl]
types funcs :: [FuncDecl]
funcs ops :: [OpDecl]
ops) = String -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> a
prog String
name [String]
imps [TypeDecl]
types [FuncDecl]
funcs [OpDecl]
ops

-- Selectors

-- |get name from program
progName :: Prog -> String
progName :: Prog -> String
progName = (String
 -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> String)
-> Prog -> String
forall a.
(String -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> a)
-> Prog -> a
trProg (\name :: String
name _ _ _ _ -> String
name)

-- |get imports from program
progImports :: Prog -> [String]
progImports :: Prog -> [String]
progImports = (String
 -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> [String])
-> Prog -> [String]
forall a.
(String -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> a)
-> Prog -> a
trProg (\_ imps :: [String]
imps _ _ _ -> [String]
imps)

-- |get type declarations from program
progTypes :: Prog -> [TypeDecl]
progTypes :: Prog -> [TypeDecl]
progTypes = (String
 -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> [TypeDecl])
-> Prog -> [TypeDecl]
forall a.
(String -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> a)
-> Prog -> a
trProg (\_ _ types :: [TypeDecl]
types _ _ -> [TypeDecl]
types)

-- |get functions from program
progFuncs :: Prog -> [FuncDecl]
progFuncs :: Prog -> [FuncDecl]
progFuncs = (String
 -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> [FuncDecl])
-> Prog -> [FuncDecl]
forall a.
(String -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> a)
-> Prog -> a
trProg (\_ _ _ funcs :: [FuncDecl]
funcs _ -> [FuncDecl]
funcs)

-- |get infix operators from program
progOps :: Prog -> [OpDecl]
progOps :: Prog -> [OpDecl]
progOps = (String
 -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> [OpDecl])
-> Prog -> [OpDecl]
forall a.
(String -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> a)
-> Prog -> a
trProg (\_ _ _ _ ops :: [OpDecl]
ops -> [OpDecl]
ops)

-- Update Operations

-- |update program
updProg :: (String -> String)         ->
           ([String] -> [String])     ->
           ([TypeDecl] -> [TypeDecl]) ->
           ([FuncDecl] -> [FuncDecl]) ->
           ([OpDecl] -> [OpDecl])     -> Prog -> Prog
updProg :: (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([FuncDecl] -> [FuncDecl])
-> ([OpDecl] -> [OpDecl])
-> Prog
-> Prog
updProg fn :: String -> String
fn fi :: [String] -> [String]
fi ft :: [TypeDecl] -> [TypeDecl]
ft ff :: [FuncDecl] -> [FuncDecl]
ff fo :: [OpDecl] -> [OpDecl]
fo = (String
 -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> Prog)
-> Prog -> Prog
forall a.
(String -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> a)
-> Prog -> a
trProg String -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> Prog
prog
 where
  prog :: String -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> Prog
prog name :: String
name imps :: [String]
imps types :: [TypeDecl]
types funcs :: [FuncDecl]
funcs ops :: [OpDecl]
ops
    = String -> [String] -> [TypeDecl] -> [FuncDecl] -> [OpDecl] -> Prog
Prog (String -> String
fn String
name) ([String] -> [String]
fi [String]
imps) ([TypeDecl] -> [TypeDecl]
ft [TypeDecl]
types) ([FuncDecl] -> [FuncDecl]
ff [FuncDecl]
funcs) ([OpDecl] -> [OpDecl]
fo [OpDecl]
ops)

-- |update name of program
updProgName :: Update Prog String
updProgName :: Update Prog String
updProgName f :: String -> String
f = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([FuncDecl] -> [FuncDecl])
-> ([OpDecl] -> [OpDecl])
-> Prog
-> Prog
updProg String -> String
f [String] -> [String]
forall a. a -> a
id [TypeDecl] -> [TypeDecl]
forall a. a -> a
id [FuncDecl] -> [FuncDecl]
forall a. a -> a
id [OpDecl] -> [OpDecl]
forall a. a -> a
id

-- |update imports of program
updProgImports :: Update Prog [String]
updProgImports :: Update Prog [String]
updProgImports f :: [String] -> [String]
f = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([FuncDecl] -> [FuncDecl])
-> ([OpDecl] -> [OpDecl])
-> Prog
-> Prog
updProg String -> String
forall a. a -> a
id [String] -> [String]
f [TypeDecl] -> [TypeDecl]
forall a. a -> a
id [FuncDecl] -> [FuncDecl]
forall a. a -> a
id [OpDecl] -> [OpDecl]
forall a. a -> a
id

-- |update type declarations of program
updProgTypes :: Update Prog [TypeDecl]
updProgTypes :: Update Prog [TypeDecl]
updProgTypes f :: [TypeDecl] -> [TypeDecl]
f = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([FuncDecl] -> [FuncDecl])
-> ([OpDecl] -> [OpDecl])
-> Prog
-> Prog
updProg String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id [TypeDecl] -> [TypeDecl]
f [FuncDecl] -> [FuncDecl]
forall a. a -> a
id [OpDecl] -> [OpDecl]
forall a. a -> a
id

-- |update functions of program
updProgFuncs :: Update Prog [FuncDecl]
updProgFuncs :: Update Prog [FuncDecl]
updProgFuncs f :: [FuncDecl] -> [FuncDecl]
f = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([FuncDecl] -> [FuncDecl])
-> ([OpDecl] -> [OpDecl])
-> Prog
-> Prog
updProg String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id [TypeDecl] -> [TypeDecl]
forall a. a -> a
id [FuncDecl] -> [FuncDecl]
f [OpDecl] -> [OpDecl]
forall a. a -> a
id

-- |update infix operators of program
updProgOps :: Update Prog [OpDecl]
updProgOps :: ([OpDecl] -> [OpDecl]) -> Prog -> Prog
updProgOps = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([FuncDecl] -> [FuncDecl])
-> ([OpDecl] -> [OpDecl])
-> Prog
-> Prog
updProg String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id [TypeDecl] -> [TypeDecl]
forall a. a -> a
id [FuncDecl] -> [FuncDecl]
forall a. a -> a
id

-- Auxiliary Functions

-- |get all program variables (also from patterns)
allVarsInProg :: Prog -> [VarIndex]
allVarsInProg :: Prog -> [VarIndex]
allVarsInProg = (FuncDecl -> [VarIndex]) -> [FuncDecl] -> [VarIndex]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FuncDecl -> [VarIndex]
allVarsInFunc ([FuncDecl] -> [VarIndex])
-> (Prog -> [FuncDecl]) -> Prog -> [VarIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prog -> [FuncDecl]
progFuncs

-- |lift transformation on expressions to program
updProgExps :: Update Prog Expr
updProgExps :: Update Prog Expr
updProgExps = Update Prog [FuncDecl]
updProgFuncs Update Prog [FuncDecl]
-> ((Expr -> Expr) -> [FuncDecl] -> [FuncDecl]) -> Update Prog Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FuncDecl -> FuncDecl) -> [FuncDecl] -> [FuncDecl]
forall a b. (a -> b) -> [a] -> [b]
map ((FuncDecl -> FuncDecl) -> [FuncDecl] -> [FuncDecl])
-> ((Expr -> Expr) -> FuncDecl -> FuncDecl)
-> (Expr -> Expr)
-> [FuncDecl]
-> [FuncDecl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> Expr) -> FuncDecl -> FuncDecl
updFuncBody

-- |rename programs variables
rnmAllVarsInProg :: Update Prog VarIndex
rnmAllVarsInProg :: Update Prog VarIndex
rnmAllVarsInProg = Update Prog [FuncDecl]
updProgFuncs Update Prog [FuncDecl]
-> ((VarIndex -> VarIndex) -> [FuncDecl] -> [FuncDecl])
-> Update Prog VarIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FuncDecl -> FuncDecl) -> [FuncDecl] -> [FuncDecl]
forall a b. (a -> b) -> [a] -> [b]
map ((FuncDecl -> FuncDecl) -> [FuncDecl] -> [FuncDecl])
-> ((VarIndex -> VarIndex) -> FuncDecl -> FuncDecl)
-> (VarIndex -> VarIndex)
-> [FuncDecl]
-> [FuncDecl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarIndex -> VarIndex) -> FuncDecl -> FuncDecl
rnmAllVarsInFunc

-- |update all qualified names in program
updQNamesInProg :: Update Prog QName
updQNamesInProg :: Update Prog QName
updQNamesInProg f :: QName -> QName
f = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([FuncDecl] -> [FuncDecl])
-> ([OpDecl] -> [OpDecl])
-> Prog
-> Prog
updProg 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)) ((FuncDecl -> FuncDecl) -> [FuncDecl] -> [FuncDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Update FuncDecl QName
updQNamesInFunc 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)
rnmProg :: String -> Prog -> Prog
rnmProg :: String -> Prog -> Prog
rnmProg name :: String
name p :: Prog
p = Update Prog String
updProgName (String -> String -> String
forall a b. a -> b -> a
const String
name) (Update Prog QName
updQNamesInProg QName -> QName
forall b. (String, b) -> (String, b)
rnm Prog
p)
 where
  rnm :: (String, b) -> (String, b)
rnm (m :: String
m,n :: b
n) | String
mString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==Prog -> String
progName Prog
p = (String
name,b
n)
            | Bool
otherwise = (String
m,b
n)

-- TypeDecl ------------------------------------------------------------------

-- Selectors

-- |transform type declaration
trType :: (QName -> Visibility -> [TVarIndex] -> [ConsDecl] -> a) ->
          (QName -> Visibility -> [TVarIndex] -> TypeExpr   -> a) -> TypeDecl -> a
trType :: (QName -> Visibility -> [VarIndex] -> [ConsDecl] -> a)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> a)
-> TypeDecl
-> a
trType typ :: QName -> Visibility -> [VarIndex] -> [ConsDecl] -> a
typ _ (Type name :: QName
name vis :: Visibility
vis params :: [VarIndex]
params cs :: [ConsDecl]
cs) = QName -> Visibility -> [VarIndex] -> [ConsDecl] -> a
typ QName
name Visibility
vis [VarIndex]
params [ConsDecl]
cs
trType _ typesyn :: QName -> Visibility -> [VarIndex] -> TypeExpr -> a
typesyn (TypeSyn name :: QName
name vis :: Visibility
vis params :: [VarIndex]
params syn :: TypeExpr
syn) = QName -> Visibility -> [VarIndex] -> TypeExpr -> a
typesyn QName
name Visibility
vis [VarIndex]
params TypeExpr
syn

-- |get name of type declaration
typeName :: TypeDecl -> QName
typeName :: TypeDecl -> QName
typeName = (QName -> Visibility -> [VarIndex] -> [ConsDecl] -> QName)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> QName)
-> TypeDecl
-> QName
forall a.
(QName -> Visibility -> [VarIndex] -> [ConsDecl] -> a)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> a)
-> TypeDecl
-> a
trType (\name :: QName
name _ _ _ -> QName
name) (\name :: QName
name _ _ _ -> QName
name)

-- |get visibility of type declaration
typeVisibility :: TypeDecl -> Visibility
typeVisibility :: TypeDecl -> Visibility
typeVisibility = (QName -> Visibility -> [VarIndex] -> [ConsDecl] -> Visibility)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> Visibility)
-> TypeDecl
-> Visibility
forall a.
(QName -> Visibility -> [VarIndex] -> [ConsDecl] -> a)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> a)
-> TypeDecl
-> a
trType (\_ vis :: Visibility
vis _ _ -> Visibility
vis) (\_ vis :: Visibility
vis _ _ -> Visibility
vis)

-- |get type parameters of type declaration
typeParams :: TypeDecl -> [TVarIndex]
typeParams :: TypeDecl -> [VarIndex]
typeParams = (QName -> Visibility -> [VarIndex] -> [ConsDecl] -> [VarIndex])
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> [VarIndex])
-> TypeDecl
-> [VarIndex]
forall a.
(QName -> Visibility -> [VarIndex] -> [ConsDecl] -> a)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> a)
-> TypeDecl
-> a
trType (\_ _ params :: [VarIndex]
params _ -> [VarIndex]
params) (\_ _ params :: [VarIndex]
params _ -> [VarIndex]
params)

-- |get constructor declarations from type declaration
typeConsDecls :: TypeDecl -> [ConsDecl]
typeConsDecls :: TypeDecl -> [ConsDecl]
typeConsDecls = (QName -> Visibility -> [VarIndex] -> [ConsDecl] -> [ConsDecl])
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> [ConsDecl])
-> TypeDecl
-> [ConsDecl]
forall a.
(QName -> Visibility -> [VarIndex] -> [ConsDecl] -> a)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> a)
-> TypeDecl
-> a
trType (\_ _ _ cs :: [ConsDecl]
cs -> [ConsDecl]
cs)
                       (String
-> QName -> Visibility -> [VarIndex] -> TypeExpr -> [ConsDecl]
forall a. HasCallStack => String -> a
error "Curry.FlatCurry.Goodies: type synonym")

-- |get synonym of type declaration
typeSyn :: TypeDecl -> TypeExpr
typeSyn :: TypeDecl -> TypeExpr
typeSyn = (QName -> Visibility -> [VarIndex] -> [ConsDecl] -> TypeExpr)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> TypeExpr)
-> TypeDecl
-> TypeExpr
forall a.
(QName -> Visibility -> [VarIndex] -> [ConsDecl] -> a)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> a)
-> TypeDecl
-> a
trType QName -> Visibility -> [VarIndex] -> [ConsDecl] -> TypeExpr
forall a. HasCallStack => a
undefined (\_ _ _ syn :: TypeExpr
syn -> TypeExpr
syn)

-- |is type declaration a type synonym?
isTypeSyn :: TypeDecl -> Bool
isTypeSyn :: TypeDecl -> Bool
isTypeSyn = (QName -> Visibility -> [VarIndex] -> [ConsDecl] -> Bool)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> Bool)
-> TypeDecl
-> Bool
forall a.
(QName -> Visibility -> [VarIndex] -> [ConsDecl] -> a)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> a)
-> TypeDecl
-> a
trType (\_ _ _ _ -> Bool
False) (\_ _ _ _ -> Bool
True)

-- | is type declaration declaring a regular type?
isDataTypeDecl :: TypeDecl -> Bool
isDataTypeDecl :: TypeDecl -> Bool
isDataTypeDecl = (QName -> Visibility -> [VarIndex] -> [ConsDecl] -> Bool)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> Bool)
-> TypeDecl
-> Bool
forall a.
(QName -> Visibility -> [VarIndex] -> [ConsDecl] -> a)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> a)
-> TypeDecl
-> a
trType (\_ _ _ cs :: [ConsDecl]
cs -> Bool -> Bool
not ([ConsDecl] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ConsDecl]
cs)) (\_ _ _ _ -> Bool
False)

-- | is type declaration declaring an external type?
isExternalType :: TypeDecl -> Bool
isExternalType :: TypeDecl -> Bool
isExternalType = (QName -> Visibility -> [VarIndex] -> [ConsDecl] -> Bool)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> Bool)
-> TypeDecl
-> Bool
forall a.
(QName -> Visibility -> [VarIndex] -> [ConsDecl] -> a)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> a)
-> TypeDecl
-> a
trType (\_ _ _ cs :: [ConsDecl]
cs -> [ConsDecl] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ConsDecl]
cs) (\_ _ _ _ -> Bool
False)

-- |Is the 'TypeDecl' public?
isPublicType :: TypeDecl -> Bool
isPublicType :: TypeDecl -> Bool
isPublicType = (Visibility -> Visibility -> Bool
forall a. Eq a => a -> a -> Bool
== Visibility
Public) (Visibility -> Bool)
-> (TypeDecl -> Visibility) -> TypeDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDecl -> Visibility
typeVisibility

-- Update Operations

-- |update type declaration
updType :: (QName -> QName) ->
           (Visibility -> Visibility) ->
           ([TVarIndex] -> [TVarIndex]) ->
           ([ConsDecl] -> [ConsDecl]) ->
           (TypeExpr -> TypeExpr)     -> TypeDecl -> TypeDecl
updType :: (QName -> QName)
-> (Visibility -> Visibility)
-> ([VarIndex] -> [VarIndex])
-> ([ConsDecl] -> [ConsDecl])
-> (TypeExpr -> TypeExpr)
-> TypeDecl
-> TypeDecl
updType fn :: QName -> QName
fn fv :: Visibility -> Visibility
fv fp :: [VarIndex] -> [VarIndex]
fp fc :: [ConsDecl] -> [ConsDecl]
fc fs :: TypeExpr -> TypeExpr
fs = (QName -> Visibility -> [VarIndex] -> [ConsDecl] -> TypeDecl)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> TypeDecl)
-> TypeDecl
-> TypeDecl
forall a.
(QName -> Visibility -> [VarIndex] -> [ConsDecl] -> a)
-> (QName -> Visibility -> [VarIndex] -> TypeExpr -> a)
-> TypeDecl
-> a
trType QName -> Visibility -> [VarIndex] -> [ConsDecl] -> TypeDecl
typ QName -> Visibility -> [VarIndex] -> TypeExpr -> TypeDecl
typesyn
 where
  typ :: QName -> Visibility -> [VarIndex] -> [ConsDecl] -> TypeDecl
typ name :: QName
name vis :: Visibility
vis params :: [VarIndex]
params cs :: [ConsDecl]
cs = QName -> Visibility -> [VarIndex] -> [ConsDecl] -> TypeDecl
Type (QName -> QName
fn QName
name) (Visibility -> Visibility
fv Visibility
vis) ([VarIndex] -> [VarIndex]
fp [VarIndex]
params) ([ConsDecl] -> [ConsDecl]
fc [ConsDecl]
cs)
  typesyn :: QName -> Visibility -> [VarIndex] -> TypeExpr -> TypeDecl
typesyn name :: QName
name vis :: Visibility
vis params :: [VarIndex]
params syn :: TypeExpr
syn = QName -> Visibility -> [VarIndex] -> TypeExpr -> TypeDecl
TypeSyn (QName -> QName
fn QName
name) (Visibility -> Visibility
fv Visibility
vis) ([VarIndex] -> [VarIndex]
fp [VarIndex]
params) (TypeExpr -> TypeExpr
fs TypeExpr
syn)

-- |update name of type declaration
updTypeName :: Update TypeDecl QName
updTypeName :: Update TypeDecl QName
updTypeName f :: QName -> QName
f = (QName -> QName)
-> (Visibility -> Visibility)
-> ([VarIndex] -> [VarIndex])
-> ([ConsDecl] -> [ConsDecl])
-> (TypeExpr -> TypeExpr)
-> TypeDecl
-> TypeDecl
updType QName -> QName
f Visibility -> Visibility
forall a. a -> a
id [VarIndex] -> [VarIndex]
forall a. a -> a
id [ConsDecl] -> [ConsDecl]
forall a. a -> a
id TypeExpr -> TypeExpr
forall a. a -> a
id

-- |update visibility of type declaration
updTypeVisibility :: Update TypeDecl Visibility
updTypeVisibility :: Update TypeDecl Visibility
updTypeVisibility f :: Visibility -> Visibility
f = (QName -> QName)
-> (Visibility -> Visibility)
-> ([VarIndex] -> [VarIndex])
-> ([ConsDecl] -> [ConsDecl])
-> (TypeExpr -> TypeExpr)
-> TypeDecl
-> TypeDecl
updType QName -> QName
forall a. a -> a
id Visibility -> Visibility
f [VarIndex] -> [VarIndex]
forall a. a -> a
id [ConsDecl] -> [ConsDecl]
forall a. a -> a
id TypeExpr -> TypeExpr
forall a. a -> a
id

-- |update type parameters of type declaration
updTypeParams :: Update TypeDecl [TVarIndex]
updTypeParams :: Update TypeDecl [VarIndex]
updTypeParams f :: [VarIndex] -> [VarIndex]
f = (QName -> QName)
-> (Visibility -> Visibility)
-> ([VarIndex] -> [VarIndex])
-> ([ConsDecl] -> [ConsDecl])
-> (TypeExpr -> TypeExpr)
-> TypeDecl
-> TypeDecl
updType QName -> QName
forall a. a -> a
id Visibility -> Visibility
forall a. a -> a
id [VarIndex] -> [VarIndex]
f [ConsDecl] -> [ConsDecl]
forall a. a -> a
id TypeExpr -> TypeExpr
forall a. a -> a
id

-- |update constructor declarations of type declaration
updTypeConsDecls :: Update TypeDecl [ConsDecl]
updTypeConsDecls :: Update TypeDecl [ConsDecl]
updTypeConsDecls f :: [ConsDecl] -> [ConsDecl]
f = (QName -> QName)
-> (Visibility -> Visibility)
-> ([VarIndex] -> [VarIndex])
-> ([ConsDecl] -> [ConsDecl])
-> (TypeExpr -> TypeExpr)
-> TypeDecl
-> TypeDecl
updType QName -> QName
forall a. a -> a
id Visibility -> Visibility
forall a. a -> a
id [VarIndex] -> [VarIndex]
forall a. a -> a
id [ConsDecl] -> [ConsDecl]
f TypeExpr -> TypeExpr
forall a. a -> a
id

-- |update synonym of type declaration
updTypeSynonym :: Update TypeDecl TypeExpr
updTypeSynonym :: (TypeExpr -> TypeExpr) -> TypeDecl -> TypeDecl
updTypeSynonym = (QName -> QName)
-> (Visibility -> Visibility)
-> ([VarIndex] -> [VarIndex])
-> ([ConsDecl] -> [ConsDecl])
-> (TypeExpr -> TypeExpr)
-> TypeDecl
-> TypeDecl
updType QName -> QName
forall a. a -> a
id Visibility -> Visibility
forall a. a -> a
id [VarIndex] -> [VarIndex]
forall a. a -> a
id [ConsDecl] -> [ConsDecl]
forall a. a -> a
id

-- Auxiliary Functions

-- |update all qualified names in type declaration
updQNamesInType :: Update TypeDecl QName
updQNamesInType :: Update TypeDecl QName
updQNamesInType f :: QName -> QName
f
  = (QName -> QName)
-> (Visibility -> Visibility)
-> ([VarIndex] -> [VarIndex])
-> ([ConsDecl] -> [ConsDecl])
-> (TypeExpr -> TypeExpr)
-> TypeDecl
-> TypeDecl
updType QName -> QName
f Visibility -> Visibility
forall a. a -> a
id [VarIndex] -> [VarIndex]
forall a. a -> a
id ((ConsDecl -> ConsDecl) -> [ConsDecl] -> [ConsDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Update ConsDecl QName
updQNamesInConsDecl QName -> QName
f)) ((QName -> QName) -> TypeExpr -> TypeExpr
updQNamesInTypeExpr QName -> QName
f)

-- ConsDecl ------------------------------------------------------------------

-- Selectors

-- |transform constructor declaration
trCons :: (QName -> Int -> Visibility -> [TypeExpr] -> a) -> ConsDecl -> a
trCons :: (QName -> VarIndex -> Visibility -> [TypeExpr] -> a)
-> ConsDecl -> a
trCons cons :: QName -> VarIndex -> Visibility -> [TypeExpr] -> a
cons (Cons name :: QName
name arity :: VarIndex
arity vis :: Visibility
vis args :: [TypeExpr]
args) = QName -> VarIndex -> Visibility -> [TypeExpr] -> a
cons QName
name VarIndex
arity Visibility
vis [TypeExpr]
args

-- |get name of constructor declaration
consName :: ConsDecl -> QName
consName :: ConsDecl -> QName
consName = (QName -> VarIndex -> Visibility -> [TypeExpr] -> QName)
-> ConsDecl -> QName
forall a.
(QName -> VarIndex -> Visibility -> [TypeExpr] -> a)
-> ConsDecl -> a
trCons (\name :: QName
name _ _ _ -> QName
name)

-- |get arity of constructor declaration
consArity :: ConsDecl -> Int
consArity :: ConsDecl -> VarIndex
consArity = (QName -> VarIndex -> Visibility -> [TypeExpr] -> VarIndex)
-> ConsDecl -> VarIndex
forall a.
(QName -> VarIndex -> Visibility -> [TypeExpr] -> a)
-> ConsDecl -> a
trCons (\_ arity :: VarIndex
arity _ _ -> VarIndex
arity)

-- |get visibility of constructor declaration
consVisibility :: ConsDecl -> Visibility
consVisibility :: ConsDecl -> Visibility
consVisibility = (QName -> VarIndex -> Visibility -> [TypeExpr] -> Visibility)
-> ConsDecl -> Visibility
forall a.
(QName -> VarIndex -> Visibility -> [TypeExpr] -> a)
-> ConsDecl -> a
trCons (\_ _ vis :: Visibility
vis _ -> Visibility
vis)

-- |Is the constructor declaration public?
isPublicCons :: ConsDecl -> Bool
isPublicCons :: ConsDecl -> Bool
isPublicCons = Visibility -> Bool
isPublic (Visibility -> Bool)
-> (ConsDecl -> Visibility) -> ConsDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsDecl -> Visibility
consVisibility

-- |get arguments of constructor declaration
consArgs :: ConsDecl -> [TypeExpr]
consArgs :: ConsDecl -> [TypeExpr]
consArgs = (QName -> VarIndex -> Visibility -> [TypeExpr] -> [TypeExpr])
-> ConsDecl -> [TypeExpr]
forall a.
(QName -> VarIndex -> Visibility -> [TypeExpr] -> a)
-> ConsDecl -> a
trCons (\_ _ _ args :: [TypeExpr]
args -> [TypeExpr]
args)

-- Update Operations

-- |update constructor declaration
updCons :: (QName -> QName) ->
           (Int -> Int) ->
           (Visibility -> Visibility) ->
           ([TypeExpr] -> [TypeExpr]) -> ConsDecl -> ConsDecl
updCons :: (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> ([TypeExpr] -> [TypeExpr])
-> ConsDecl
-> ConsDecl
updCons fn :: QName -> QName
fn fa :: VarIndex -> VarIndex
fa fv :: Visibility -> Visibility
fv fas :: [TypeExpr] -> [TypeExpr]
fas = (QName -> VarIndex -> Visibility -> [TypeExpr] -> ConsDecl)
-> ConsDecl -> ConsDecl
forall a.
(QName -> VarIndex -> Visibility -> [TypeExpr] -> a)
-> ConsDecl -> a
trCons QName -> VarIndex -> Visibility -> [TypeExpr] -> ConsDecl
cons
 where
  cons :: QName -> VarIndex -> Visibility -> [TypeExpr] -> ConsDecl
cons name :: QName
name arity :: VarIndex
arity vis :: Visibility
vis args :: [TypeExpr]
args = QName -> VarIndex -> Visibility -> [TypeExpr] -> ConsDecl
Cons (QName -> QName
fn QName
name) (VarIndex -> VarIndex
fa VarIndex
arity) (Visibility -> Visibility
fv Visibility
vis) ([TypeExpr] -> [TypeExpr]
fas [TypeExpr]
args)

-- |update name of constructor declaration
updConsName :: Update ConsDecl QName
updConsName :: Update ConsDecl QName
updConsName f :: QName -> QName
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> ([TypeExpr] -> [TypeExpr])
-> ConsDecl
-> ConsDecl
updCons QName -> QName
f VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
forall a. a -> a
id [TypeExpr] -> [TypeExpr]
forall a. a -> a
id

-- |update arity of constructor declaration
updConsArity :: Update ConsDecl Int
updConsArity :: Update ConsDecl VarIndex
updConsArity f :: VarIndex -> VarIndex
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> ([TypeExpr] -> [TypeExpr])
-> ConsDecl
-> ConsDecl
updCons QName -> QName
forall a. a -> a
id VarIndex -> VarIndex
f Visibility -> Visibility
forall a. a -> a
id [TypeExpr] -> [TypeExpr]
forall a. a -> a
id

-- |update visibility of constructor declaration
updConsVisibility :: Update ConsDecl Visibility
updConsVisibility :: Update ConsDecl Visibility
updConsVisibility f :: Visibility -> Visibility
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> ([TypeExpr] -> [TypeExpr])
-> ConsDecl
-> ConsDecl
updCons QName -> QName
forall a. a -> a
id VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
f [TypeExpr] -> [TypeExpr]
forall a. a -> a
id

-- |update arguments of constructor declaration
updConsArgs :: Update ConsDecl [TypeExpr]
updConsArgs :: ([TypeExpr] -> [TypeExpr]) -> ConsDecl -> ConsDecl
updConsArgs = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> ([TypeExpr] -> [TypeExpr])
-> ConsDecl
-> ConsDecl
updCons QName -> QName
forall a. a -> a
id VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
forall a. a -> a
id

-- Auxiliary Functions

-- |update all qualified names in constructor declaration
updQNamesInConsDecl :: Update ConsDecl QName
updQNamesInConsDecl :: Update ConsDecl QName
updQNamesInConsDecl f :: QName -> QName
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> ([TypeExpr] -> [TypeExpr])
-> ConsDecl
-> ConsDecl
updCons QName -> QName
f VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
forall a. a -> a
id ((TypeExpr -> TypeExpr) -> [TypeExpr] -> [TypeExpr]
forall a b. (a -> b) -> [a] -> [b]
map ((QName -> QName) -> TypeExpr -> TypeExpr
updQNamesInTypeExpr QName -> QName
f))

-- TypeExpr ------------------------------------------------------------------

-- Selectors

-- |get index from type variable
tVarIndex :: TypeExpr -> TVarIndex
tVarIndex :: TypeExpr -> VarIndex
tVarIndex (TVar n :: VarIndex
n) = VarIndex
n
tVarIndex _        = String -> VarIndex
forall a. HasCallStack => String -> a
error (String -> VarIndex) -> String -> VarIndex
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Goodies.tvarIndex: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                             "no type variable"

-- |get domain from functional type
domain :: TypeExpr -> TypeExpr
domain :: TypeExpr -> TypeExpr
domain (FuncType dom :: TypeExpr
dom _) = TypeExpr
dom
domain _                = String -> TypeExpr
forall a. HasCallStack => String -> a
error (String -> TypeExpr) -> String -> TypeExpr
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Goodies.domain: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                  "no function type"

-- |get range from functional type
range :: TypeExpr -> TypeExpr
range :: TypeExpr -> TypeExpr
range (FuncType _ ran :: TypeExpr
ran) = TypeExpr
ran
range _                = String -> TypeExpr
forall a. HasCallStack => String -> a
error (String -> TypeExpr) -> String -> TypeExpr
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Goodies.range: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                  "no function type"

-- |get name from constructed type
tConsName :: TypeExpr -> QName
tConsName :: TypeExpr -> QName
tConsName (TCons name :: QName
name _) = QName
name
tConsName _              = String -> QName
forall a. HasCallStack => String -> a
error (String -> QName) -> String -> QName
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Goodies.tConsName: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                   "no constructor type"

-- |get arguments from constructed type
tConsArgs :: TypeExpr -> [TypeExpr]
tConsArgs :: TypeExpr -> [TypeExpr]
tConsArgs (TCons _ args :: [TypeExpr]
args) = [TypeExpr]
args
tConsArgs _              = String -> [TypeExpr]
forall a. HasCallStack => String -> a
error (String -> [TypeExpr]) -> String -> [TypeExpr]
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Goodies.tConsArgs: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                   "no constructor type"

-- |transform type expression
trTypeExpr :: (TVarIndex -> a) ->
              (QName -> [a] -> a) ->
              (a -> a -> a) ->
              ([TVarIndex] -> a -> a) -> TypeExpr -> a
trTypeExpr :: (VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
trTypeExpr tvar :: VarIndex -> a
tvar _ _ _ (TVar n :: VarIndex
n) = VarIndex -> a
tvar VarIndex
n
trTypeExpr tvar :: VarIndex -> a
tvar tcons :: QName -> [a] -> a
tcons functype :: a -> a -> a
functype foralltype :: [VarIndex] -> a -> a
foralltype (TCons name :: QName
name args :: [TypeExpr]
args)
  = QName -> [a] -> a
tcons QName
name ((TypeExpr -> a) -> [TypeExpr] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
forall a.
(VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
trTypeExpr VarIndex -> a
tvar QName -> [a] -> a
tcons a -> a -> a
functype [VarIndex] -> a -> a
foralltype) [TypeExpr]
args)
trTypeExpr tvar :: VarIndex -> a
tvar tcons :: QName -> [a] -> a
tcons functype :: a -> a -> a
functype foralltype :: [VarIndex] -> a -> a
foralltype (FuncType from :: TypeExpr
from to :: TypeExpr
to)
  = a -> a -> a
functype (TypeExpr -> a
f TypeExpr
from) (TypeExpr -> a
f TypeExpr
to)
 where
  f :: TypeExpr -> a
f = (VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
forall a.
(VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
trTypeExpr VarIndex -> a
tvar QName -> [a] -> a
tcons a -> a -> a
functype [VarIndex] -> a -> a
foralltype
trTypeExpr tvar :: VarIndex -> a
tvar tcons :: QName -> [a] -> a
tcons functype :: a -> a -> a
functype foralltype :: [VarIndex] -> a -> a
foralltype (ForallType ns :: [VarIndex]
ns t :: TypeExpr
t)
  = [VarIndex] -> a -> a
foralltype [VarIndex]
ns ((VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
forall a.
(VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
trTypeExpr VarIndex -> a
tvar QName -> [a] -> a
tcons a -> a -> a
functype [VarIndex] -> a -> a
foralltype TypeExpr
t)

-- Test Operations

-- |is type expression a type variable?
isTVar :: TypeExpr -> Bool
isTVar :: TypeExpr -> Bool
isTVar = (VarIndex -> Bool)
-> (QName -> [Bool] -> Bool)
-> (Bool -> Bool -> Bool)
-> ([VarIndex] -> Bool -> Bool)
-> TypeExpr
-> Bool
forall a.
(VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
trTypeExpr (\_ -> Bool
True) (\_ _ -> Bool
False) (\_ _ -> Bool
False) (\_ _ -> Bool
False)

-- |is type declaration a constructed type?
isTCons :: TypeExpr -> Bool
isTCons :: TypeExpr -> Bool
isTCons
  = (VarIndex -> Bool)
-> (QName -> [Bool] -> Bool)
-> (Bool -> Bool -> Bool)
-> ([VarIndex] -> Bool -> Bool)
-> TypeExpr
-> Bool
forall a.
(VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
trTypeExpr (\_ -> Bool
False) (\_ _ -> Bool
True) (\_ _ -> Bool
False) (\_ _ -> Bool
False)

-- |is type declaration a functional type?
isFuncType :: TypeExpr -> Bool
isFuncType :: TypeExpr -> Bool
isFuncType
  = (VarIndex -> Bool)
-> (QName -> [Bool] -> Bool)
-> (Bool -> Bool -> Bool)
-> ([VarIndex] -> Bool -> Bool)
-> TypeExpr
-> Bool
forall a.
(VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
trTypeExpr (\_ -> Bool
False) (\_ _ -> Bool
False) (\_ _ -> Bool
True) (\_ _ -> Bool
False)

-- |is type declaration a forall type?
isForallType :: TypeExpr -> Bool
isForallType :: TypeExpr -> Bool
isForallType
  = (VarIndex -> Bool)
-> (QName -> [Bool] -> Bool)
-> (Bool -> Bool -> Bool)
-> ([VarIndex] -> Bool -> Bool)
-> TypeExpr
-> Bool
forall a.
(VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
trTypeExpr (\_ -> Bool
False) (\_ _ -> Bool
False) (\_ _ -> Bool
False) (\_ _ -> Bool
True)

-- Update Operations

-- |update all type variables
updTVars :: (TVarIndex -> TypeExpr) -> TypeExpr -> TypeExpr
updTVars :: (VarIndex -> TypeExpr) -> TypeExpr -> TypeExpr
updTVars tvar :: VarIndex -> TypeExpr
tvar = (VarIndex -> TypeExpr)
-> (QName -> [TypeExpr] -> TypeExpr)
-> (TypeExpr -> TypeExpr -> TypeExpr)
-> ([VarIndex] -> TypeExpr -> TypeExpr)
-> TypeExpr
-> TypeExpr
forall a.
(VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
trTypeExpr VarIndex -> TypeExpr
tvar QName -> [TypeExpr] -> TypeExpr
TCons TypeExpr -> TypeExpr -> TypeExpr
FuncType [VarIndex] -> TypeExpr -> TypeExpr
ForallType

-- |update all type constructors
updTCons :: (QName -> [TypeExpr] -> TypeExpr) -> TypeExpr -> TypeExpr
updTCons :: (QName -> [TypeExpr] -> TypeExpr) -> TypeExpr -> TypeExpr
updTCons tcons :: QName -> [TypeExpr] -> TypeExpr
tcons = (VarIndex -> TypeExpr)
-> (QName -> [TypeExpr] -> TypeExpr)
-> (TypeExpr -> TypeExpr -> TypeExpr)
-> ([VarIndex] -> TypeExpr -> TypeExpr)
-> TypeExpr
-> TypeExpr
forall a.
(VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
trTypeExpr VarIndex -> TypeExpr
TVar QName -> [TypeExpr] -> TypeExpr
tcons TypeExpr -> TypeExpr -> TypeExpr
FuncType [VarIndex] -> TypeExpr -> TypeExpr
ForallType

-- |update all functional types
updFuncTypes :: (TypeExpr -> TypeExpr -> TypeExpr) -> TypeExpr -> TypeExpr
updFuncTypes :: (TypeExpr -> TypeExpr -> TypeExpr) -> TypeExpr -> TypeExpr
updFuncTypes functype :: TypeExpr -> TypeExpr -> TypeExpr
functype = (VarIndex -> TypeExpr)
-> (QName -> [TypeExpr] -> TypeExpr)
-> (TypeExpr -> TypeExpr -> TypeExpr)
-> ([VarIndex] -> TypeExpr -> TypeExpr)
-> TypeExpr
-> TypeExpr
forall a.
(VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
trTypeExpr VarIndex -> TypeExpr
TVar QName -> [TypeExpr] -> TypeExpr
TCons TypeExpr -> TypeExpr -> TypeExpr
functype [VarIndex] -> TypeExpr -> TypeExpr
ForallType

-- |update all forall types
updForallTypes :: ([TVarIndex] -> TypeExpr -> TypeExpr) -> TypeExpr -> TypeExpr
updForallTypes :: ([VarIndex] -> TypeExpr -> TypeExpr) -> TypeExpr -> TypeExpr
updForallTypes = (VarIndex -> TypeExpr)
-> (QName -> [TypeExpr] -> TypeExpr)
-> (TypeExpr -> TypeExpr -> TypeExpr)
-> ([VarIndex] -> TypeExpr -> TypeExpr)
-> TypeExpr
-> TypeExpr
forall a.
(VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
trTypeExpr VarIndex -> TypeExpr
TVar QName -> [TypeExpr] -> TypeExpr
TCons TypeExpr -> TypeExpr -> TypeExpr
FuncType

-- Auxiliary Functions

-- |get argument types from functional type
argTypes :: TypeExpr -> [TypeExpr]
argTypes :: TypeExpr -> [TypeExpr]
argTypes (TVar _) = []
argTypes (TCons _ _) = []
argTypes (FuncType dom :: TypeExpr
dom ran :: TypeExpr
ran) = TypeExpr
dom TypeExpr -> [TypeExpr] -> [TypeExpr]
forall a. a -> [a] -> [a]
: TypeExpr -> [TypeExpr]
argTypes TypeExpr
ran
argTypes (ForallType _ _) = []

-- |Compute the arity of a 'TypeExpr'
typeArity :: TypeExpr -> Int
typeArity :: TypeExpr -> VarIndex
typeArity = [TypeExpr] -> VarIndex
forall (t :: * -> *) a. Foldable t => t a -> VarIndex
length ([TypeExpr] -> VarIndex)
-> (TypeExpr -> [TypeExpr]) -> TypeExpr -> VarIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeExpr -> [TypeExpr]
argTypes

-- |get result type from (nested) functional type
resultType :: TypeExpr -> TypeExpr
resultType :: TypeExpr -> TypeExpr
resultType (TVar n :: VarIndex
n) = VarIndex -> TypeExpr
TVar VarIndex
n
resultType (TCons name :: QName
name args :: [TypeExpr]
args) = QName -> [TypeExpr] -> TypeExpr
TCons QName
name [TypeExpr]
args
resultType (FuncType _ ran :: TypeExpr
ran) = TypeExpr -> TypeExpr
resultType TypeExpr
ran
resultType (ForallType ns :: [VarIndex]
ns t :: TypeExpr
t) = [VarIndex] -> TypeExpr -> TypeExpr
ForallType [VarIndex]
ns TypeExpr
t

-- |get indexes of all type variables
allVarsInTypeExpr :: TypeExpr -> [TVarIndex]
allVarsInTypeExpr :: TypeExpr -> [VarIndex]
allVarsInTypeExpr = (VarIndex -> [VarIndex])
-> (QName -> [[VarIndex]] -> [VarIndex])
-> ([VarIndex] -> [VarIndex] -> [VarIndex])
-> ([VarIndex] -> [VarIndex] -> [VarIndex])
-> TypeExpr
-> [VarIndex]
forall a.
(VarIndex -> a)
-> (QName -> [a] -> a)
-> (a -> a -> a)
-> ([VarIndex] -> a -> a)
-> TypeExpr
-> a
trTypeExpr (VarIndex -> [VarIndex] -> [VarIndex]
forall a. a -> [a] -> [a]
:[]) (([[VarIndex]] -> [VarIndex]) -> QName -> [[VarIndex]] -> [VarIndex]
forall a b. a -> b -> a
const [[VarIndex]] -> [VarIndex]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) [VarIndex] -> [VarIndex] -> [VarIndex]
forall a. [a] -> [a] -> [a]
(++) [VarIndex] -> [VarIndex] -> [VarIndex]
forall a. [a] -> [a] -> [a]
(++)

-- |yield the list of all contained type constructors
allTypeCons :: TypeExpr -> [QName]
allTypeCons :: TypeExpr -> [QName]
allTypeCons (TVar _) = []
allTypeCons (TCons name :: QName
name args :: [TypeExpr]
args) = QName
name QName -> [QName] -> [QName]
forall a. a -> [a] -> [a]
: (TypeExpr -> [QName]) -> [TypeExpr] -> [QName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TypeExpr -> [QName]
allTypeCons [TypeExpr]
args
allTypeCons (FuncType t1 :: TypeExpr
t1 t2 :: TypeExpr
t2) = TypeExpr -> [QName]
allTypeCons TypeExpr
t1 [QName] -> [QName] -> [QName]
forall a. [a] -> [a] -> [a]
++ TypeExpr -> [QName]
allTypeCons TypeExpr
t2
allTypeCons (ForallType _ t :: TypeExpr
t) = TypeExpr -> [QName]
allTypeCons TypeExpr
t

-- |rename variables in type expression
rnmAllVarsInTypeExpr :: (TVarIndex -> TVarIndex) -> TypeExpr -> TypeExpr
rnmAllVarsInTypeExpr :: (VarIndex -> VarIndex) -> TypeExpr -> TypeExpr
rnmAllVarsInTypeExpr f :: VarIndex -> VarIndex
f = (VarIndex -> TypeExpr) -> TypeExpr -> TypeExpr
updTVars (VarIndex -> TypeExpr
TVar (VarIndex -> TypeExpr)
-> (VarIndex -> VarIndex) -> VarIndex -> TypeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarIndex -> VarIndex
f)

-- |update all qualified names in type expression
updQNamesInTypeExpr :: (QName -> QName) -> TypeExpr -> TypeExpr
updQNamesInTypeExpr :: (QName -> QName) -> TypeExpr -> TypeExpr
updQNamesInTypeExpr f :: QName -> QName
f = (QName -> [TypeExpr] -> TypeExpr) -> TypeExpr -> TypeExpr
updTCons (\name :: QName
name args :: [TypeExpr]
args -> QName -> [TypeExpr] -> TypeExpr
TCons (QName -> QName
f QName
name) [TypeExpr]
args)

-- OpDecl --------------------------------------------------------------------

-- |transform operator declaration
trOp :: (QName -> Fixity -> Integer -> a) -> OpDecl -> a
trOp :: (QName -> Fixity -> Integer -> a) -> OpDecl -> a
trOp op :: QName -> Fixity -> Integer -> a
op (Op name :: QName
name fix :: Fixity
fix prec :: Integer
prec) = QName -> Fixity -> Integer -> a
op QName
name Fixity
fix Integer
prec

-- Selectors

-- |get name from operator declaration
opName :: OpDecl -> QName
opName :: OpDecl -> QName
opName = (QName -> Fixity -> Integer -> QName) -> OpDecl -> QName
forall a. (QName -> Fixity -> Integer -> a) -> OpDecl -> a
trOp (\name :: QName
name _ _ -> QName
name)

-- |get fixity of operator declaration
opFixity :: OpDecl -> Fixity
opFixity :: OpDecl -> Fixity
opFixity = (QName -> Fixity -> Integer -> Fixity) -> OpDecl -> Fixity
forall a. (QName -> Fixity -> Integer -> a) -> OpDecl -> a
trOp (\_ fix :: Fixity
fix _ -> Fixity
fix)

-- |get precedence of operator declaration
opPrecedence :: OpDecl -> Integer
opPrecedence :: OpDecl -> Integer
opPrecedence = (QName -> Fixity -> Integer -> Integer) -> OpDecl -> Integer
forall a. (QName -> Fixity -> Integer -> a) -> OpDecl -> a
trOp (\_ _ prec :: Integer
prec -> Integer
prec)

-- Update Operations

-- |update operator declaration
updOp :: (QName -> QName) ->
         (Fixity -> Fixity) ->
         (Integer -> Integer) -> OpDecl -> OpDecl
updOp :: (QName -> QName)
-> (Fixity -> Fixity) -> (Integer -> Integer) -> OpDecl -> OpDecl
updOp fn :: QName -> QName
fn ff :: Fixity -> Fixity
ff fp :: Integer -> Integer
fp = (QName -> Fixity -> Integer -> OpDecl) -> OpDecl -> OpDecl
forall a. (QName -> Fixity -> Integer -> a) -> OpDecl -> a
trOp QName -> Fixity -> Integer -> OpDecl
op
 where op :: QName -> Fixity -> Integer -> OpDecl
op name :: QName
name fix :: Fixity
fix prec :: Integer
prec = QName -> Fixity -> Integer -> OpDecl
Op (QName -> QName
fn QName
name) (Fixity -> Fixity
ff Fixity
fix) (Integer -> Integer
fp Integer
prec)

-- |update name of operator declaration
updOpName :: Update OpDecl QName
updOpName :: Update OpDecl QName
updOpName f :: QName -> QName
f = (QName -> QName)
-> (Fixity -> Fixity) -> (Integer -> Integer) -> OpDecl -> OpDecl
updOp QName -> QName
f Fixity -> Fixity
forall a. a -> a
id Integer -> Integer
forall a. a -> a
id

-- |update fixity of operator declaration
updOpFixity :: Update OpDecl Fixity
updOpFixity :: Update OpDecl Fixity
updOpFixity f :: Fixity -> Fixity
f = (QName -> QName)
-> (Fixity -> Fixity) -> (Integer -> Integer) -> OpDecl -> OpDecl
updOp QName -> QName
forall a. a -> a
id Fixity -> Fixity
f Integer -> Integer
forall a. a -> a
id

-- |update precedence of operator declaration
updOpPrecedence :: Update OpDecl Integer
updOpPrecedence :: (Integer -> Integer) -> OpDecl -> OpDecl
updOpPrecedence = (QName -> QName)
-> (Fixity -> Fixity) -> (Integer -> Integer) -> OpDecl -> OpDecl
updOp QName -> QName
forall a. a -> a
id Fixity -> Fixity
forall a. a -> a
id

-- FuncDecl ------------------------------------------------------------------

-- |transform function
trFunc :: (QName -> Int -> Visibility -> TypeExpr -> Rule -> a) -> FuncDecl -> a
trFunc :: (QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> a)
-> FuncDecl -> a
trFunc func :: QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> a
func (Func name :: QName
name arity :: VarIndex
arity vis :: Visibility
vis t :: TypeExpr
t rule :: Rule
rule) = QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> a
func QName
name VarIndex
arity Visibility
vis TypeExpr
t Rule
rule

-- Selectors

-- |get name of function
funcName :: FuncDecl -> QName
funcName :: FuncDecl -> QName
funcName = (QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> QName)
-> FuncDecl -> QName
forall a.
(QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> a)
-> FuncDecl -> a
trFunc (\name :: QName
name _ _ _ _ -> QName
name)

-- |get arity of function
funcArity :: FuncDecl -> Int
funcArity :: FuncDecl -> VarIndex
funcArity = (QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> VarIndex)
-> FuncDecl -> VarIndex
forall a.
(QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> a)
-> FuncDecl -> a
trFunc (\_ arity :: VarIndex
arity _ _ _ -> VarIndex
arity)

-- |get visibility of function
funcVisibility :: FuncDecl -> Visibility
funcVisibility :: FuncDecl -> Visibility
funcVisibility = (QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> Visibility)
-> FuncDecl -> Visibility
forall a.
(QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> a)
-> FuncDecl -> a
trFunc (\_ _ vis :: Visibility
vis _ _ -> Visibility
vis)

-- |get type of function
funcType :: FuncDecl -> TypeExpr
funcType :: FuncDecl -> TypeExpr
funcType = (QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> TypeExpr)
-> FuncDecl -> TypeExpr
forall a.
(QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> a)
-> FuncDecl -> a
trFunc (\_ _ _ t :: TypeExpr
t _ -> TypeExpr
t)

-- |get rule of function
funcRule :: FuncDecl -> Rule
funcRule :: FuncDecl -> Rule
funcRule = (QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> Rule)
-> FuncDecl -> Rule
forall a.
(QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> a)
-> FuncDecl -> a
trFunc (\_ _ _ _ rule :: Rule
rule -> Rule
rule)

-- Update Operations

-- |update function
updFunc :: (QName -> QName) ->
           (Int -> Int) ->
           (Visibility -> Visibility) ->
           (TypeExpr -> TypeExpr) ->
           (Rule -> Rule)             -> FuncDecl -> FuncDecl
updFunc :: (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (Rule -> Rule)
-> FuncDecl
-> FuncDecl
updFunc fn :: QName -> QName
fn fa :: VarIndex -> VarIndex
fa fv :: Visibility -> Visibility
fv ft :: TypeExpr -> TypeExpr
ft fr :: Rule -> Rule
fr = (QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> FuncDecl)
-> FuncDecl -> FuncDecl
forall a.
(QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> a)
-> FuncDecl -> a
trFunc QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> FuncDecl
func
 where
  func :: QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> FuncDecl
func name :: QName
name arity :: VarIndex
arity vis :: Visibility
vis t :: TypeExpr
t rule :: Rule
rule
    = QName -> VarIndex -> Visibility -> TypeExpr -> Rule -> FuncDecl
Func (QName -> QName
fn QName
name) (VarIndex -> VarIndex
fa VarIndex
arity) (Visibility -> Visibility
fv Visibility
vis) (TypeExpr -> TypeExpr
ft TypeExpr
t) (Rule -> Rule
fr Rule
rule)

-- |update name of function
updFuncName :: Update FuncDecl QName
updFuncName :: Update FuncDecl QName
updFuncName f :: QName -> QName
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (Rule -> Rule)
-> FuncDecl
-> FuncDecl
updFunc QName -> QName
f VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
forall a. a -> a
id TypeExpr -> TypeExpr
forall a. a -> a
id Rule -> Rule
forall a. a -> a
id

-- |update arity of function
updFuncArity :: Update FuncDecl Int
updFuncArity :: (VarIndex -> VarIndex) -> FuncDecl -> FuncDecl
updFuncArity f :: VarIndex -> VarIndex
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (Rule -> Rule)
-> FuncDecl
-> FuncDecl
updFunc QName -> QName
forall a. a -> a
id VarIndex -> VarIndex
f Visibility -> Visibility
forall a. a -> a
id TypeExpr -> TypeExpr
forall a. a -> a
id Rule -> Rule
forall a. a -> a
id

-- |update visibility of function
updFuncVisibility :: Update FuncDecl Visibility
updFuncVisibility :: Update FuncDecl Visibility
updFuncVisibility f :: Visibility -> Visibility
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (Rule -> Rule)
-> FuncDecl
-> FuncDecl
updFunc QName -> QName
forall a. a -> a
id VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
f TypeExpr -> TypeExpr
forall a. a -> a
id Rule -> Rule
forall a. a -> a
id

-- |update type of function
updFuncType :: Update FuncDecl TypeExpr
updFuncType :: Update FuncDecl TypeExpr
updFuncType f :: TypeExpr -> TypeExpr
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (Rule -> Rule)
-> FuncDecl
-> FuncDecl
updFunc QName -> QName
forall a. a -> a
id VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
forall a. a -> a
id TypeExpr -> TypeExpr
f Rule -> Rule
forall a. a -> a
id

-- |update rule of function
updFuncRule :: Update FuncDecl Rule
updFuncRule :: (Rule -> Rule) -> FuncDecl -> FuncDecl
updFuncRule = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (Rule -> Rule)
-> FuncDecl
-> FuncDecl
updFunc 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?
isPublicFunc :: FuncDecl -> Bool
isPublicFunc :: FuncDecl -> Bool
isPublicFunc = Visibility -> Bool
isPublic (Visibility -> Bool)
-> (FuncDecl -> Visibility) -> FuncDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncDecl -> Visibility
funcVisibility

-- |is function externally defined?
isExternal :: FuncDecl -> Bool
isExternal :: FuncDecl -> Bool
isExternal = Rule -> Bool
isRuleExternal (Rule -> Bool) -> (FuncDecl -> Rule) -> FuncDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncDecl -> Rule
funcRule

-- |get variable names in a function declaration
allVarsInFunc :: FuncDecl -> [VarIndex]
allVarsInFunc :: FuncDecl -> [VarIndex]
allVarsInFunc = Rule -> [VarIndex]
allVarsInRule (Rule -> [VarIndex])
-> (FuncDecl -> Rule) -> FuncDecl -> [VarIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncDecl -> Rule
funcRule

-- |get arguments of function, if not externally defined
funcArgs :: FuncDecl -> [VarIndex]
funcArgs :: FuncDecl -> [VarIndex]
funcArgs = Rule -> [VarIndex]
ruleArgs (Rule -> [VarIndex])
-> (FuncDecl -> Rule) -> FuncDecl -> [VarIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncDecl -> Rule
funcRule

-- |get body of function, if not externally defined
funcBody :: FuncDecl -> Expr
funcBody :: FuncDecl -> Expr
funcBody = Rule -> Expr
ruleBody (Rule -> Expr) -> (FuncDecl -> Rule) -> FuncDecl -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncDecl -> Rule
funcRule

-- |get the right-hand-sides of a 'FuncDecl'
funcRHS :: FuncDecl -> [Expr]
funcRHS :: FuncDecl -> [Expr]
funcRHS f :: FuncDecl
f | Bool -> Bool
not (FuncDecl -> Bool
isExternal FuncDecl
f) = Expr -> [Expr]
orCase (FuncDecl -> Expr
funcBody FuncDecl
f)
          | Bool
otherwise = []
 where
  orCase :: Expr -> [Expr]
orCase e :: Expr
e
    | Expr -> Bool
isOr Expr
e = (Expr -> [Expr]) -> [Expr] -> [Expr]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [Expr]
orCase (Expr -> [Expr]
orExps Expr
e)
    | Expr -> Bool
isCase Expr
e = (Expr -> [Expr]) -> [Expr] -> [Expr]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [Expr]
orCase ((BranchExpr -> Expr) -> [BranchExpr] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map BranchExpr -> Expr
branchExpr (Expr -> [BranchExpr]
caseBranches Expr
e))
    | Bool
otherwise = [Expr
e]

-- |rename all variables in function
rnmAllVarsInFunc :: Update FuncDecl VarIndex
rnmAllVarsInFunc :: (VarIndex -> VarIndex) -> FuncDecl -> FuncDecl
rnmAllVarsInFunc = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (Rule -> Rule)
-> FuncDecl
-> FuncDecl
updFunc 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 ((Rule -> Rule) -> FuncDecl -> FuncDecl)
-> ((VarIndex -> VarIndex) -> Rule -> Rule)
-> (VarIndex -> VarIndex)
-> FuncDecl
-> FuncDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarIndex -> VarIndex) -> Rule -> Rule
rnmAllVarsInRule

-- |update all qualified names in function
updQNamesInFunc :: Update FuncDecl QName
updQNamesInFunc :: Update FuncDecl QName
updQNamesInFunc f :: QName -> QName
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (Rule -> Rule)
-> FuncDecl
-> FuncDecl
updFunc 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 Rule QName
updQNamesInRule QName -> QName
f)

-- |update arguments of function, if not externally defined
updFuncArgs :: Update FuncDecl [VarIndex]
updFuncArgs :: Update FuncDecl [VarIndex]
updFuncArgs = (Rule -> Rule) -> FuncDecl -> FuncDecl
updFuncRule ((Rule -> Rule) -> FuncDecl -> FuncDecl)
-> (([VarIndex] -> [VarIndex]) -> Rule -> Rule)
-> Update FuncDecl [VarIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([VarIndex] -> [VarIndex]) -> Rule -> Rule
updRuleArgs

-- |update body of function, if not externally defined
updFuncBody :: Update FuncDecl Expr
updFuncBody :: (Expr -> Expr) -> FuncDecl -> FuncDecl
updFuncBody = (Rule -> Rule) -> FuncDecl -> FuncDecl
updFuncRule ((Rule -> Rule) -> FuncDecl -> FuncDecl)
-> ((Expr -> Expr) -> Rule -> Rule)
-> (Expr -> Expr)
-> FuncDecl
-> FuncDecl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> Expr) -> Rule -> Rule
updRuleBody

-- Rule ----------------------------------------------------------------------

-- |transform rule
trRule :: ([VarIndex] -> Expr -> a) -> (String -> a) -> Rule -> a
trRule :: ([VarIndex] -> Expr -> a) -> (String -> a) -> Rule -> a
trRule rule :: [VarIndex] -> Expr -> a
rule _ (Rule args :: [VarIndex]
args e :: Expr
e) = [VarIndex] -> Expr -> a
rule [VarIndex]
args Expr
e
trRule _ ext :: String -> a
ext (External s :: String
s) = String -> a
ext String
s

-- Selectors

-- |get rules arguments if it's not external
ruleArgs :: Rule -> [VarIndex]
ruleArgs :: Rule -> [VarIndex]
ruleArgs = ([VarIndex] -> Expr -> [VarIndex])
-> (String -> [VarIndex]) -> Rule -> [VarIndex]
forall a. ([VarIndex] -> Expr -> a) -> (String -> a) -> Rule -> a
trRule (\args :: [VarIndex]
args _ -> [VarIndex]
args) String -> [VarIndex]
forall a. HasCallStack => a
undefined

-- |get rules body if it's not external
ruleBody :: Rule -> Expr
ruleBody :: Rule -> Expr
ruleBody = ([VarIndex] -> Expr -> Expr) -> (String -> Expr) -> Rule -> Expr
forall a. ([VarIndex] -> Expr -> a) -> (String -> a) -> Rule -> a
trRule (\_ e :: Expr
e -> Expr
e) String -> Expr
forall a. HasCallStack => a
undefined

-- |get rules external declaration
ruleExtDecl :: Rule -> String
ruleExtDecl :: Rule -> String
ruleExtDecl = ([VarIndex] -> Expr -> String)
-> (String -> String) -> Rule -> String
forall a. ([VarIndex] -> Expr -> a) -> (String -> a) -> Rule -> a
trRule [VarIndex] -> Expr -> String
forall a. HasCallStack => a
undefined String -> String
forall a. a -> a
id

-- Test Operations

-- |is rule external?
isRuleExternal :: Rule -> Bool
isRuleExternal :: Rule -> Bool
isRuleExternal = ([VarIndex] -> Expr -> Bool) -> (String -> Bool) -> Rule -> Bool
forall a. ([VarIndex] -> Expr -> a) -> (String -> a) -> Rule -> a
trRule (\_ _ -> Bool
False) (\_ -> Bool
True)

-- Update Operations

-- |update rule
updRule :: ([VarIndex] -> [VarIndex]) ->
           (Expr -> Expr) ->
           (String -> String) -> Rule -> Rule
updRule :: ([VarIndex] -> [VarIndex])
-> (Expr -> Expr) -> (String -> String) -> Rule -> Rule
updRule fa :: [VarIndex] -> [VarIndex]
fa fe :: Expr -> Expr
fe fs :: String -> String
fs = ([VarIndex] -> Expr -> Rule) -> (String -> Rule) -> Rule -> Rule
forall a. ([VarIndex] -> Expr -> a) -> (String -> a) -> Rule -> a
trRule [VarIndex] -> Expr -> Rule
rule String -> Rule
ext
 where
  rule :: [VarIndex] -> Expr -> Rule
rule args :: [VarIndex]
args e :: Expr
e = [VarIndex] -> Expr -> Rule
Rule ([VarIndex] -> [VarIndex]
fa [VarIndex]
args) (Expr -> Expr
fe Expr
e)
  ext :: String -> Rule
ext s :: String
s = String -> Rule
External (String -> String
fs String
s)

-- |update rules arguments
updRuleArgs :: Update Rule [VarIndex]
updRuleArgs :: ([VarIndex] -> [VarIndex]) -> Rule -> Rule
updRuleArgs f :: [VarIndex] -> [VarIndex]
f = ([VarIndex] -> [VarIndex])
-> (Expr -> Expr) -> (String -> String) -> Rule -> Rule
updRule [VarIndex] -> [VarIndex]
f Expr -> Expr
forall a. a -> a
id String -> String
forall a. a -> a
id

-- |update rules body
updRuleBody :: Update Rule Expr
updRuleBody :: (Expr -> Expr) -> Rule -> Rule
updRuleBody f :: Expr -> Expr
f = ([VarIndex] -> [VarIndex])
-> (Expr -> Expr) -> (String -> String) -> Rule -> Rule
updRule [VarIndex] -> [VarIndex]
forall a. a -> a
id Expr -> Expr
f String -> String
forall a. a -> a
id

-- |update rules external declaration
updRuleExtDecl :: Update Rule String
updRuleExtDecl :: (String -> String) -> Rule -> Rule
updRuleExtDecl f :: String -> String
f = ([VarIndex] -> [VarIndex])
-> (Expr -> Expr) -> (String -> String) -> Rule -> Rule
updRule [VarIndex] -> [VarIndex]
forall a. a -> a
id Expr -> Expr
forall a. a -> a
id String -> String
f

-- Auxiliary Functions

-- |get variable names in a functions rule
allVarsInRule :: Rule -> [VarIndex]
allVarsInRule :: Rule -> [VarIndex]
allVarsInRule = ([VarIndex] -> Expr -> [VarIndex])
-> (String -> [VarIndex]) -> Rule -> [VarIndex]
forall a. ([VarIndex] -> Expr -> a) -> (String -> a) -> Rule -> a
trRule (\args :: [VarIndex]
args body :: Expr
body -> [VarIndex]
args [VarIndex] -> [VarIndex] -> [VarIndex]
forall a. [a] -> [a] -> [a]
++ Expr -> [VarIndex]
allVars Expr
body) (\_ -> [])

-- |rename all variables in rule
rnmAllVarsInRule :: Update Rule VarIndex
rnmAllVarsInRule :: (VarIndex -> VarIndex) -> Rule -> Rule
rnmAllVarsInRule f :: VarIndex -> VarIndex
f = ([VarIndex] -> [VarIndex])
-> (Expr -> Expr) -> (String -> String) -> Rule -> Rule
updRule ((VarIndex -> VarIndex) -> [VarIndex] -> [VarIndex]
forall a b. (a -> b) -> [a] -> [b]
map VarIndex -> VarIndex
f) (Update Expr VarIndex
rnmAllVars VarIndex -> VarIndex
f) String -> String
forall a. a -> a
id

-- |update all qualified names in rule
updQNamesInRule :: Update Rule QName
updQNamesInRule :: Update Rule QName
updQNamesInRule = (Expr -> Expr) -> Rule -> Rule
updRuleBody ((Expr -> Expr) -> Rule -> Rule)
-> ((QName -> QName) -> Expr -> Expr) -> Update Rule QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> QName) -> Expr -> Expr
updQNames

-- CombType ------------------------------------------------------------------

-- |transform combination type
trCombType :: a -> (Int -> a) -> a -> (Int -> a) -> CombType -> a
trCombType :: a -> (VarIndex -> a) -> a -> (VarIndex -> a) -> CombType -> a
trCombType fc :: a
fc _ _ _ FuncCall = a
fc
trCombType _ fpc :: VarIndex -> a
fpc _ _ (FuncPartCall n :: VarIndex
n) = VarIndex -> a
fpc VarIndex
n
trCombType _ _ cc :: a
cc _ ConsCall = a
cc
trCombType _ _ _ cpc :: VarIndex -> a
cpc (ConsPartCall n :: VarIndex
n) = VarIndex -> a
cpc VarIndex
n

-- Test Operations

-- |is type of combination FuncCall?
isCombTypeFuncCall :: CombType -> Bool
isCombTypeFuncCall :: CombType -> Bool
isCombTypeFuncCall = Bool
-> (VarIndex -> Bool)
-> Bool
-> (VarIndex -> Bool)
-> CombType
-> Bool
forall a.
a -> (VarIndex -> a) -> a -> (VarIndex -> a) -> CombType -> a
trCombType Bool
True (\_ -> Bool
False) Bool
False (\_ -> Bool
False)

-- |is type of combination FuncPartCall?
isCombTypeFuncPartCall :: CombType -> Bool
isCombTypeFuncPartCall :: CombType -> Bool
isCombTypeFuncPartCall = Bool
-> (VarIndex -> Bool)
-> Bool
-> (VarIndex -> Bool)
-> CombType
-> Bool
forall a.
a -> (VarIndex -> a) -> a -> (VarIndex -> a) -> CombType -> a
trCombType Bool
False (\_ -> Bool
True) Bool
False (\_ -> Bool
False)

-- |is type of combination ConsCall?
isCombTypeConsCall :: CombType -> Bool
isCombTypeConsCall :: CombType -> Bool
isCombTypeConsCall = Bool
-> (VarIndex -> Bool)
-> Bool
-> (VarIndex -> Bool)
-> CombType
-> Bool
forall a.
a -> (VarIndex -> a) -> a -> (VarIndex -> a) -> CombType -> a
trCombType Bool
False (\_ -> Bool
False) Bool
True (\_ -> Bool
False)

-- |is type of combination ConsPartCall?
isCombTypeConsPartCall :: CombType -> Bool
isCombTypeConsPartCall :: CombType -> Bool
isCombTypeConsPartCall = Bool
-> (VarIndex -> Bool)
-> Bool
-> (VarIndex -> Bool)
-> CombType
-> Bool
forall a.
a -> (VarIndex -> a) -> a -> (VarIndex -> a) -> CombType -> a
trCombType Bool
False (\_ -> Bool
False) Bool
False (\_ -> Bool
True)

-- Expr ----------------------------------------------------------------------

-- Selectors

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

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

-- |get combination type of a combined expression
combType :: Expr -> CombType
combType :: Expr -> CombType
combType (Comb 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.Goodies.combType: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                 "no combined expression"

-- |get name of a combined expression
combName :: Expr -> QName
combName :: Expr -> QName
combName (Comb _ 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.Goodies.combName: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                 "no combined expression"

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

-- |get number of missing arguments if expression is combined
missingCombArgs :: Expr -> Int
missingCombArgs :: Expr -> VarIndex
missingCombArgs = CombType -> VarIndex
missingArgs (CombType -> VarIndex) -> (Expr -> CombType) -> Expr -> VarIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> 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 varoables in let declaration
letBinds :: Expr -> [(VarIndex,Expr)]
letBinds :: Expr -> [(VarIndex, Expr)]
letBinds (Let vs :: [(VarIndex, Expr)]
vs _) = [(VarIndex, Expr)]
vs
letBinds _          = String -> [(VarIndex, Expr)]
forall a. HasCallStack => String -> a
error (String -> [(VarIndex, Expr)]) -> String -> [(VarIndex, Expr)]
forall a b. (a -> b) -> a -> b
$ "Curry.FlatCurry.Goodies.letBinds: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                              "no let expression"

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

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

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

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

-- |get case-type of case expression
caseType :: Expr -> CaseType
caseType :: Expr -> CaseType
caseType (Case 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.Goodies.caseType: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                   "no case expression"

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


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

-- Test Operations

-- |is expression a variable?
isVar :: Expr -> Bool
isVar :: Expr -> Bool
isVar e :: Expr
e = case Expr
e of
  Var _ -> Bool
True
  _ -> Bool
False

-- |is expression a literal expression?
isLit :: Expr -> Bool
isLit :: Expr -> Bool
isLit e :: Expr
e = case Expr
e of
  Lit _ -> Bool
True
  _ -> Bool
False

-- |is expression combined?
isComb :: Expr -> Bool
isComb :: Expr -> Bool
isComb e :: Expr
e = case Expr
e of
  Comb _ _ _ -> Bool
True
  _ -> Bool
False

-- |is expression a let expression?
isLet :: Expr -> Bool
isLet :: Expr -> Bool
isLet e :: Expr
e = case Expr
e of
  Let _ _ -> Bool
True
  _ -> Bool
False

-- |is expression a declaration of free variables?
isFree :: Expr -> Bool
isFree :: Expr -> Bool
isFree e :: Expr
e = case Expr
e of
  Free _ _ -> Bool
True
  _ -> Bool
False

-- |is expression an or-expression?
isOr :: Expr -> Bool
isOr :: Expr -> Bool
isOr e :: Expr
e = case Expr
e of
  Or _ _ -> Bool
True
  _ -> Bool
False

-- |is expression a case expression?
isCase :: Expr -> Bool
isCase :: Expr -> Bool
isCase e :: Expr
e = case Expr
e of
  Case _ _ _ -> Bool
True
  _ -> Bool
False

-- |transform expression
trExpr  :: (VarIndex -> a)
        -> (Literal -> a)
        -> (CombType -> QName -> [a] -> a)
        -> ([(VarIndex, a)] -> a -> a)
        -> ([VarIndex] -> a -> a)
        -> (a -> a -> a)
        -> (CaseType -> a -> [b] -> a)
        -> (Pattern -> a -> b)
        -> (a -> TypeExpr -> a)
        -> Expr
        -> a
trExpr :: (VarIndex -> a)
-> (Literal -> a)
-> (CombType -> QName -> [a] -> a)
-> ([(VarIndex, a)] -> a -> a)
-> ([VarIndex] -> a -> a)
-> (a -> a -> a)
-> (CaseType -> a -> [b] -> a)
-> (Pattern -> a -> b)
-> (a -> TypeExpr -> a)
-> Expr
-> a
trExpr var :: VarIndex -> a
var lit :: Literal -> a
lit comb :: CombType -> QName -> [a] -> a
comb lt :: [(VarIndex, a)] -> a -> a
lt fr :: [VarIndex] -> a -> a
fr oR :: a -> a -> a
oR cas :: CaseType -> a -> [b] -> a
cas branch :: Pattern -> a -> b
branch typed :: a -> TypeExpr -> a
typed expr :: Expr
expr = case Expr
expr of
  Var n :: VarIndex
n             -> VarIndex -> a
var VarIndex
n
  Lit l :: Literal
l             -> Literal -> a
lit Literal
l
  Comb ct :: CombType
ct name :: QName
name args :: [Expr]
args -> CombType -> QName -> [a] -> a
comb CombType
ct QName
name ((Expr -> a) -> [Expr] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> a
f [Expr]
args)
  Let bs :: [(VarIndex, Expr)]
bs e :: Expr
e          -> [(VarIndex, a)] -> a -> a
lt (((VarIndex, Expr) -> (VarIndex, a))
-> [(VarIndex, Expr)] -> [(VarIndex, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(v :: VarIndex
v, x :: Expr
x) -> (VarIndex
v, Expr -> a
f Expr
x)) [(VarIndex, Expr)]
bs) (Expr -> a
f Expr
e)
  Free vs :: [VarIndex]
vs e :: Expr
e         -> [VarIndex] -> a -> a
fr [VarIndex]
vs (Expr -> a
f Expr
e)
  Or e1 :: Expr
e1 e2 :: Expr
e2          -> a -> a -> a
oR (Expr -> a
f Expr
e1) (Expr -> a
f Expr
e2)
  Case ct :: CaseType
ct e :: Expr
e bs :: [BranchExpr]
bs      -> CaseType -> a -> [b] -> a
cas CaseType
ct (Expr -> a
f Expr
e) ((BranchExpr -> b) -> [BranchExpr] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (\ (Branch p :: Pattern
p e' :: Expr
e') -> Pattern -> a -> b
branch Pattern
p (Expr -> a
f Expr
e')) [BranchExpr]
bs)
  Typed e :: Expr
e ty :: TypeExpr
ty        -> a -> TypeExpr -> a
typed (Expr -> a
f Expr
e) TypeExpr
ty
  where
  f :: Expr -> a
f = (VarIndex -> a)
-> (Literal -> a)
-> (CombType -> QName -> [a] -> a)
-> ([(VarIndex, a)] -> a -> a)
-> ([VarIndex] -> a -> a)
-> (a -> a -> a)
-> (CaseType -> a -> [b] -> a)
-> (Pattern -> a -> b)
-> (a -> TypeExpr -> a)
-> Expr
-> a
forall a b.
(VarIndex -> a)
-> (Literal -> a)
-> (CombType -> QName -> [a] -> a)
-> ([(VarIndex, a)] -> a -> a)
-> ([VarIndex] -> a -> a)
-> (a -> a -> a)
-> (CaseType -> a -> [b] -> a)
-> (Pattern -> a -> b)
-> (a -> TypeExpr -> a)
-> Expr
-> a
trExpr VarIndex -> a
var Literal -> a
lit CombType -> QName -> [a] -> a
comb [(VarIndex, a)] -> a -> a
lt [VarIndex] -> a -> a
fr a -> a -> a
oR CaseType -> a -> [b] -> a
cas Pattern -> a -> b
branch a -> TypeExpr -> a
typed

-- Update Operations

-- |update all variables in given expression
updVars :: (VarIndex -> Expr) -> Expr -> Expr
updVars :: (VarIndex -> Expr) -> Expr -> Expr
updVars var :: VarIndex -> Expr
var = (VarIndex -> Expr)
-> (Literal -> Expr)
-> (CombType -> QName -> [Expr] -> Expr)
-> ([(VarIndex, Expr)] -> Expr -> Expr)
-> ([VarIndex] -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> (CaseType -> Expr -> [BranchExpr] -> Expr)
-> (Pattern -> Expr -> BranchExpr)
-> (Expr -> TypeExpr -> Expr)
-> Expr
-> Expr
forall a b.
(VarIndex -> a)
-> (Literal -> a)
-> (CombType -> QName -> [a] -> a)
-> ([(VarIndex, a)] -> a -> a)
-> ([VarIndex] -> a -> a)
-> (a -> a -> a)
-> (CaseType -> a -> [b] -> a)
-> (Pattern -> a -> b)
-> (a -> TypeExpr -> a)
-> Expr
-> a
trExpr VarIndex -> Expr
var Literal -> Expr
Lit CombType -> QName -> [Expr] -> Expr
Comb [(VarIndex, Expr)] -> Expr -> Expr
Let [VarIndex] -> Expr -> Expr
Free Expr -> Expr -> Expr
Or CaseType -> Expr -> [BranchExpr] -> Expr
Case Pattern -> Expr -> BranchExpr
Branch Expr -> TypeExpr -> Expr
Typed

-- |update all literals in given expression
updLiterals :: (Literal -> Expr) -> Expr -> Expr
updLiterals :: (Literal -> Expr) -> Expr -> Expr
updLiterals lit :: Literal -> Expr
lit = (VarIndex -> Expr)
-> (Literal -> Expr)
-> (CombType -> QName -> [Expr] -> Expr)
-> ([(VarIndex, Expr)] -> Expr -> Expr)
-> ([VarIndex] -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> (CaseType -> Expr -> [BranchExpr] -> Expr)
-> (Pattern -> Expr -> BranchExpr)
-> (Expr -> TypeExpr -> Expr)
-> Expr
-> Expr
forall a b.
(VarIndex -> a)
-> (Literal -> a)
-> (CombType -> QName -> [a] -> a)
-> ([(VarIndex, a)] -> a -> a)
-> ([VarIndex] -> a -> a)
-> (a -> a -> a)
-> (CaseType -> a -> [b] -> a)
-> (Pattern -> a -> b)
-> (a -> TypeExpr -> a)
-> Expr
-> a
trExpr VarIndex -> Expr
Var Literal -> Expr
lit CombType -> QName -> [Expr] -> Expr
Comb [(VarIndex, Expr)] -> Expr -> Expr
Let [VarIndex] -> Expr -> Expr
Free Expr -> Expr -> Expr
Or CaseType -> Expr -> [BranchExpr] -> Expr
Case Pattern -> Expr -> BranchExpr
Branch Expr -> TypeExpr -> Expr
Typed

-- |update all combined expressions in given expression
updCombs :: (CombType -> QName -> [Expr] -> Expr) -> Expr -> Expr
updCombs :: (CombType -> QName -> [Expr] -> Expr) -> Expr -> Expr
updCombs comb :: CombType -> QName -> [Expr] -> Expr
comb = (VarIndex -> Expr)
-> (Literal -> Expr)
-> (CombType -> QName -> [Expr] -> Expr)
-> ([(VarIndex, Expr)] -> Expr -> Expr)
-> ([VarIndex] -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> (CaseType -> Expr -> [BranchExpr] -> Expr)
-> (Pattern -> Expr -> BranchExpr)
-> (Expr -> TypeExpr -> Expr)
-> Expr
-> Expr
forall a b.
(VarIndex -> a)
-> (Literal -> a)
-> (CombType -> QName -> [a] -> a)
-> ([(VarIndex, a)] -> a -> a)
-> ([VarIndex] -> a -> a)
-> (a -> a -> a)
-> (CaseType -> a -> [b] -> a)
-> (Pattern -> a -> b)
-> (a -> TypeExpr -> a)
-> Expr
-> a
trExpr VarIndex -> Expr
Var Literal -> Expr
Lit CombType -> QName -> [Expr] -> Expr
comb [(VarIndex, Expr)] -> Expr -> Expr
Let [VarIndex] -> Expr -> Expr
Free Expr -> Expr -> Expr
Or CaseType -> Expr -> [BranchExpr] -> Expr
Case Pattern -> Expr -> BranchExpr
Branch Expr -> TypeExpr -> Expr
Typed

-- |update all let expressions in given expression
updLets :: ([(VarIndex,Expr)] -> Expr -> Expr) -> Expr -> Expr
updLets :: ([(VarIndex, Expr)] -> Expr -> Expr) -> Expr -> Expr
updLets lt :: [(VarIndex, Expr)] -> Expr -> Expr
lt = (VarIndex -> Expr)
-> (Literal -> Expr)
-> (CombType -> QName -> [Expr] -> Expr)
-> ([(VarIndex, Expr)] -> Expr -> Expr)
-> ([VarIndex] -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> (CaseType -> Expr -> [BranchExpr] -> Expr)
-> (Pattern -> Expr -> BranchExpr)
-> (Expr -> TypeExpr -> Expr)
-> Expr
-> Expr
forall a b.
(VarIndex -> a)
-> (Literal -> a)
-> (CombType -> QName -> [a] -> a)
-> ([(VarIndex, a)] -> a -> a)
-> ([VarIndex] -> a -> a)
-> (a -> a -> a)
-> (CaseType -> a -> [b] -> a)
-> (Pattern -> a -> b)
-> (a -> TypeExpr -> a)
-> Expr
-> a
trExpr VarIndex -> Expr
Var Literal -> Expr
Lit CombType -> QName -> [Expr] -> Expr
Comb [(VarIndex, Expr)] -> Expr -> Expr
lt [VarIndex] -> Expr -> Expr
Free Expr -> Expr -> Expr
Or CaseType -> Expr -> [BranchExpr] -> Expr
Case Pattern -> Expr -> BranchExpr
Branch Expr -> TypeExpr -> Expr
Typed

-- |update all free declarations in given expression
updFrees :: ([VarIndex] -> Expr -> Expr) -> Expr -> Expr
updFrees :: ([VarIndex] -> Expr -> Expr) -> Expr -> Expr
updFrees fr :: [VarIndex] -> Expr -> Expr
fr = (VarIndex -> Expr)
-> (Literal -> Expr)
-> (CombType -> QName -> [Expr] -> Expr)
-> ([(VarIndex, Expr)] -> Expr -> Expr)
-> ([VarIndex] -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> (CaseType -> Expr -> [BranchExpr] -> Expr)
-> (Pattern -> Expr -> BranchExpr)
-> (Expr -> TypeExpr -> Expr)
-> Expr
-> Expr
forall a b.
(VarIndex -> a)
-> (Literal -> a)
-> (CombType -> QName -> [a] -> a)
-> ([(VarIndex, a)] -> a -> a)
-> ([VarIndex] -> a -> a)
-> (a -> a -> a)
-> (CaseType -> a -> [b] -> a)
-> (Pattern -> a -> b)
-> (a -> TypeExpr -> a)
-> Expr
-> a
trExpr VarIndex -> Expr
Var Literal -> Expr
Lit CombType -> QName -> [Expr] -> Expr
Comb [(VarIndex, Expr)] -> Expr -> Expr
Let [VarIndex] -> Expr -> Expr
fr Expr -> Expr -> Expr
Or CaseType -> Expr -> [BranchExpr] -> Expr
Case Pattern -> Expr -> BranchExpr
Branch Expr -> TypeExpr -> Expr
Typed

-- |update all or expressions in given expression
updOrs :: (Expr -> Expr -> Expr) -> Expr -> Expr
updOrs :: (Expr -> Expr -> Expr) -> Expr -> Expr
updOrs oR :: Expr -> Expr -> Expr
oR = (VarIndex -> Expr)
-> (Literal -> Expr)
-> (CombType -> QName -> [Expr] -> Expr)
-> ([(VarIndex, Expr)] -> Expr -> Expr)
-> ([VarIndex] -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> (CaseType -> Expr -> [BranchExpr] -> Expr)
-> (Pattern -> Expr -> BranchExpr)
-> (Expr -> TypeExpr -> Expr)
-> Expr
-> Expr
forall a b.
(VarIndex -> a)
-> (Literal -> a)
-> (CombType -> QName -> [a] -> a)
-> ([(VarIndex, a)] -> a -> a)
-> ([VarIndex] -> a -> a)
-> (a -> a -> a)
-> (CaseType -> a -> [b] -> a)
-> (Pattern -> a -> b)
-> (a -> TypeExpr -> a)
-> Expr
-> a
trExpr VarIndex -> Expr
Var Literal -> Expr
Lit CombType -> QName -> [Expr] -> Expr
Comb [(VarIndex, Expr)] -> Expr -> Expr
Let [VarIndex] -> Expr -> Expr
Free Expr -> Expr -> Expr
oR CaseType -> Expr -> [BranchExpr] -> Expr
Case Pattern -> Expr -> BranchExpr
Branch Expr -> TypeExpr -> Expr
Typed

-- |update all case expressions in given expression
updCases :: (CaseType -> Expr -> [BranchExpr] -> Expr) -> Expr -> Expr
updCases :: (CaseType -> Expr -> [BranchExpr] -> Expr) -> Expr -> Expr
updCases cas :: CaseType -> Expr -> [BranchExpr] -> Expr
cas = (VarIndex -> Expr)
-> (Literal -> Expr)
-> (CombType -> QName -> [Expr] -> Expr)
-> ([(VarIndex, Expr)] -> Expr -> Expr)
-> ([VarIndex] -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> (CaseType -> Expr -> [BranchExpr] -> Expr)
-> (Pattern -> Expr -> BranchExpr)
-> (Expr -> TypeExpr -> Expr)
-> Expr
-> Expr
forall a b.
(VarIndex -> a)
-> (Literal -> a)
-> (CombType -> QName -> [a] -> a)
-> ([(VarIndex, a)] -> a -> a)
-> ([VarIndex] -> a -> a)
-> (a -> a -> a)
-> (CaseType -> a -> [b] -> a)
-> (Pattern -> a -> b)
-> (a -> TypeExpr -> a)
-> Expr
-> a
trExpr VarIndex -> Expr
Var Literal -> Expr
Lit CombType -> QName -> [Expr] -> Expr
Comb [(VarIndex, Expr)] -> Expr -> Expr
Let [VarIndex] -> Expr -> Expr
Free Expr -> Expr -> Expr
Or CaseType -> Expr -> [BranchExpr] -> Expr
cas Pattern -> Expr -> BranchExpr
Branch Expr -> TypeExpr -> Expr
Typed

-- |update all case branches in given expression
updBranches :: (Pattern -> Expr -> BranchExpr) -> Expr -> Expr
updBranches :: (Pattern -> Expr -> BranchExpr) -> Expr -> Expr
updBranches branch :: Pattern -> Expr -> BranchExpr
branch = (VarIndex -> Expr)
-> (Literal -> Expr)
-> (CombType -> QName -> [Expr] -> Expr)
-> ([(VarIndex, Expr)] -> Expr -> Expr)
-> ([VarIndex] -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> (CaseType -> Expr -> [BranchExpr] -> Expr)
-> (Pattern -> Expr -> BranchExpr)
-> (Expr -> TypeExpr -> Expr)
-> Expr
-> Expr
forall a b.
(VarIndex -> a)
-> (Literal -> a)
-> (CombType -> QName -> [a] -> a)
-> ([(VarIndex, a)] -> a -> a)
-> ([VarIndex] -> a -> a)
-> (a -> a -> a)
-> (CaseType -> a -> [b] -> a)
-> (Pattern -> a -> b)
-> (a -> TypeExpr -> a)
-> Expr
-> a
trExpr VarIndex -> Expr
Var Literal -> Expr
Lit CombType -> QName -> [Expr] -> Expr
Comb [(VarIndex, Expr)] -> Expr -> Expr
Let [VarIndex] -> Expr -> Expr
Free Expr -> Expr -> Expr
Or CaseType -> Expr -> [BranchExpr] -> Expr
Case Pattern -> Expr -> BranchExpr
branch Expr -> TypeExpr -> Expr
Typed

-- |update all typed expressions in given expression
updTypeds :: (Expr -> TypeExpr -> Expr) -> Expr -> Expr
updTypeds :: (Expr -> TypeExpr -> Expr) -> Expr -> Expr
updTypeds = (VarIndex -> Expr)
-> (Literal -> Expr)
-> (CombType -> QName -> [Expr] -> Expr)
-> ([(VarIndex, Expr)] -> Expr -> Expr)
-> ([VarIndex] -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> (CaseType -> Expr -> [BranchExpr] -> Expr)
-> (Pattern -> Expr -> BranchExpr)
-> (Expr -> TypeExpr -> Expr)
-> Expr
-> Expr
forall a b.
(VarIndex -> a)
-> (Literal -> a)
-> (CombType -> QName -> [a] -> a)
-> ([(VarIndex, a)] -> a -> a)
-> ([VarIndex] -> a -> a)
-> (a -> a -> a)
-> (CaseType -> a -> [b] -> a)
-> (Pattern -> a -> b)
-> (a -> TypeExpr -> a)
-> Expr
-> a
trExpr VarIndex -> Expr
Var Literal -> Expr
Lit CombType -> QName -> [Expr] -> Expr
Comb [(VarIndex, Expr)] -> Expr -> Expr
Let [VarIndex] -> Expr -> Expr
Free Expr -> Expr -> Expr
Or CaseType -> Expr -> [BranchExpr] -> Expr
Case Pattern -> Expr -> BranchExpr
Branch

-- Auxiliary Functions

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

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

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

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

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

-- |get all variables (also pattern variables) in expression
allVars :: Expr -> [VarIndex]
allVars :: Expr -> [VarIndex]
allVars e :: Expr
e = (VarIndex -> [VarIndex] -> [VarIndex])
-> (Literal -> [VarIndex] -> [VarIndex])
-> (CombType
    -> QName -> [[VarIndex] -> [VarIndex]] -> [VarIndex] -> [VarIndex])
-> ([(VarIndex, [VarIndex] -> [VarIndex])]
    -> ([VarIndex] -> [VarIndex]) -> [VarIndex] -> [VarIndex])
-> ([VarIndex]
    -> ([VarIndex] -> [VarIndex]) -> [VarIndex] -> [VarIndex])
-> (([VarIndex] -> [VarIndex])
    -> ([VarIndex] -> [VarIndex]) -> [VarIndex] -> [VarIndex])
-> (CaseType
    -> ([VarIndex] -> [VarIndex])
    -> [[VarIndex] -> [VarIndex]]
    -> [VarIndex]
    -> [VarIndex])
-> (Pattern
    -> ([VarIndex] -> [VarIndex]) -> [VarIndex] -> [VarIndex])
-> (([VarIndex] -> [VarIndex])
    -> TypeExpr -> [VarIndex] -> [VarIndex])
-> Expr
-> [VarIndex]
-> [VarIndex]
forall a b.
(VarIndex -> a)
-> (Literal -> a)
-> (CombType -> QName -> [a] -> a)
-> ([(VarIndex, a)] -> a -> a)
-> ([VarIndex] -> a -> a)
-> (a -> a -> a)
-> (CaseType -> a -> [b] -> a)
-> (Pattern -> a -> b)
-> (a -> TypeExpr -> a)
-> Expr
-> a
trExpr (:) (([VarIndex] -> [VarIndex]) -> Literal -> [VarIndex] -> [VarIndex]
forall a b. a -> b -> a
const [VarIndex] -> [VarIndex]
forall a. a -> a
id) CombType
-> QName -> [[VarIndex] -> [VarIndex]] -> [VarIndex] -> [VarIndex]
forall (t :: * -> *) p p b.
Foldable t =>
p -> p -> t (b -> b) -> b -> b
comb [(VarIndex, [VarIndex] -> [VarIndex])]
-> ([VarIndex] -> [VarIndex]) -> [VarIndex] -> [VarIndex]
forall a c. [(a, [a] -> [a])] -> ([a] -> c) -> [a] -> c
lt [VarIndex]
-> ([VarIndex] -> [VarIndex]) -> [VarIndex] -> [VarIndex]
forall a a. [a] -> (a -> [a]) -> a -> [a]
fr ([VarIndex] -> [VarIndex])
-> ([VarIndex] -> [VarIndex]) -> [VarIndex] -> [VarIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) CaseType
-> ([VarIndex] -> [VarIndex])
-> [[VarIndex] -> [VarIndex]]
-> [VarIndex]
-> [VarIndex]
forall (t :: * -> *) p b c.
Foldable t =>
p -> (b -> c) -> t (b -> b) -> b -> c
cas Pattern -> ([VarIndex] -> [VarIndex]) -> [VarIndex] -> [VarIndex]
forall a. Pattern -> (a -> [VarIndex]) -> a -> [VarIndex]
branch ([VarIndex] -> [VarIndex]) -> TypeExpr -> [VarIndex] -> [VarIndex]
forall a b. a -> b -> a
const Expr
e []
 where
  comb :: 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 :: Pattern -> (a -> [VarIndex]) -> a -> [VarIndex]
branch pat :: Pattern
pat e' :: a -> [VarIndex]
e' = ((Pattern -> [VarIndex]
args Pattern
pat)[VarIndex] -> [VarIndex] -> [VarIndex]
forall a. [a] -> [a] -> [a]
++) ([VarIndex] -> [VarIndex]) -> (a -> [VarIndex]) -> a -> [VarIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [VarIndex]
e'
  args :: Pattern -> [VarIndex]
args pat :: Pattern
pat | Pattern -> Bool
isConsPattern Pattern
pat = Pattern -> [VarIndex]
patArgs Pattern
pat
           | Bool
otherwise = []

-- |rename all variables (also in patterns) in expression
rnmAllVars :: Update Expr VarIndex
rnmAllVars :: Update Expr VarIndex
rnmAllVars f :: VarIndex -> VarIndex
f = (VarIndex -> Expr)
-> (Literal -> Expr)
-> (CombType -> QName -> [Expr] -> Expr)
-> ([(VarIndex, Expr)] -> Expr -> Expr)
-> ([VarIndex] -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> (CaseType -> Expr -> [BranchExpr] -> Expr)
-> (Pattern -> Expr -> BranchExpr)
-> (Expr -> TypeExpr -> Expr)
-> Expr
-> Expr
forall a b.
(VarIndex -> a)
-> (Literal -> a)
-> (CombType -> QName -> [a] -> a)
-> ([(VarIndex, a)] -> a -> a)
-> ([VarIndex] -> a -> a)
-> (a -> a -> a)
-> (CaseType -> a -> [b] -> a)
-> (Pattern -> a -> b)
-> (a -> TypeExpr -> a)
-> Expr
-> a
trExpr (VarIndex -> Expr
Var (VarIndex -> Expr) -> (VarIndex -> VarIndex) -> VarIndex -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarIndex -> VarIndex
f) Literal -> Expr
Lit CombType -> QName -> [Expr] -> Expr
Comb [(VarIndex, Expr)] -> Expr -> Expr
lt ([VarIndex] -> Expr -> Expr
Free ([VarIndex] -> Expr -> Expr)
-> ([VarIndex] -> [VarIndex]) -> [VarIndex] -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarIndex -> VarIndex) -> [VarIndex] -> [VarIndex]
forall a b. (a -> b) -> [a] -> [b]
map VarIndex -> VarIndex
f) Expr -> Expr -> Expr
Or CaseType -> Expr -> [BranchExpr] -> Expr
Case Pattern -> Expr -> BranchExpr
branch Expr -> TypeExpr -> Expr
Typed
 where
   lt :: [(VarIndex, Expr)] -> Expr -> Expr
lt = [(VarIndex, Expr)] -> Expr -> Expr
Let ([(VarIndex, Expr)] -> Expr -> Expr)
-> ([(VarIndex, Expr)] -> [(VarIndex, Expr)])
-> [(VarIndex, Expr)]
-> Expr
-> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VarIndex, Expr) -> (VarIndex, Expr))
-> [(VarIndex, Expr)] -> [(VarIndex, Expr)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (n :: VarIndex
n,e :: Expr
e) -> (VarIndex -> VarIndex
f VarIndex
n,Expr
e))
   branch :: Pattern -> Expr -> BranchExpr
branch = Pattern -> Expr -> BranchExpr
Branch (Pattern -> Expr -> BranchExpr)
-> (Pattern -> Pattern) -> Pattern -> Expr -> BranchExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([VarIndex] -> [VarIndex]) -> Pattern -> Pattern
updPatArgs ((VarIndex -> VarIndex) -> [VarIndex] -> [VarIndex]
forall a b. (a -> b) -> [a] -> [b]
map VarIndex -> VarIndex
f)

-- |update all qualified names in expression
updQNames :: Update Expr QName
updQNames :: (QName -> QName) -> Expr -> Expr
updQNames f :: QName -> QName
f = (VarIndex -> Expr)
-> (Literal -> Expr)
-> (CombType -> QName -> [Expr] -> Expr)
-> ([(VarIndex, Expr)] -> Expr -> Expr)
-> ([VarIndex] -> Expr -> Expr)
-> (Expr -> Expr -> Expr)
-> (CaseType -> Expr -> [BranchExpr] -> Expr)
-> (Pattern -> Expr -> BranchExpr)
-> (Expr -> TypeExpr -> Expr)
-> Expr
-> Expr
forall a b.
(VarIndex -> a)
-> (Literal -> a)
-> (CombType -> QName -> [a] -> a)
-> ([(VarIndex, a)] -> a -> a)
-> ([VarIndex] -> a -> a)
-> (a -> a -> a)
-> (CaseType -> a -> [b] -> a)
-> (Pattern -> a -> b)
-> (a -> TypeExpr -> a)
-> Expr
-> a
trExpr VarIndex -> Expr
Var Literal -> Expr
Lit CombType -> QName -> [Expr] -> Expr
comb [(VarIndex, Expr)] -> Expr -> Expr
Let [VarIndex] -> Expr -> Expr
Free Expr -> Expr -> Expr
Or CaseType -> Expr -> [BranchExpr] -> Expr
Case (Pattern -> Expr -> BranchExpr
Branch (Pattern -> Expr -> BranchExpr)
-> (Pattern -> Pattern) -> Pattern -> Expr -> BranchExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> QName) -> Pattern -> Pattern
updPatCons QName -> QName
f) Expr -> TypeExpr -> Expr
Typed
 where
  comb :: CombType -> QName -> [Expr] -> Expr
comb ct :: CombType
ct name :: QName
name args :: [Expr]
args = CombType -> QName -> [Expr] -> Expr
Comb CombType
ct (QName -> QName
f QName
name) [Expr]
args

-- BranchExpr ----------------------------------------------------------------

-- |transform branch expression
trBranch :: (Pattern -> Expr -> a) -> BranchExpr -> a
trBranch :: (Pattern -> Expr -> a) -> BranchExpr -> a
trBranch branch :: Pattern -> Expr -> a
branch (Branch pat :: Pattern
pat e :: Expr
e) = Pattern -> Expr -> a
branch Pattern
pat Expr
e

-- Selectors

-- |get pattern from branch expression
branchPattern :: BranchExpr -> Pattern
branchPattern :: BranchExpr -> Pattern
branchPattern = (Pattern -> Expr -> Pattern) -> BranchExpr -> Pattern
forall a. (Pattern -> Expr -> a) -> BranchExpr -> a
trBranch (\pat :: Pattern
pat _ -> Pattern
pat)

-- |get expression from branch expression
branchExpr :: BranchExpr -> Expr
branchExpr :: BranchExpr -> Expr
branchExpr = (Pattern -> Expr -> Expr) -> BranchExpr -> Expr
forall a. (Pattern -> Expr -> a) -> BranchExpr -> a
trBranch (\_ e :: Expr
e -> Expr
e)

-- Update Operations

-- |update branch expression
updBranch :: (Pattern -> Pattern) -> (Expr -> Expr) -> BranchExpr -> BranchExpr
updBranch :: (Pattern -> Pattern) -> (Expr -> Expr) -> BranchExpr -> BranchExpr
updBranch fp :: Pattern -> Pattern
fp fe :: Expr -> Expr
fe = (Pattern -> Expr -> BranchExpr) -> BranchExpr -> BranchExpr
forall a. (Pattern -> Expr -> a) -> BranchExpr -> a
trBranch Pattern -> Expr -> BranchExpr
branch
 where
  branch :: Pattern -> Expr -> BranchExpr
branch pat :: Pattern
pat e :: Expr
e = Pattern -> Expr -> BranchExpr
Branch (Pattern -> Pattern
fp Pattern
pat) (Expr -> Expr
fe Expr
e)

-- |update pattern of branch expression
updBranchPattern :: Update BranchExpr Pattern
updBranchPattern :: Update BranchExpr Pattern
updBranchPattern f :: Pattern -> Pattern
f = (Pattern -> Pattern) -> (Expr -> Expr) -> BranchExpr -> BranchExpr
updBranch Pattern -> Pattern
f Expr -> Expr
forall a. a -> a
id

-- |update expression of branch expression
updBranchExpr :: Update BranchExpr Expr
updBranchExpr :: (Expr -> Expr) -> BranchExpr -> BranchExpr
updBranchExpr = (Pattern -> Pattern) -> (Expr -> Expr) -> BranchExpr -> BranchExpr
updBranch Pattern -> Pattern
forall a. a -> a
id

-- Pattern -------------------------------------------------------------------

-- |transform pattern
trPattern :: (QName -> [VarIndex] -> a) -> (Literal -> a) -> Pattern -> a
trPattern :: (QName -> [VarIndex] -> a) -> (Literal -> a) -> Pattern -> a
trPattern pattern :: QName -> [VarIndex] -> a
pattern _ (Pattern name :: QName
name args :: [VarIndex]
args) = QName -> [VarIndex] -> a
pattern QName
name [VarIndex]
args
trPattern _ lpattern :: Literal -> a
lpattern (LPattern l :: Literal
l) = Literal -> a
lpattern Literal
l

-- Selectors

-- |get name from constructor pattern
patCons :: Pattern -> QName
patCons :: Pattern -> QName
patCons = (QName -> [VarIndex] -> QName)
-> (Literal -> QName) -> Pattern -> QName
forall a.
(QName -> [VarIndex] -> a) -> (Literal -> a) -> Pattern -> a
trPattern (\name :: QName
name _ -> QName
name) Literal -> QName
forall a. HasCallStack => a
undefined

-- |get arguments from constructor pattern
patArgs :: Pattern -> [VarIndex]
patArgs :: Pattern -> [VarIndex]
patArgs = (QName -> [VarIndex] -> [VarIndex])
-> (Literal -> [VarIndex]) -> Pattern -> [VarIndex]
forall a.
(QName -> [VarIndex] -> a) -> (Literal -> a) -> Pattern -> a
trPattern (\_ args :: [VarIndex]
args -> [VarIndex]
args) Literal -> [VarIndex]
forall a. HasCallStack => a
undefined

-- |get literal from literal pattern
patLiteral :: Pattern -> Literal
patLiteral :: Pattern -> Literal
patLiteral = (QName -> [VarIndex] -> Literal)
-> (Literal -> Literal) -> Pattern -> Literal
forall a.
(QName -> [VarIndex] -> a) -> (Literal -> a) -> Pattern -> a
trPattern QName -> [VarIndex] -> Literal
forall a. HasCallStack => a
undefined Literal -> Literal
forall a. a -> a
id

-- Test Operations

-- |is pattern a constructor pattern?
isConsPattern :: Pattern -> Bool
isConsPattern :: Pattern -> Bool
isConsPattern = (QName -> [VarIndex] -> Bool)
-> (Literal -> Bool) -> Pattern -> Bool
forall a.
(QName -> [VarIndex] -> a) -> (Literal -> a) -> Pattern -> a
trPattern (\_ _ -> Bool
True) (\_ -> Bool
False)

-- Update Operations

-- |update pattern
updPattern :: (QName -> QName) ->
              ([VarIndex] -> [VarIndex]) ->
              (Literal -> Literal) -> Pattern -> Pattern
updPattern :: (QName -> QName)
-> ([VarIndex] -> [VarIndex])
-> (Literal -> Literal)
-> Pattern
-> Pattern
updPattern fn :: QName -> QName
fn fa :: [VarIndex] -> [VarIndex]
fa fl :: Literal -> Literal
fl = (QName -> [VarIndex] -> Pattern)
-> (Literal -> Pattern) -> Pattern -> Pattern
forall a.
(QName -> [VarIndex] -> a) -> (Literal -> a) -> Pattern -> a
trPattern QName -> [VarIndex] -> Pattern
pattern Literal -> Pattern
lpattern
 where
  pattern :: QName -> [VarIndex] -> Pattern
pattern name :: QName
name args :: [VarIndex]
args = QName -> [VarIndex] -> Pattern
Pattern (QName -> QName
fn QName
name) ([VarIndex] -> [VarIndex]
fa [VarIndex]
args)
  lpattern :: Literal -> Pattern
lpattern l :: Literal
l = Literal -> Pattern
LPattern (Literal -> Literal
fl Literal
l)

-- |update constructors name of pattern
updPatCons :: (QName -> QName) -> Pattern -> Pattern
updPatCons :: (QName -> QName) -> Pattern -> Pattern
updPatCons f :: QName -> QName
f = (QName -> QName)
-> ([VarIndex] -> [VarIndex])
-> (Literal -> Literal)
-> Pattern
-> Pattern
updPattern QName -> QName
f [VarIndex] -> [VarIndex]
forall a. a -> a
id Literal -> Literal
forall a. a -> a
id

-- |update arguments of constructor pattern
updPatArgs :: ([VarIndex] -> [VarIndex]) -> Pattern -> Pattern
updPatArgs :: ([VarIndex] -> [VarIndex]) -> Pattern -> Pattern
updPatArgs f :: [VarIndex] -> [VarIndex]
f = (QName -> QName)
-> ([VarIndex] -> [VarIndex])
-> (Literal -> Literal)
-> Pattern
-> Pattern
updPattern QName -> QName
forall a. a -> a
id [VarIndex] -> [VarIndex]
f Literal -> Literal
forall a. a -> a
id

-- |update literal of pattern
updPatLiteral :: (Literal -> Literal) -> Pattern -> Pattern
updPatLiteral :: (Literal -> Literal) -> Pattern -> Pattern
updPatLiteral f :: Literal -> Literal
f = (QName -> QName)
-> ([VarIndex] -> [VarIndex])
-> (Literal -> Literal)
-> Pattern
-> Pattern
updPattern QName -> QName
forall a. a -> a
id [VarIndex] -> [VarIndex]
forall a. a -> a
id Literal -> Literal
f

-- Auxiliary Functions

-- |build expression from pattern
patExpr :: Pattern -> Expr
patExpr :: Pattern -> Expr
patExpr = (QName -> [VarIndex] -> Expr)
-> (Literal -> Expr) -> Pattern -> Expr
forall a.
(QName -> [VarIndex] -> a) -> (Literal -> a) -> Pattern -> a
trPattern (\ name :: QName
name -> CombType -> QName -> [Expr] -> Expr
Comb CombType
ConsCall QName
name ([Expr] -> Expr) -> ([VarIndex] -> [Expr]) -> [VarIndex] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarIndex -> Expr) -> [VarIndex] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map VarIndex -> Expr
Var) Literal -> Expr
Lit

-- |Is this a public 'Visibility'?
isPublic :: Visibility -> Bool
isPublic :: Visibility -> Bool
isPublic = (Visibility -> Visibility -> Bool
forall a. Eq a => a -> a -> Bool
== Visibility
Public)