{- |
    Module      : $Header$
    Description : Utility functions for working with annotated FlatCurry.
    Copyright   : (c) 2016 - 2017 Finn Teegen
    License     : BSD-3-clause

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

    This library provides selector functions, test and update operations
    as well as some useful auxiliary functions for AnnotatedFlatCurry 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 AnnotatedFlatCurry 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.Annotated.Goodies
  ( module Curry.FlatCurry.Annotated.Goodies
  , module Curry.FlatCurry.Goodies
  ) where

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

import Curry.FlatCurry.Annotated.Type

-- AProg ----------------------------------------------------------------------

-- |transform program
trAProg :: (String -> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> b)
        -> AProg a -> b
trAProg :: (String
 -> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> b)
-> AProg a -> b
trAProg prog :: String -> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> b
prog (AProg name :: String
name imps :: [String]
imps types :: [TypeDecl]
types funcs :: [AFuncDecl a]
funcs ops :: [OpDecl]
ops) = String -> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> b
prog String
name [String]
imps [TypeDecl]
types [AFuncDecl a]
funcs [OpDecl]
ops

-- Selectors

-- |get name from program
aProgName :: AProg a -> String
aProgName :: AProg a -> String
aProgName = (String
 -> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> String)
-> AProg a -> String
forall a b.
(String
 -> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> b)
-> AProg a -> b
trAProg (\name :: String
name _ _ _ _ -> String
name)

-- |get imports from program
aProgImports :: AProg a -> [String]
aProgImports :: AProg a -> [String]
aProgImports = (String
 -> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> [String])
-> AProg a -> [String]
forall a b.
(String
 -> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> b)
-> AProg a -> b
trAProg (\_ imps :: [String]
imps _ _ _ -> [String]
imps)

-- |get type declarations from program
aProgTypes :: AProg a -> [TypeDecl]
aProgTypes :: AProg a -> [TypeDecl]
aProgTypes = (String
 -> [String]
 -> [TypeDecl]
 -> [AFuncDecl a]
 -> [OpDecl]
 -> [TypeDecl])
-> AProg a -> [TypeDecl]
forall a b.
(String
 -> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> b)
-> AProg a -> b
trAProg (\_ _ types :: [TypeDecl]
types _ _ -> [TypeDecl]
types)

-- |get functions from program
aProgAFuncs :: AProg a -> [AFuncDecl a]
aProgAFuncs :: AProg a -> [AFuncDecl a]
aProgAFuncs = (String
 -> [String]
 -> [TypeDecl]
 -> [AFuncDecl a]
 -> [OpDecl]
 -> [AFuncDecl a])
-> AProg a -> [AFuncDecl a]
forall a b.
(String
 -> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> b)
-> AProg a -> b
trAProg (\_ _ _ funcs :: [AFuncDecl a]
funcs _ -> [AFuncDecl a]
funcs)

-- |get infix operators from program
aProgOps :: AProg a -> [OpDecl]
aProgOps :: AProg a -> [OpDecl]
aProgOps = (String
 -> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> [OpDecl])
-> AProg a -> [OpDecl]
forall a b.
(String
 -> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> b)
-> AProg a -> b
trAProg (\_ _ _ _ ops :: [OpDecl]
ops -> [OpDecl]
ops)

-- Update Operations

-- |update program
updAProg :: (String -> String) ->
            ([String] -> [String]) ->
            ([TypeDecl] -> [TypeDecl]) ->
            ([AFuncDecl a] -> [AFuncDecl a]) ->
            ([OpDecl] -> [OpDecl]) -> AProg a -> AProg a
updAProg :: (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([AFuncDecl a] -> [AFuncDecl a])
-> ([OpDecl] -> [OpDecl])
-> AProg a
-> AProg a
updAProg fn :: String -> String
fn fi :: [String] -> [String]
fi ft :: [TypeDecl] -> [TypeDecl]
ft ff :: [AFuncDecl a] -> [AFuncDecl a]
ff fo :: [OpDecl] -> [OpDecl]
fo = (String
 -> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> AProg a)
-> AProg a -> AProg a
forall a b.
(String
 -> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> b)
-> AProg a -> b
trAProg String
-> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> AProg a
prog
 where
  prog :: String
-> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> AProg a
prog name :: String
name imps :: [String]
imps types :: [TypeDecl]
types funcs :: [AFuncDecl a]
funcs ops :: [OpDecl]
ops
    = String
-> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> AProg a
forall a.
String
-> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> AProg a
AProg (String -> String
fn String
name) ([String] -> [String]
fi [String]
imps) ([TypeDecl] -> [TypeDecl]
ft [TypeDecl]
types) ([AFuncDecl a] -> [AFuncDecl a]
ff [AFuncDecl a]
funcs) ([OpDecl] -> [OpDecl]
fo [OpDecl]
ops)

-- |update name of program
updAProgName :: Update (AProg a) String
updAProgName :: Update (AProg a) String
updAProgName f :: String -> String
f = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([AFuncDecl a] -> [AFuncDecl a])
-> ([OpDecl] -> [OpDecl])
-> AProg a
-> AProg a
forall a.
(String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([AFuncDecl a] -> [AFuncDecl a])
-> ([OpDecl] -> [OpDecl])
-> AProg a
-> AProg a
updAProg String -> String
f [String] -> [String]
forall a. a -> a
id [TypeDecl] -> [TypeDecl]
forall a. a -> a
id [AFuncDecl a] -> [AFuncDecl a]
forall a. a -> a
id [OpDecl] -> [OpDecl]
forall a. a -> a
id

-- |update imports of program
updAProgImports :: Update (AProg a) [String]
updAProgImports :: Update (AProg a) [String]
updAProgImports f :: [String] -> [String]
f = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([AFuncDecl a] -> [AFuncDecl a])
-> ([OpDecl] -> [OpDecl])
-> AProg a
-> AProg a
forall a.
(String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([AFuncDecl a] -> [AFuncDecl a])
-> ([OpDecl] -> [OpDecl])
-> AProg a
-> AProg a
updAProg String -> String
forall a. a -> a
id [String] -> [String]
f [TypeDecl] -> [TypeDecl]
forall a. a -> a
id [AFuncDecl a] -> [AFuncDecl a]
forall a. a -> a
id [OpDecl] -> [OpDecl]
forall a. a -> a
id

-- |update type declarations of program
updAProgTypes :: Update (AProg a) [TypeDecl]
updAProgTypes :: Update (AProg a) [TypeDecl]
updAProgTypes f :: [TypeDecl] -> [TypeDecl]
f = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([AFuncDecl a] -> [AFuncDecl a])
-> ([OpDecl] -> [OpDecl])
-> AProg a
-> AProg a
forall a.
(String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([AFuncDecl a] -> [AFuncDecl a])
-> ([OpDecl] -> [OpDecl])
-> AProg a
-> AProg a
updAProg String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id [TypeDecl] -> [TypeDecl]
f [AFuncDecl a] -> [AFuncDecl a]
forall a. a -> a
id [OpDecl] -> [OpDecl]
forall a. a -> a
id

-- |update functions of program
updAProgAFuncs :: Update (AProg a) [AFuncDecl a]
updAProgAFuncs :: Update (AProg a) [AFuncDecl a]
updAProgAFuncs f :: [AFuncDecl a] -> [AFuncDecl a]
f = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([AFuncDecl a] -> [AFuncDecl a])
-> ([OpDecl] -> [OpDecl])
-> AProg a
-> AProg a
forall a.
(String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([AFuncDecl a] -> [AFuncDecl a])
-> ([OpDecl] -> [OpDecl])
-> AProg a
-> AProg a
updAProg String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id [TypeDecl] -> [TypeDecl]
forall a. a -> a
id [AFuncDecl a] -> [AFuncDecl a]
f [OpDecl] -> [OpDecl]
forall a. a -> a
id

-- |update infix operators of program
updAProgOps :: Update (AProg a) [OpDecl]
updAProgOps :: Update (AProg a) [OpDecl]
updAProgOps = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([AFuncDecl a] -> [AFuncDecl a])
-> Update (AProg a) [OpDecl]
forall a.
(String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([AFuncDecl a] -> [AFuncDecl a])
-> ([OpDecl] -> [OpDecl])
-> AProg a
-> AProg a
updAProg String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id [TypeDecl] -> [TypeDecl]
forall a. a -> a
id [AFuncDecl a] -> [AFuncDecl a]
forall a. a -> a
id

-- Auxiliary Functions

-- |get all program variables (also from patterns)
allVarsInAProg :: AProg a -> [(VarIndex, a)]
allVarsInAProg :: AProg a -> [(VarIndex, a)]
allVarsInAProg = (AFuncDecl a -> [(VarIndex, a)])
-> [AFuncDecl a] -> [(VarIndex, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AFuncDecl a -> [(VarIndex, a)]
forall a. AFuncDecl a -> [(VarIndex, a)]
allVarsInAFunc ([AFuncDecl a] -> [(VarIndex, a)])
-> (AProg a -> [AFuncDecl a]) -> AProg a -> [(VarIndex, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AProg a -> [AFuncDecl a]
forall a. AProg a -> [AFuncDecl a]
aProgAFuncs

-- |lift transformation on expressions to program
updAProgAExps :: Update (AProg a) (AExpr a)
updAProgAExps :: Update (AProg a) (AExpr a)
updAProgAExps = Update (AProg a) [AFuncDecl a]
forall a. Update (AProg a) [AFuncDecl a]
updAProgAFuncs Update (AProg a) [AFuncDecl a]
-> ((AExpr a -> AExpr a) -> [AFuncDecl a] -> [AFuncDecl a])
-> Update (AProg a) (AExpr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AFuncDecl a -> AFuncDecl a) -> [AFuncDecl a] -> [AFuncDecl a]
forall a b. (a -> b) -> [a] -> [b]
map ((AFuncDecl a -> AFuncDecl a) -> [AFuncDecl a] -> [AFuncDecl a])
-> ((AExpr a -> AExpr a) -> AFuncDecl a -> AFuncDecl a)
-> (AExpr a -> AExpr a)
-> [AFuncDecl a]
-> [AFuncDecl a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AExpr a -> AExpr a) -> AFuncDecl a -> AFuncDecl a
forall a. Update (AFuncDecl a) (AExpr a)
updAFuncBody

-- |rename programs variables
rnmAllVarsInAProg :: Update (AProg a) VarIndex
rnmAllVarsInAProg :: Update (AProg a) VarIndex
rnmAllVarsInAProg = Update (AProg a) [AFuncDecl a]
forall a. Update (AProg a) [AFuncDecl a]
updAProgAFuncs Update (AProg a) [AFuncDecl a]
-> ((VarIndex -> VarIndex) -> [AFuncDecl a] -> [AFuncDecl a])
-> Update (AProg a) VarIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AFuncDecl a -> AFuncDecl a) -> [AFuncDecl a] -> [AFuncDecl a]
forall a b. (a -> b) -> [a] -> [b]
map ((AFuncDecl a -> AFuncDecl a) -> [AFuncDecl a] -> [AFuncDecl a])
-> ((VarIndex -> VarIndex) -> AFuncDecl a -> AFuncDecl a)
-> (VarIndex -> VarIndex)
-> [AFuncDecl a]
-> [AFuncDecl a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarIndex -> VarIndex) -> AFuncDecl a -> AFuncDecl a
forall a. Update (AFuncDecl a) VarIndex
rnmAllVarsInAFunc

-- |update all qualified names in program
updQNamesInAProg :: Update (AProg a) QName
updQNamesInAProg :: Update (AProg a) QName
updQNamesInAProg f :: QName -> QName
f = (String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([AFuncDecl a] -> [AFuncDecl a])
-> ([OpDecl] -> [OpDecl])
-> AProg a
-> AProg a
forall a.
(String -> String)
-> ([String] -> [String])
-> ([TypeDecl] -> [TypeDecl])
-> ([AFuncDecl a] -> [AFuncDecl a])
-> ([OpDecl] -> [OpDecl])
-> AProg a
-> AProg a
updAProg 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)) ((AFuncDecl a -> AFuncDecl a) -> [AFuncDecl a] -> [AFuncDecl a]
forall a b. (a -> b) -> [a] -> [b]
map (Update (AFuncDecl a) QName
forall a. Update (AFuncDecl a) QName
updQNamesInAFunc 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)
rnmAProg :: String -> AProg a -> AProg a
rnmAProg :: String -> AProg a -> AProg a
rnmAProg name :: String
name p :: AProg a
p = Update (AProg a) String
forall a. Update (AProg a) String
updAProgName (String -> String -> String
forall a b. a -> b -> a
const String
name) (Update (AProg a) QName
forall a. Update (AProg a) QName
updQNamesInAProg QName -> QName
forall b. (String, b) -> (String, b)
rnm AProg a
p)
 where
  rnm :: (String, b) -> (String, b)
rnm (m :: String
m, n :: b
n) | String
m String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== AProg a -> String
forall a. AProg a -> String
aProgName AProg a
p = (String
name, b
n)
             | Bool
otherwise = (String
m, b
n)

-- AFuncDecl ------------------------------------------------------------------

-- |transform function
trAFunc :: (QName -> Int -> Visibility -> TypeExpr -> ARule a -> b) -> AFuncDecl a -> b
trAFunc :: (QName -> VarIndex -> Visibility -> TypeExpr -> ARule a -> b)
-> AFuncDecl a -> b
trAFunc func :: QName -> VarIndex -> Visibility -> TypeExpr -> ARule a -> b
func (AFunc name :: QName
name arity :: VarIndex
arity vis :: Visibility
vis t :: TypeExpr
t rule :: ARule a
rule) = QName -> VarIndex -> Visibility -> TypeExpr -> ARule a -> b
func QName
name VarIndex
arity Visibility
vis TypeExpr
t ARule a
rule

-- Selectors

-- |get name of function
aFuncName :: AFuncDecl a -> QName
aFuncName :: AFuncDecl a -> QName
aFuncName = (QName -> VarIndex -> Visibility -> TypeExpr -> ARule a -> QName)
-> AFuncDecl a -> QName
forall a b.
(QName -> VarIndex -> Visibility -> TypeExpr -> ARule a -> b)
-> AFuncDecl a -> b
trAFunc (\name :: QName
name _ _ _ _ -> QName
name)

-- |get arity of function
aFuncArity :: AFuncDecl a -> Int
aFuncArity :: AFuncDecl a -> VarIndex
aFuncArity = (QName
 -> VarIndex -> Visibility -> TypeExpr -> ARule a -> VarIndex)
-> AFuncDecl a -> VarIndex
forall a b.
(QName -> VarIndex -> Visibility -> TypeExpr -> ARule a -> b)
-> AFuncDecl a -> b
trAFunc (\_ arity :: VarIndex
arity _ _ _ -> VarIndex
arity)

-- |get visibility of function
aFuncVisibility :: AFuncDecl a -> Visibility
aFuncVisibility :: AFuncDecl a -> Visibility
aFuncVisibility = (QName
 -> VarIndex -> Visibility -> TypeExpr -> ARule a -> Visibility)
-> AFuncDecl a -> Visibility
forall a b.
(QName -> VarIndex -> Visibility -> TypeExpr -> ARule a -> b)
-> AFuncDecl a -> b
trAFunc (\_ _ vis :: Visibility
vis _ _ -> Visibility
vis)

-- |get type of function
aFuncType :: AFuncDecl a -> TypeExpr
aFuncType :: AFuncDecl a -> TypeExpr
aFuncType = (QName
 -> VarIndex -> Visibility -> TypeExpr -> ARule a -> TypeExpr)
-> AFuncDecl a -> TypeExpr
forall a b.
(QName -> VarIndex -> Visibility -> TypeExpr -> ARule a -> b)
-> AFuncDecl a -> b
trAFunc (\_ _ _ t :: TypeExpr
t _ -> TypeExpr
t)

-- |get rule of function
aFuncARule :: AFuncDecl a -> ARule a
aFuncARule :: AFuncDecl a -> ARule a
aFuncARule = (QName -> VarIndex -> Visibility -> TypeExpr -> ARule a -> ARule a)
-> AFuncDecl a -> ARule a
forall a b.
(QName -> VarIndex -> Visibility -> TypeExpr -> ARule a -> b)
-> AFuncDecl a -> b
trAFunc (\_ _ _ _ rule :: ARule a
rule -> ARule a
rule)

-- Update Operations

-- |update function
updAFunc :: (QName -> QName) ->
            (Int -> Int) ->
            (Visibility -> Visibility) ->
            (TypeExpr -> TypeExpr) ->
            (ARule a -> ARule a) -> AFuncDecl a -> AFuncDecl a
updAFunc :: (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (ARule a -> ARule a)
-> AFuncDecl a
-> AFuncDecl a
updAFunc fn :: QName -> QName
fn fa :: VarIndex -> VarIndex
fa fv :: Visibility -> Visibility
fv ft :: TypeExpr -> TypeExpr
ft fr :: ARule a -> ARule a
fr = (QName
 -> VarIndex -> Visibility -> TypeExpr -> ARule a -> AFuncDecl a)
-> AFuncDecl a -> AFuncDecl a
forall a b.
(QName -> VarIndex -> Visibility -> TypeExpr -> ARule a -> b)
-> AFuncDecl a -> b
trAFunc QName
-> VarIndex -> Visibility -> TypeExpr -> ARule a -> AFuncDecl a
func
 where
  func :: QName
-> VarIndex -> Visibility -> TypeExpr -> ARule a -> AFuncDecl a
func name :: QName
name arity :: VarIndex
arity vis :: Visibility
vis t :: TypeExpr
t rule :: ARule a
rule
    = QName
-> VarIndex -> Visibility -> TypeExpr -> ARule a -> AFuncDecl a
forall a.
QName
-> VarIndex -> Visibility -> TypeExpr -> ARule a -> AFuncDecl a
AFunc (QName -> QName
fn QName
name) (VarIndex -> VarIndex
fa VarIndex
arity) (Visibility -> Visibility
fv Visibility
vis) (TypeExpr -> TypeExpr
ft TypeExpr
t) (ARule a -> ARule a
fr ARule a
rule)

-- |update name of function
updAFuncName :: Update (AFuncDecl a) QName
updAFuncName :: Update (AFuncDecl a) QName
updAFuncName f :: QName -> QName
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (ARule a -> ARule a)
-> AFuncDecl a
-> AFuncDecl a
forall a.
(QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (ARule a -> ARule a)
-> AFuncDecl a
-> AFuncDecl a
updAFunc QName -> QName
f VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
forall a. a -> a
id TypeExpr -> TypeExpr
forall a. a -> a
id ARule a -> ARule a
forall a. a -> a
id

-- |update arity of function
updAFuncArity :: Update (AFuncDecl a) Int
updAFuncArity :: Update (AFuncDecl a) VarIndex
updAFuncArity f :: VarIndex -> VarIndex
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (ARule a -> ARule a)
-> AFuncDecl a
-> AFuncDecl a
forall a.
(QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (ARule a -> ARule a)
-> AFuncDecl a
-> AFuncDecl a
updAFunc QName -> QName
forall a. a -> a
id VarIndex -> VarIndex
f Visibility -> Visibility
forall a. a -> a
id TypeExpr -> TypeExpr
forall a. a -> a
id ARule a -> ARule a
forall a. a -> a
id

-- |update visibility of function
updAFuncVisibility :: Update (AFuncDecl a) Visibility
updAFuncVisibility :: Update (AFuncDecl a) Visibility
updAFuncVisibility f :: Visibility -> Visibility
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (ARule a -> ARule a)
-> AFuncDecl a
-> AFuncDecl a
forall a.
(QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (ARule a -> ARule a)
-> AFuncDecl a
-> AFuncDecl a
updAFunc QName -> QName
forall a. a -> a
id VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
f TypeExpr -> TypeExpr
forall a. a -> a
id ARule a -> ARule a
forall a. a -> a
id

-- |update type of function
updFuncType :: Update (AFuncDecl a) TypeExpr
updFuncType :: Update (AFuncDecl a) TypeExpr
updFuncType f :: TypeExpr -> TypeExpr
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (ARule a -> ARule a)
-> AFuncDecl a
-> AFuncDecl a
forall a.
(QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (ARule a -> ARule a)
-> AFuncDecl a
-> AFuncDecl a
updAFunc QName -> QName
forall a. a -> a
id VarIndex -> VarIndex
forall a. a -> a
id Visibility -> Visibility
forall a. a -> a
id TypeExpr -> TypeExpr
f ARule a -> ARule a
forall a. a -> a
id

-- |update rule of function
updAFuncARule :: Update (AFuncDecl a) (ARule a)
updAFuncARule :: Update (AFuncDecl a) (ARule a)
updAFuncARule = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> Update (AFuncDecl a) (ARule a)
forall a.
(QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (ARule a -> ARule a)
-> AFuncDecl a
-> AFuncDecl a
updAFunc 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?
isPublicAFunc :: AFuncDecl a -> Bool
isPublicAFunc :: AFuncDecl a -> Bool
isPublicAFunc = Visibility -> Bool
isPublic (Visibility -> Bool)
-> (AFuncDecl a -> Visibility) -> AFuncDecl a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AFuncDecl a -> Visibility
forall a. AFuncDecl a -> Visibility
aFuncVisibility

-- |is function externally defined?
isExternal :: AFuncDecl a -> Bool
isExternal :: AFuncDecl a -> Bool
isExternal = ARule a -> Bool
forall a. ARule a -> Bool
isARuleExternal (ARule a -> Bool)
-> (AFuncDecl a -> ARule a) -> AFuncDecl a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AFuncDecl a -> ARule a
forall a. AFuncDecl a -> ARule a
aFuncARule

-- |get variable names in a function declaration
allVarsInAFunc :: AFuncDecl a -> [(VarIndex, a)]
allVarsInAFunc :: AFuncDecl a -> [(VarIndex, a)]
allVarsInAFunc = ARule a -> [(VarIndex, a)]
forall a. ARule a -> [(VarIndex, a)]
allVarsInARule (ARule a -> [(VarIndex, a)])
-> (AFuncDecl a -> ARule a) -> AFuncDecl a -> [(VarIndex, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AFuncDecl a -> ARule a
forall a. AFuncDecl a -> ARule a
aFuncARule

-- |get arguments of function, if not externally defined
aFuncArgs :: AFuncDecl a -> [(VarIndex, a)]
aFuncArgs :: AFuncDecl a -> [(VarIndex, a)]
aFuncArgs = ARule a -> [(VarIndex, a)]
forall a. ARule a -> [(VarIndex, a)]
aRuleArgs (ARule a -> [(VarIndex, a)])
-> (AFuncDecl a -> ARule a) -> AFuncDecl a -> [(VarIndex, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AFuncDecl a -> ARule a
forall a. AFuncDecl a -> ARule a
aFuncARule

-- |get body of function, if not externally defined
aFuncBody :: AFuncDecl a -> AExpr a
aFuncBody :: AFuncDecl a -> AExpr a
aFuncBody = ARule a -> AExpr a
forall a. ARule a -> AExpr a
aRuleBody (ARule a -> AExpr a)
-> (AFuncDecl a -> ARule a) -> AFuncDecl a -> AExpr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AFuncDecl a -> ARule a
forall a. AFuncDecl a -> ARule a
aFuncARule

-- |get the right-hand-sides of a 'FuncDecl'
aFuncRHS :: AFuncDecl a -> [AExpr a]
aFuncRHS :: AFuncDecl a -> [AExpr a]
aFuncRHS f :: AFuncDecl a
f | Bool -> Bool
not (AFuncDecl a -> Bool
forall a. AFuncDecl a -> Bool
isExternal AFuncDecl a
f) = AExpr a -> [AExpr a]
forall a. AExpr a -> [AExpr a]
orCase (AFuncDecl a -> AExpr a
forall a. AFuncDecl a -> AExpr a
aFuncBody AFuncDecl a
f)
           | Bool
otherwise = []
 where
  orCase :: AExpr a -> [AExpr a]
orCase e :: AExpr a
e
    | AExpr a -> Bool
forall a. AExpr a -> Bool
isAOr AExpr a
e = (AExpr a -> [AExpr a]) -> [AExpr a] -> [AExpr a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AExpr a -> [AExpr a]
orCase (AExpr a -> [AExpr a]
forall a. AExpr a -> [AExpr a]
orExps AExpr a
e)
    | AExpr a -> Bool
forall a. AExpr a -> Bool
isACase AExpr a
e = (AExpr a -> [AExpr a]) -> [AExpr a] -> [AExpr a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AExpr a -> [AExpr a]
orCase ((ABranchExpr a -> AExpr a) -> [ABranchExpr a] -> [AExpr a]
forall a b. (a -> b) -> [a] -> [b]
map ABranchExpr a -> AExpr a
forall a. ABranchExpr a -> AExpr a
aBranchAExpr (AExpr a -> [ABranchExpr a]
forall a. AExpr a -> [ABranchExpr a]
caseBranches AExpr a
e))
    | Bool
otherwise = [AExpr a
e]

-- |rename all variables in function
rnmAllVarsInAFunc :: Update (AFuncDecl a) VarIndex
rnmAllVarsInAFunc :: Update (AFuncDecl a) VarIndex
rnmAllVarsInAFunc = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (ARule a -> ARule a)
-> AFuncDecl a
-> AFuncDecl a
forall a.
(QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (ARule a -> ARule a)
-> AFuncDecl a
-> AFuncDecl a
updAFunc 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 ((ARule a -> ARule a) -> AFuncDecl a -> AFuncDecl a)
-> ((VarIndex -> VarIndex) -> ARule a -> ARule a)
-> Update (AFuncDecl a) VarIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarIndex -> VarIndex) -> ARule a -> ARule a
forall a. Update (ARule a) VarIndex
rnmAllVarsInARule

-- |update all qualified names in function
updQNamesInAFunc :: Update (AFuncDecl a) QName
updQNamesInAFunc :: Update (AFuncDecl a) QName
updQNamesInAFunc f :: QName -> QName
f = (QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (ARule a -> ARule a)
-> AFuncDecl a
-> AFuncDecl a
forall a.
(QName -> QName)
-> (VarIndex -> VarIndex)
-> (Visibility -> Visibility)
-> (TypeExpr -> TypeExpr)
-> (ARule a -> ARule a)
-> AFuncDecl a
-> AFuncDecl a
updAFunc 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 (ARule a) QName
forall a. Update (ARule a) QName
updQNamesInARule QName -> QName
f)

-- |update arguments of function, if not externally defined
updAFuncArgs :: Update (AFuncDecl a) [(VarIndex, a)]
updAFuncArgs :: Update (AFuncDecl a) [(VarIndex, a)]
updAFuncArgs = Update (AFuncDecl a) (ARule a)
forall a. Update (AFuncDecl a) (ARule a)
updAFuncARule Update (AFuncDecl a) (ARule a)
-> (([(VarIndex, a)] -> [(VarIndex, a)]) -> ARule a -> ARule a)
-> Update (AFuncDecl a) [(VarIndex, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(VarIndex, a)] -> [(VarIndex, a)]) -> ARule a -> ARule a
forall a. Update (ARule a) [(VarIndex, a)]
updARuleArgs

-- |update body of function, if not externally defined
updAFuncBody :: Update (AFuncDecl a) (AExpr a)
updAFuncBody :: Update (AFuncDecl a) (AExpr a)
updAFuncBody = Update (AFuncDecl a) (ARule a)
forall a. Update (AFuncDecl a) (ARule a)
updAFuncARule Update (AFuncDecl a) (ARule a)
-> ((AExpr a -> AExpr a) -> ARule a -> ARule a)
-> Update (AFuncDecl a) (AExpr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AExpr a -> AExpr a) -> ARule a -> ARule a
forall a. Update (ARule a) (AExpr a)
updARuleBody

-- ARule ----------------------------------------------------------------------

-- |transform rule
trARule :: (a -> [(VarIndex, a)] -> AExpr a -> b) -> (a -> String -> b) -> ARule a -> b
trARule :: (a -> [(VarIndex, a)] -> AExpr a -> b)
-> (a -> String -> b) -> ARule a -> b
trARule rule :: a -> [(VarIndex, a)] -> AExpr a -> b
rule _ (ARule a :: a
a args :: [(VarIndex, a)]
args e :: AExpr a
e) = a -> [(VarIndex, a)] -> AExpr a -> b
rule a
a [(VarIndex, a)]
args AExpr a
e
trARule _ ext :: a -> String -> b
ext (AExternal a :: a
a s :: String
s) = a -> String -> b
ext a
a String
s

-- Selectors

-- |get rules annotation
aRuleAnnot :: ARule a -> a
aRuleAnnot :: ARule a -> a
aRuleAnnot = (a -> [(VarIndex, a)] -> AExpr a -> a)
-> (a -> String -> a) -> ARule a -> a
forall a b.
(a -> [(VarIndex, a)] -> AExpr a -> b)
-> (a -> String -> b) -> ARule a -> b
trARule (\a :: a
a _ _ -> a
a) (\a :: a
a _ -> a
a)

-- |get rules arguments if it's not external
aRuleArgs :: ARule a -> [(VarIndex, a)]
aRuleArgs :: ARule a -> [(VarIndex, a)]
aRuleArgs = (a -> [(VarIndex, a)] -> AExpr a -> [(VarIndex, a)])
-> (a -> String -> [(VarIndex, a)]) -> ARule a -> [(VarIndex, a)]
forall a b.
(a -> [(VarIndex, a)] -> AExpr a -> b)
-> (a -> String -> b) -> ARule a -> b
trARule (\_ args :: [(VarIndex, a)]
args _ -> [(VarIndex, a)]
args) a -> String -> [(VarIndex, a)]
forall a. HasCallStack => a
undefined

-- |get rules body if it's not external
aRuleBody :: ARule a -> AExpr a
aRuleBody :: ARule a -> AExpr a
aRuleBody = (a -> [(VarIndex, a)] -> AExpr a -> AExpr a)
-> (a -> String -> AExpr a) -> ARule a -> AExpr a
forall a b.
(a -> [(VarIndex, a)] -> AExpr a -> b)
-> (a -> String -> b) -> ARule a -> b
trARule (\_ _ e :: AExpr a
e -> AExpr a
e) a -> String -> AExpr a
forall a. HasCallStack => a
undefined

-- |get rules external declaration
aRuleExtDecl :: ARule a -> String
aRuleExtDecl :: ARule a -> String
aRuleExtDecl = (a -> [(VarIndex, a)] -> AExpr a -> String)
-> (a -> String -> String) -> ARule a -> String
forall a b.
(a -> [(VarIndex, a)] -> AExpr a -> b)
-> (a -> String -> b) -> ARule a -> b
trARule a -> [(VarIndex, a)] -> AExpr a -> String
forall a. HasCallStack => a
undefined (\_ s :: String
s -> String
s)

-- Test Operations

-- |is rule external?
isARuleExternal :: ARule a -> Bool
isARuleExternal :: ARule a -> Bool
isARuleExternal = (a -> [(VarIndex, a)] -> AExpr a -> Bool)
-> (a -> String -> Bool) -> ARule a -> Bool
forall a b.
(a -> [(VarIndex, a)] -> AExpr a -> b)
-> (a -> String -> b) -> ARule a -> b
trARule (\_ _ _ -> Bool
False) (\_ _ -> Bool
True)

-- Update Operations

-- |update rule
updARule :: (a -> b) ->
            ([(VarIndex, a)] -> [(VarIndex, b)]) ->
            (AExpr a -> AExpr b) ->
            (String -> String) -> ARule a -> ARule b
updARule :: (a -> b)
-> ([(VarIndex, a)] -> [(VarIndex, b)])
-> (AExpr a -> AExpr b)
-> (String -> String)
-> ARule a
-> ARule b
updARule fannot :: a -> b
fannot fa :: [(VarIndex, a)] -> [(VarIndex, b)]
fa fe :: AExpr a -> AExpr b
fe fs :: String -> String
fs = (a -> [(VarIndex, a)] -> AExpr a -> ARule b)
-> (a -> String -> ARule b) -> ARule a -> ARule b
forall a b.
(a -> [(VarIndex, a)] -> AExpr a -> b)
-> (a -> String -> b) -> ARule a -> b
trARule a -> [(VarIndex, a)] -> AExpr a -> ARule b
rule a -> String -> ARule b
ext
 where
  rule :: a -> [(VarIndex, a)] -> AExpr a -> ARule b
rule a :: a
a args :: [(VarIndex, a)]
args e :: AExpr a
e = b -> [(VarIndex, b)] -> AExpr b -> ARule b
forall a. a -> [(VarIndex, a)] -> AExpr a -> ARule a
ARule (a -> b
fannot a
a) ([(VarIndex, a)] -> [(VarIndex, b)]
fa [(VarIndex, a)]
args) (AExpr a -> AExpr b
fe AExpr a
e)
  ext :: a -> String -> ARule b
ext a :: a
a s :: String
s = b -> String -> ARule b
forall a. a -> String -> ARule a
AExternal (a -> b
fannot a
a) (String -> String
fs String
s)

-- |update rules annotation
updARuleAnnot :: Update (ARule a) a
updARuleAnnot :: Update (ARule a) a
updARuleAnnot f :: a -> a
f = (a -> a)
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> (AExpr a -> AExpr a)
-> (String -> String)
-> ARule a
-> ARule a
forall a b.
(a -> b)
-> ([(VarIndex, a)] -> [(VarIndex, b)])
-> (AExpr a -> AExpr b)
-> (String -> String)
-> ARule a
-> ARule b
updARule a -> a
f [(VarIndex, a)] -> [(VarIndex, a)]
forall a. a -> a
id AExpr a -> AExpr a
forall a. a -> a
id String -> String
forall a. a -> a
id

-- |update rules arguments
updARuleArgs :: Update (ARule a) [(VarIndex, a)]
updARuleArgs :: Update (ARule a) [(VarIndex, a)]
updARuleArgs f :: [(VarIndex, a)] -> [(VarIndex, a)]
f = (a -> a)
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> (AExpr a -> AExpr a)
-> (String -> String)
-> ARule a
-> ARule a
forall a b.
(a -> b)
-> ([(VarIndex, a)] -> [(VarIndex, b)])
-> (AExpr a -> AExpr b)
-> (String -> String)
-> ARule a
-> ARule b
updARule a -> a
forall a. a -> a
id [(VarIndex, a)] -> [(VarIndex, a)]
f AExpr a -> AExpr a
forall a. a -> a
id String -> String
forall a. a -> a
id

-- |update rules body
updARuleBody :: Update (ARule a) (AExpr a)
updARuleBody :: Update (ARule a) (AExpr a)
updARuleBody f :: AExpr a -> AExpr a
f = (a -> a)
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> (AExpr a -> AExpr a)
-> (String -> String)
-> ARule a
-> ARule a
forall a b.
(a -> b)
-> ([(VarIndex, a)] -> [(VarIndex, b)])
-> (AExpr a -> AExpr b)
-> (String -> String)
-> ARule a
-> ARule b
updARule a -> a
forall a. a -> a
id [(VarIndex, a)] -> [(VarIndex, a)]
forall a. a -> a
id AExpr a -> AExpr a
f String -> String
forall a. a -> a
id

-- |update rules external declaration
updARuleExtDecl :: Update (ARule a) String
updARuleExtDecl :: Update (ARule a) String
updARuleExtDecl f :: String -> String
f = (a -> a)
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> (AExpr a -> AExpr a)
-> Update (ARule a) String
forall a b.
(a -> b)
-> ([(VarIndex, a)] -> [(VarIndex, b)])
-> (AExpr a -> AExpr b)
-> (String -> String)
-> ARule a
-> ARule b
updARule a -> a
forall a. a -> a
id [(VarIndex, a)] -> [(VarIndex, a)]
forall a. a -> a
id AExpr a -> AExpr a
forall a. a -> a
id String -> String
f

-- Auxiliary Functions

-- |get variable names in a functions rule
allVarsInARule :: ARule a -> [(VarIndex, a)]
allVarsInARule :: ARule a -> [(VarIndex, a)]
allVarsInARule = (a -> [(VarIndex, a)] -> AExpr a -> [(VarIndex, a)])
-> (a -> String -> [(VarIndex, a)]) -> ARule a -> [(VarIndex, a)]
forall a b.
(a -> [(VarIndex, a)] -> AExpr a -> b)
-> (a -> String -> b) -> ARule a -> b
trARule (\_ args :: [(VarIndex, a)]
args body :: AExpr a
body -> [(VarIndex, a)]
args [(VarIndex, a)] -> [(VarIndex, a)] -> [(VarIndex, a)]
forall a. [a] -> [a] -> [a]
++ AExpr a -> [(VarIndex, a)]
forall a. AExpr a -> [(VarIndex, a)]
allVars AExpr a
body) (\_ _ -> [])

-- |rename all variables in rule
rnmAllVarsInARule :: Update (ARule a) VarIndex
rnmAllVarsInARule :: Update (ARule a) VarIndex
rnmAllVarsInARule f :: VarIndex -> VarIndex
f = (a -> a)
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> (AExpr a -> AExpr a)
-> (String -> String)
-> ARule a
-> ARule a
forall a b.
(a -> b)
-> ([(VarIndex, a)] -> [(VarIndex, b)])
-> (AExpr a -> AExpr b)
-> (String -> String)
-> ARule a
-> ARule b
updARule a -> a
forall a. a -> a
id (((VarIndex, a) -> (VarIndex, a))
-> [(VarIndex, a)] -> [(VarIndex, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: VarIndex
a, b :: a
b) -> (VarIndex -> VarIndex
f VarIndex
a, a
b))) (Update (AExpr a) VarIndex
forall a. Update (AExpr a) VarIndex
rnmAllVars VarIndex -> VarIndex
f) String -> String
forall a. a -> a
id

-- |update all qualified names in rule
updQNamesInARule :: Update (ARule a) QName
updQNamesInARule :: Update (ARule a) QName
updQNamesInARule = Update (ARule a) (AExpr a)
forall a. Update (ARule a) (AExpr a)
updARuleBody Update (ARule a) (AExpr a)
-> ((QName -> QName) -> AExpr a -> AExpr a)
-> Update (ARule a) QName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> QName) -> AExpr a -> AExpr a
forall a. Update (AExpr a) QName
updQNames

-- AExpr ----------------------------------------------------------------------

-- Selectors

-- |get annoation of an expression
annot :: AExpr a -> a
annot :: AExpr a -> a
annot (AVar   a :: a
a _    ) = a
a
annot (ALit   a :: a
a _    ) = a
a
annot (AComb  a :: a
a _ _ _) = a
a
annot (ALet   a :: a
a _ _  ) = a
a
annot (AFree  a :: a
a _ _  ) = a
a
annot (AOr    a :: a
a _ _  ) = a
a
annot (ACase  a :: a
a _ _ _) = a
a
annot (ATyped a :: a
a _ _  ) = a
a

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

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

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

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

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

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

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

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

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

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

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

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


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

-- Test Operations

-- |is expression a variable?
isAVar :: AExpr a -> Bool
isAVar :: AExpr a -> Bool
isAVar e :: AExpr a
e = case AExpr a
e of
  AVar _ _ -> Bool
True
  _ -> Bool
False

-- |is expression a literal expression?
isALit :: AExpr a -> Bool
isALit :: AExpr a -> Bool
isALit e :: AExpr a
e = case AExpr a
e of
  ALit _ _ -> Bool
True
  _ -> Bool
False

-- |is expression combined?
isAComb :: AExpr a -> Bool
isAComb :: AExpr a -> Bool
isAComb e :: AExpr a
e = case AExpr a
e of
  AComb _ _ _ _ -> Bool
True
  _ -> Bool
False

-- |is expression a let expression?
isALet :: AExpr a -> Bool
isALet :: AExpr a -> Bool
isALet e :: AExpr a
e = case AExpr a
e of
  ALet _ _ _ -> Bool
True
  _ -> Bool
False

-- |is expression a declaration of free variables?
isAFree :: AExpr a -> Bool
isAFree :: AExpr a -> Bool
isAFree e :: AExpr a
e = case AExpr a
e of
  AFree _ _ _ -> Bool
True
  _ -> Bool
False

-- |is expression an or-expression?
isAOr :: AExpr a -> Bool
isAOr :: AExpr a -> Bool
isAOr e :: AExpr a
e = case AExpr a
e of
  AOr _ _ _ -> Bool
True
  _ -> Bool
False

-- |is expression a case expression?
isACase :: AExpr a -> Bool
isACase :: AExpr a -> Bool
isACase e :: AExpr a
e = case AExpr a
e of
  ACase _ _ _ _ -> Bool
True
  _ -> Bool
False

-- |transform expression
trAExpr  :: (a -> VarIndex -> b)
         -> (a -> Literal -> b)
         -> (a -> CombType -> (QName, a) -> [b] -> b)
         -> (a -> [((VarIndex, a), b)] -> b -> b)
         -> (a -> [(VarIndex, a)] -> b -> b)
         -> (a -> b -> b -> b)
         -> (a -> CaseType -> b -> [c] -> b)
         -> (APattern a -> b -> c)
         -> (a -> b -> TypeExpr -> b)
         -> AExpr a
         -> b
trAExpr :: (a -> VarIndex -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((VarIndex, a), b)] -> b -> b)
-> (a -> [(VarIndex, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
trAExpr var :: a -> VarIndex -> b
var lit :: a -> Literal -> b
lit comb :: a -> CombType -> (QName, a) -> [b] -> b
comb lt :: a -> [((VarIndex, a), b)] -> b -> b
lt fr :: a -> [(VarIndex, a)] -> b -> b
fr oR :: a -> b -> b -> b
oR cas :: a -> CaseType -> b -> [c] -> b
cas branch :: APattern a -> b -> c
branch typed :: a -> b -> TypeExpr -> b
typed expr :: AExpr a
expr = case AExpr a
expr of
  AVar a :: a
a n :: VarIndex
n             -> a -> VarIndex -> b
var a
a VarIndex
n
  ALit a :: a
a l :: Literal
l             -> a -> Literal -> b
lit a
a Literal
l
  AComb a :: a
a ct :: CombType
ct name :: (QName, a)
name args :: [AExpr a]
args -> a -> CombType -> (QName, a) -> [b] -> b
comb a
a CombType
ct (QName, a)
name ((AExpr a -> b) -> [AExpr a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map AExpr a -> b
f [AExpr a]
args)
  ALet a :: a
a bs :: [((VarIndex, a), AExpr a)]
bs e :: AExpr a
e          -> a -> [((VarIndex, a), b)] -> b -> b
lt a
a ((((VarIndex, a), AExpr a) -> ((VarIndex, a), b))
-> [((VarIndex, a), AExpr a)] -> [((VarIndex, a), b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(v :: (VarIndex, a)
v, x :: AExpr a
x) -> ((VarIndex, a)
v, AExpr a -> b
f AExpr a
x)) [((VarIndex, a), AExpr a)]
bs) (AExpr a -> b
f AExpr a
e)
  AFree a :: a
a vs :: [(VarIndex, a)]
vs e :: AExpr a
e         -> a -> [(VarIndex, a)] -> b -> b
fr a
a [(VarIndex, a)]
vs (AExpr a -> b
f AExpr a
e)
  AOr a :: a
a e1 :: AExpr a
e1 e2 :: AExpr a
e2          -> a -> b -> b -> b
oR a
a (AExpr a -> b
f AExpr a
e1) (AExpr a -> b
f AExpr a
e2)
  ACase a :: a
a ct :: CaseType
ct e :: AExpr a
e bs :: [ABranchExpr a]
bs      -> a -> CaseType -> b -> [c] -> b
cas a
a CaseType
ct (AExpr a -> b
f AExpr a
e) ((ABranchExpr a -> c) -> [ABranchExpr a] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map (\ (ABranch p :: APattern a
p e' :: AExpr a
e') -> APattern a -> b -> c
branch APattern a
p (AExpr a -> b
f AExpr a
e')) [ABranchExpr a]
bs)
  ATyped a :: a
a e :: AExpr a
e ty :: TypeExpr
ty        -> a -> b -> TypeExpr -> b
typed a
a (AExpr a -> b
f AExpr a
e) TypeExpr
ty
  where
  f :: AExpr a -> b
f = (a -> VarIndex -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((VarIndex, a), b)] -> b -> b)
-> (a -> [(VarIndex, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
forall a b c.
(a -> VarIndex -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((VarIndex, a), b)] -> b -> b)
-> (a -> [(VarIndex, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
trAExpr a -> VarIndex -> b
var a -> Literal -> b
lit a -> CombType -> (QName, a) -> [b] -> b
comb a -> [((VarIndex, a), b)] -> b -> b
lt a -> [(VarIndex, a)] -> b -> b
fr a -> b -> b -> b
oR a -> CaseType -> b -> [c] -> b
cas APattern a -> b -> c
branch a -> b -> TypeExpr -> b
typed

-- |update all variables in given expression
updVars :: (a -> VarIndex -> AExpr a) -> AExpr a -> AExpr a
updVars :: (a -> VarIndex -> AExpr a) -> AExpr a -> AExpr a
updVars var :: a -> VarIndex -> AExpr a
var = (a -> VarIndex -> AExpr a)
-> (a -> Literal -> AExpr a)
-> (a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a)
-> (a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a)
-> (a -> [(VarIndex, a)] -> AExpr a -> AExpr a)
-> (a -> AExpr a -> AExpr a -> AExpr a)
-> (a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a)
-> (APattern a -> AExpr a -> ABranchExpr a)
-> (a -> AExpr a -> TypeExpr -> AExpr a)
-> AExpr a
-> AExpr a
forall a b c.
(a -> VarIndex -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((VarIndex, a), b)] -> b -> b)
-> (a -> [(VarIndex, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
trAExpr a -> VarIndex -> AExpr a
var a -> Literal -> AExpr a
forall a. a -> Literal -> AExpr a
ALit a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
forall a. a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
AComb a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
forall a. a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
ALet a -> [(VarIndex, a)] -> AExpr a -> AExpr a
forall a. a -> [(VarIndex, a)] -> AExpr a -> AExpr a
AFree a -> AExpr a -> AExpr a -> AExpr a
forall a. a -> AExpr a -> AExpr a -> AExpr a
AOr a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
forall a. a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
ACase APattern a -> AExpr a -> ABranchExpr a
forall a. APattern a -> AExpr a -> ABranchExpr a
ABranch a -> AExpr a -> TypeExpr -> AExpr a
forall a. a -> AExpr a -> TypeExpr -> AExpr a
ATyped

-- |update all literals in given expression
updLiterals :: (a -> Literal -> AExpr a) -> AExpr a -> AExpr a
updLiterals :: (a -> Literal -> AExpr a) -> AExpr a -> AExpr a
updLiterals lit :: a -> Literal -> AExpr a
lit = (a -> VarIndex -> AExpr a)
-> (a -> Literal -> AExpr a)
-> (a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a)
-> (a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a)
-> (a -> [(VarIndex, a)] -> AExpr a -> AExpr a)
-> (a -> AExpr a -> AExpr a -> AExpr a)
-> (a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a)
-> (APattern a -> AExpr a -> ABranchExpr a)
-> (a -> AExpr a -> TypeExpr -> AExpr a)
-> AExpr a
-> AExpr a
forall a b c.
(a -> VarIndex -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((VarIndex, a), b)] -> b -> b)
-> (a -> [(VarIndex, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
trAExpr a -> VarIndex -> AExpr a
forall a. a -> VarIndex -> AExpr a
AVar a -> Literal -> AExpr a
lit a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
forall a. a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
AComb a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
forall a. a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
ALet a -> [(VarIndex, a)] -> AExpr a -> AExpr a
forall a. a -> [(VarIndex, a)] -> AExpr a -> AExpr a
AFree a -> AExpr a -> AExpr a -> AExpr a
forall a. a -> AExpr a -> AExpr a -> AExpr a
AOr a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
forall a. a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
ACase APattern a -> AExpr a -> ABranchExpr a
forall a. APattern a -> AExpr a -> ABranchExpr a
ABranch a -> AExpr a -> TypeExpr -> AExpr a
forall a. a -> AExpr a -> TypeExpr -> AExpr a
ATyped

-- |update all combined expressions in given expression
updCombs :: (a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a) -> AExpr a -> AExpr a
updCombs :: (a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a)
-> AExpr a -> AExpr a
updCombs comb :: a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
comb = (a -> VarIndex -> AExpr a)
-> (a -> Literal -> AExpr a)
-> (a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a)
-> (a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a)
-> (a -> [(VarIndex, a)] -> AExpr a -> AExpr a)
-> (a -> AExpr a -> AExpr a -> AExpr a)
-> (a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a)
-> (APattern a -> AExpr a -> ABranchExpr a)
-> (a -> AExpr a -> TypeExpr -> AExpr a)
-> AExpr a
-> AExpr a
forall a b c.
(a -> VarIndex -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((VarIndex, a), b)] -> b -> b)
-> (a -> [(VarIndex, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
trAExpr a -> VarIndex -> AExpr a
forall a. a -> VarIndex -> AExpr a
AVar a -> Literal -> AExpr a
forall a. a -> Literal -> AExpr a
ALit a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
comb a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
forall a. a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
ALet a -> [(VarIndex, a)] -> AExpr a -> AExpr a
forall a. a -> [(VarIndex, a)] -> AExpr a -> AExpr a
AFree a -> AExpr a -> AExpr a -> AExpr a
forall a. a -> AExpr a -> AExpr a -> AExpr a
AOr a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
forall a. a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
ACase APattern a -> AExpr a -> ABranchExpr a
forall a. APattern a -> AExpr a -> ABranchExpr a
ABranch a -> AExpr a -> TypeExpr -> AExpr a
forall a. a -> AExpr a -> TypeExpr -> AExpr a
ATyped

-- |update all let expressions in given expression
updLets :: (a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a) -> AExpr a -> AExpr a
updLets :: (a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a)
-> AExpr a -> AExpr a
updLets lt :: a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
lt = (a -> VarIndex -> AExpr a)
-> (a -> Literal -> AExpr a)
-> (a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a)
-> (a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a)
-> (a -> [(VarIndex, a)] -> AExpr a -> AExpr a)
-> (a -> AExpr a -> AExpr a -> AExpr a)
-> (a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a)
-> (APattern a -> AExpr a -> ABranchExpr a)
-> (a -> AExpr a -> TypeExpr -> AExpr a)
-> AExpr a
-> AExpr a
forall a b c.
(a -> VarIndex -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((VarIndex, a), b)] -> b -> b)
-> (a -> [(VarIndex, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
trAExpr a -> VarIndex -> AExpr a
forall a. a -> VarIndex -> AExpr a
AVar a -> Literal -> AExpr a
forall a. a -> Literal -> AExpr a
ALit a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
forall a. a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
AComb a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
lt a -> [(VarIndex, a)] -> AExpr a -> AExpr a
forall a. a -> [(VarIndex, a)] -> AExpr a -> AExpr a
AFree a -> AExpr a -> AExpr a -> AExpr a
forall a. a -> AExpr a -> AExpr a -> AExpr a
AOr a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
forall a. a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
ACase APattern a -> AExpr a -> ABranchExpr a
forall a. APattern a -> AExpr a -> ABranchExpr a
ABranch a -> AExpr a -> TypeExpr -> AExpr a
forall a. a -> AExpr a -> TypeExpr -> AExpr a
ATyped

-- |update all free declarations in given expression
updFrees :: (a -> [(VarIndex, a)] -> AExpr a -> AExpr a) -> AExpr a -> AExpr a
updFrees :: (a -> [(VarIndex, a)] -> AExpr a -> AExpr a) -> AExpr a -> AExpr a
updFrees fr :: a -> [(VarIndex, a)] -> AExpr a -> AExpr a
fr = (a -> VarIndex -> AExpr a)
-> (a -> Literal -> AExpr a)
-> (a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a)
-> (a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a)
-> (a -> [(VarIndex, a)] -> AExpr a -> AExpr a)
-> (a -> AExpr a -> AExpr a -> AExpr a)
-> (a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a)
-> (APattern a -> AExpr a -> ABranchExpr a)
-> (a -> AExpr a -> TypeExpr -> AExpr a)
-> AExpr a
-> AExpr a
forall a b c.
(a -> VarIndex -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((VarIndex, a), b)] -> b -> b)
-> (a -> [(VarIndex, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
trAExpr a -> VarIndex -> AExpr a
forall a. a -> VarIndex -> AExpr a
AVar a -> Literal -> AExpr a
forall a. a -> Literal -> AExpr a
ALit a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
forall a. a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
AComb a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
forall a. a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
ALet a -> [(VarIndex, a)] -> AExpr a -> AExpr a
fr a -> AExpr a -> AExpr a -> AExpr a
forall a. a -> AExpr a -> AExpr a -> AExpr a
AOr a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
forall a. a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
ACase APattern a -> AExpr a -> ABranchExpr a
forall a. APattern a -> AExpr a -> ABranchExpr a
ABranch a -> AExpr a -> TypeExpr -> AExpr a
forall a. a -> AExpr a -> TypeExpr -> AExpr a
ATyped

-- |update all or expressions in given expression
updOrs :: (a -> AExpr a -> AExpr a -> AExpr a) -> AExpr a -> AExpr a
updOrs :: (a -> AExpr a -> AExpr a -> AExpr a) -> AExpr a -> AExpr a
updOrs oR :: a -> AExpr a -> AExpr a -> AExpr a
oR = (a -> VarIndex -> AExpr a)
-> (a -> Literal -> AExpr a)
-> (a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a)
-> (a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a)
-> (a -> [(VarIndex, a)] -> AExpr a -> AExpr a)
-> (a -> AExpr a -> AExpr a -> AExpr a)
-> (a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a)
-> (APattern a -> AExpr a -> ABranchExpr a)
-> (a -> AExpr a -> TypeExpr -> AExpr a)
-> AExpr a
-> AExpr a
forall a b c.
(a -> VarIndex -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((VarIndex, a), b)] -> b -> b)
-> (a -> [(VarIndex, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
trAExpr a -> VarIndex -> AExpr a
forall a. a -> VarIndex -> AExpr a
AVar a -> Literal -> AExpr a
forall a. a -> Literal -> AExpr a
ALit a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
forall a. a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
AComb a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
forall a. a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
ALet a -> [(VarIndex, a)] -> AExpr a -> AExpr a
forall a. a -> [(VarIndex, a)] -> AExpr a -> AExpr a
AFree a -> AExpr a -> AExpr a -> AExpr a
oR a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
forall a. a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
ACase APattern a -> AExpr a -> ABranchExpr a
forall a. APattern a -> AExpr a -> ABranchExpr a
ABranch a -> AExpr a -> TypeExpr -> AExpr a
forall a. a -> AExpr a -> TypeExpr -> AExpr a
ATyped

-- |update all case expressions in given expression
updCases :: (a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a) -> AExpr a -> AExpr a
updCases :: (a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a)
-> AExpr a -> AExpr a
updCases cas :: a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
cas = (a -> VarIndex -> AExpr a)
-> (a -> Literal -> AExpr a)
-> (a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a)
-> (a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a)
-> (a -> [(VarIndex, a)] -> AExpr a -> AExpr a)
-> (a -> AExpr a -> AExpr a -> AExpr a)
-> (a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a)
-> (APattern a -> AExpr a -> ABranchExpr a)
-> (a -> AExpr a -> TypeExpr -> AExpr a)
-> AExpr a
-> AExpr a
forall a b c.
(a -> VarIndex -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((VarIndex, a), b)] -> b -> b)
-> (a -> [(VarIndex, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
trAExpr a -> VarIndex -> AExpr a
forall a. a -> VarIndex -> AExpr a
AVar a -> Literal -> AExpr a
forall a. a -> Literal -> AExpr a
ALit a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
forall a. a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
AComb a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
forall a. a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
ALet a -> [(VarIndex, a)] -> AExpr a -> AExpr a
forall a. a -> [(VarIndex, a)] -> AExpr a -> AExpr a
AFree a -> AExpr a -> AExpr a -> AExpr a
forall a. a -> AExpr a -> AExpr a -> AExpr a
AOr a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
cas APattern a -> AExpr a -> ABranchExpr a
forall a. APattern a -> AExpr a -> ABranchExpr a
ABranch a -> AExpr a -> TypeExpr -> AExpr a
forall a. a -> AExpr a -> TypeExpr -> AExpr a
ATyped

-- |update all case branches in given expression
updBranches :: (APattern a -> AExpr a -> ABranchExpr a) -> AExpr a -> AExpr a
updBranches :: (APattern a -> AExpr a -> ABranchExpr a) -> AExpr a -> AExpr a
updBranches branch :: APattern a -> AExpr a -> ABranchExpr a
branch = (a -> VarIndex -> AExpr a)
-> (a -> Literal -> AExpr a)
-> (a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a)
-> (a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a)
-> (a -> [(VarIndex, a)] -> AExpr a -> AExpr a)
-> (a -> AExpr a -> AExpr a -> AExpr a)
-> (a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a)
-> (APattern a -> AExpr a -> ABranchExpr a)
-> (a -> AExpr a -> TypeExpr -> AExpr a)
-> AExpr a
-> AExpr a
forall a b c.
(a -> VarIndex -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((VarIndex, a), b)] -> b -> b)
-> (a -> [(VarIndex, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
trAExpr a -> VarIndex -> AExpr a
forall a. a -> VarIndex -> AExpr a
AVar a -> Literal -> AExpr a
forall a. a -> Literal -> AExpr a
ALit a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
forall a. a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
AComb a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
forall a. a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
ALet a -> [(VarIndex, a)] -> AExpr a -> AExpr a
forall a. a -> [(VarIndex, a)] -> AExpr a -> AExpr a
AFree a -> AExpr a -> AExpr a -> AExpr a
forall a. a -> AExpr a -> AExpr a -> AExpr a
AOr a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
forall a. a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
ACase APattern a -> AExpr a -> ABranchExpr a
branch a -> AExpr a -> TypeExpr -> AExpr a
forall a. a -> AExpr a -> TypeExpr -> AExpr a
ATyped

-- |update all typed expressions in given expression
updTypeds :: (a -> AExpr a -> TypeExpr -> AExpr a) -> AExpr a -> AExpr a
updTypeds :: (a -> AExpr a -> TypeExpr -> AExpr a) -> AExpr a -> AExpr a
updTypeds = (a -> VarIndex -> AExpr a)
-> (a -> Literal -> AExpr a)
-> (a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a)
-> (a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a)
-> (a -> [(VarIndex, a)] -> AExpr a -> AExpr a)
-> (a -> AExpr a -> AExpr a -> AExpr a)
-> (a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a)
-> (APattern a -> AExpr a -> ABranchExpr a)
-> (a -> AExpr a -> TypeExpr -> AExpr a)
-> AExpr a
-> AExpr a
forall a b c.
(a -> VarIndex -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((VarIndex, a), b)] -> b -> b)
-> (a -> [(VarIndex, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
trAExpr a -> VarIndex -> AExpr a
forall a. a -> VarIndex -> AExpr a
AVar a -> Literal -> AExpr a
forall a. a -> Literal -> AExpr a
ALit a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
forall a. a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
AComb a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
forall a. a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
ALet a -> [(VarIndex, a)] -> AExpr a -> AExpr a
forall a. a -> [(VarIndex, a)] -> AExpr a -> AExpr a
AFree a -> AExpr a -> AExpr a -> AExpr a
forall a. a -> AExpr a -> AExpr a -> AExpr a
AOr a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
forall a. a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
ACase APattern a -> AExpr a -> ABranchExpr a
forall a. APattern a -> AExpr a -> ABranchExpr a
ABranch

-- Auxiliary Functions

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

-- |is expression a partial function call?
isFuncPartCall :: AExpr a -> Bool
isFuncPartCall :: AExpr a -> Bool
isFuncPartCall e :: AExpr a
e = AExpr a -> Bool
forall a. AExpr a -> Bool
isAComb AExpr a
e Bool -> Bool -> Bool
&& CombType -> Bool
isCombTypeFuncPartCall (AExpr a -> CombType
forall a. AExpr a -> CombType
combType AExpr a
e)

-- |is expression a call of a constructor?
isConsCall :: AExpr a -> Bool
isConsCall :: AExpr a -> Bool
isConsCall e :: AExpr a
e = AExpr a -> Bool
forall a. AExpr a -> Bool
isAComb AExpr a
e Bool -> Bool -> Bool
&& CombType -> Bool
isCombTypeConsCall (AExpr a -> CombType
forall a. AExpr a -> CombType
combType AExpr a
e)

-- |is expression a partial constructor call?
isConsPartCall :: AExpr a -> Bool
isConsPartCall :: AExpr a -> Bool
isConsPartCall e :: AExpr a
e = AExpr a -> Bool
forall a. AExpr a -> Bool
isAComb AExpr a
e Bool -> Bool -> Bool
&& CombType -> Bool
isCombTypeConsPartCall (AExpr a -> CombType
forall a. AExpr a -> CombType
combType AExpr a
e)

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

-- |get all variables (also pattern variables) in expression
allVars :: AExpr a -> [(VarIndex, a)]
allVars :: AExpr a -> [(VarIndex, a)]
allVars e :: AExpr a
e = (a -> VarIndex -> [(VarIndex, a)] -> [(VarIndex, a)])
-> (a -> Literal -> [(VarIndex, a)] -> [(VarIndex, a)])
-> (a
    -> CombType
    -> (QName, a)
    -> [[(VarIndex, a)] -> [(VarIndex, a)]]
    -> [(VarIndex, a)]
    -> [(VarIndex, a)])
-> (a
    -> [((VarIndex, a), [(VarIndex, a)] -> [(VarIndex, a)])]
    -> ([(VarIndex, a)] -> [(VarIndex, a)])
    -> [(VarIndex, a)]
    -> [(VarIndex, a)])
-> (a
    -> [(VarIndex, a)]
    -> ([(VarIndex, a)] -> [(VarIndex, a)])
    -> [(VarIndex, a)]
    -> [(VarIndex, a)])
-> (a
    -> ([(VarIndex, a)] -> [(VarIndex, a)])
    -> ([(VarIndex, a)] -> [(VarIndex, a)])
    -> [(VarIndex, a)]
    -> [(VarIndex, a)])
-> (a
    -> CaseType
    -> ([(VarIndex, a)] -> [(VarIndex, a)])
    -> [[(VarIndex, a)] -> [(VarIndex, a)]]
    -> [(VarIndex, a)]
    -> [(VarIndex, a)])
-> (APattern a
    -> ([(VarIndex, a)] -> [(VarIndex, a)])
    -> [(VarIndex, a)]
    -> [(VarIndex, a)])
-> (a
    -> ([(VarIndex, a)] -> [(VarIndex, a)])
    -> TypeExpr
    -> [(VarIndex, a)]
    -> [(VarIndex, a)])
-> AExpr a
-> [(VarIndex, a)]
-> [(VarIndex, a)]
forall a b c.
(a -> VarIndex -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((VarIndex, a), b)] -> b -> b)
-> (a -> [(VarIndex, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
trAExpr a -> VarIndex -> [(VarIndex, a)] -> [(VarIndex, a)]
forall b a. b -> a -> [(a, b)] -> [(a, b)]
var a -> Literal -> [(VarIndex, a)] -> [(VarIndex, a)]
forall b b a. b -> b -> a -> a
lit a
-> CombType
-> (QName, a)
-> [[(VarIndex, a)] -> [(VarIndex, a)]]
-> [(VarIndex, a)]
-> [(VarIndex, a)]
forall (t :: * -> *) p p p b.
Foldable t =>
p -> p -> p -> t (b -> b) -> b -> b
comb a
-> [((VarIndex, a), [(VarIndex, a)] -> [(VarIndex, a)])]
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> [(VarIndex, a)]
-> [(VarIndex, a)]
forall p a c. p -> [(a, [a] -> [a])] -> ([a] -> c) -> [a] -> c
lt a
-> [(VarIndex, a)]
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> [(VarIndex, a)]
-> [(VarIndex, a)]
forall p a a. p -> [a] -> (a -> [a]) -> a -> [a]
fr ((([(VarIndex, a)] -> [(VarIndex, a)])
 -> ([(VarIndex, a)] -> [(VarIndex, a)])
 -> [(VarIndex, a)]
 -> [(VarIndex, a)])
-> a
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> [(VarIndex, a)]
-> [(VarIndex, a)]
forall a b. a -> b -> a
const ([(VarIndex, a)] -> [(VarIndex, a)])
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> [(VarIndex, a)]
-> [(VarIndex, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) a
-> CaseType
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> [[(VarIndex, a)] -> [(VarIndex, a)]]
-> [(VarIndex, a)]
-> [(VarIndex, a)]
forall (t :: * -> *) p p b c.
Foldable t =>
p -> p -> (b -> c) -> t (b -> b) -> b -> c
cas APattern a
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> [(VarIndex, a)]
-> [(VarIndex, a)]
forall a a.
APattern a -> (a -> [(VarIndex, a)]) -> a -> [(VarIndex, a)]
branch a
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> TypeExpr
-> [(VarIndex, a)]
-> [(VarIndex, a)]
forall p a b. p -> a -> b -> a
typ AExpr a
e []
 where
  var :: b -> a -> [(a, b)] -> [(a, b)]
var a :: b
a v :: a
v = (:) (a
v, b
a)
  lit :: b -> b -> a -> a
lit = (b -> a -> a) -> b -> b -> a -> a
forall a b. a -> b -> a
const ((a -> a) -> b -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id)
  comb :: p -> p -> p -> t (b -> b) -> b -> b
comb _ _ _ = ((b -> b) -> (b -> b) -> b -> b)
-> (b -> b) -> t (b -> b) -> b -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) b -> b
forall a. a -> a
id
  lt :: p -> [(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 :: p -> [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 -> 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 :: APattern a -> (a -> [(VarIndex, a)]) -> a -> [(VarIndex, a)]
branch pat :: APattern a
pat e' :: a -> [(VarIndex, a)]
e' = ((APattern a -> [(VarIndex, a)]
forall a. APattern a -> [(VarIndex, a)]
args APattern a
pat)[(VarIndex, a)] -> [(VarIndex, a)] -> [(VarIndex, a)]
forall a. [a] -> [a] -> [a]
++) ([(VarIndex, a)] -> [(VarIndex, a)])
-> (a -> [(VarIndex, a)]) -> a -> [(VarIndex, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [(VarIndex, a)]
e'
  typ :: p -> a -> b -> a
typ _ = a -> b -> a
forall a b. a -> b -> a
const
  args :: APattern a -> [(VarIndex, a)]
args pat :: APattern a
pat | APattern a -> Bool
forall a. APattern a -> Bool
isConsPattern APattern a
pat = APattern a -> [(VarIndex, a)]
forall a. APattern a -> [(VarIndex, a)]
aPatArgs APattern a
pat
           | Bool
otherwise = []

-- |rename all variables (also in patterns) in expression
rnmAllVars :: Update (AExpr a) VarIndex
rnmAllVars :: Update (AExpr a) VarIndex
rnmAllVars f :: VarIndex -> VarIndex
f = (a -> VarIndex -> AExpr a)
-> (a -> Literal -> AExpr a)
-> (a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a)
-> (a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a)
-> (a -> [(VarIndex, a)] -> AExpr a -> AExpr a)
-> (a -> AExpr a -> AExpr a -> AExpr a)
-> (a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a)
-> (APattern a -> AExpr a -> ABranchExpr a)
-> (a -> AExpr a -> TypeExpr -> AExpr a)
-> AExpr a
-> AExpr a
forall a b c.
(a -> VarIndex -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((VarIndex, a), b)] -> b -> b)
-> (a -> [(VarIndex, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
trAExpr a -> VarIndex -> AExpr a
forall a. a -> VarIndex -> AExpr a
var a -> Literal -> AExpr a
forall a. a -> Literal -> AExpr a
ALit a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
forall a. a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
AComb a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
forall a. a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
lt a -> [(VarIndex, a)] -> AExpr a -> AExpr a
forall a. a -> [(VarIndex, a)] -> AExpr a -> AExpr a
fr a -> AExpr a -> AExpr a -> AExpr a
forall a. a -> AExpr a -> AExpr a -> AExpr a
AOr a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
forall a. a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
ACase APattern a -> AExpr a -> ABranchExpr a
forall a. APattern a -> AExpr a -> ABranchExpr a
branch a -> AExpr a -> TypeExpr -> AExpr a
forall a. a -> AExpr a -> TypeExpr -> AExpr a
ATyped
 where
   var :: a -> VarIndex -> AExpr a
var a :: a
a = a -> VarIndex -> AExpr a
forall a. a -> VarIndex -> AExpr a
AVar a
a (VarIndex -> AExpr a)
-> (VarIndex -> VarIndex) -> VarIndex -> AExpr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarIndex -> VarIndex
f
   lt :: a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
lt a :: a
a = a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
forall a. a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
ALet a
a ([((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a)
-> ([((VarIndex, a), AExpr a)] -> [((VarIndex, a), AExpr a)])
-> [((VarIndex, a), AExpr a)]
-> AExpr a
-> AExpr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((VarIndex, a), AExpr a) -> ((VarIndex, a), AExpr a))
-> [((VarIndex, a), AExpr a)] -> [((VarIndex, a), AExpr a)]
forall a b. (a -> b) -> [a] -> [b]
map (\((n :: VarIndex
n, b :: a
b), e :: AExpr a
e) -> ((VarIndex -> VarIndex
f VarIndex
n, a
b), AExpr a
e))
   fr :: a -> [(VarIndex, a)] -> AExpr a -> AExpr a
fr a :: a
a = a -> [(VarIndex, a)] -> AExpr a -> AExpr a
forall a. a -> [(VarIndex, a)] -> AExpr a -> AExpr a
AFree a
a ([(VarIndex, a)] -> AExpr a -> AExpr a)
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> [(VarIndex, a)]
-> AExpr a
-> AExpr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VarIndex, a) -> (VarIndex, a))
-> [(VarIndex, a)] -> [(VarIndex, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(b :: VarIndex
b, c :: a
c) -> (VarIndex -> VarIndex
f VarIndex
b, a
c))
   branch :: APattern a -> AExpr a -> ABranchExpr a
branch = APattern a -> AExpr a -> ABranchExpr a
forall a. APattern a -> AExpr a -> ABranchExpr a
ABranch (APattern a -> AExpr a -> ABranchExpr a)
-> (APattern a -> APattern a)
-> APattern a
-> AExpr a
-> ABranchExpr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(VarIndex, a)] -> [(VarIndex, a)]) -> APattern a -> APattern a
forall a.
([(VarIndex, a)] -> [(VarIndex, a)]) -> APattern a -> APattern a
updAPatArgs (((VarIndex, a) -> (VarIndex, a))
-> [(VarIndex, a)] -> [(VarIndex, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: VarIndex
a, b :: a
b) -> (VarIndex -> VarIndex
f VarIndex
a, a
b)))

-- |update all qualified names in expression
updQNames :: Update (AExpr a) QName
updQNames :: Update (AExpr a) QName
updQNames f :: QName -> QName
f = (a -> VarIndex -> AExpr a)
-> (a -> Literal -> AExpr a)
-> (a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a)
-> (a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a)
-> (a -> [(VarIndex, a)] -> AExpr a -> AExpr a)
-> (a -> AExpr a -> AExpr a -> AExpr a)
-> (a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a)
-> (APattern a -> AExpr a -> ABranchExpr a)
-> (a -> AExpr a -> TypeExpr -> AExpr a)
-> AExpr a
-> AExpr a
forall a b c.
(a -> VarIndex -> b)
-> (a -> Literal -> b)
-> (a -> CombType -> (QName, a) -> [b] -> b)
-> (a -> [((VarIndex, a), b)] -> b -> b)
-> (a -> [(VarIndex, a)] -> b -> b)
-> (a -> b -> b -> b)
-> (a -> CaseType -> b -> [c] -> b)
-> (APattern a -> b -> c)
-> (a -> b -> TypeExpr -> b)
-> AExpr a
-> b
trAExpr a -> VarIndex -> AExpr a
forall a. a -> VarIndex -> AExpr a
AVar a -> Literal -> AExpr a
forall a. a -> Literal -> AExpr a
ALit a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
forall a. a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
comb a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
forall a. a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a
ALet a -> [(VarIndex, a)] -> AExpr a -> AExpr a
forall a. a -> [(VarIndex, a)] -> AExpr a -> AExpr a
AFree a -> AExpr a -> AExpr a -> AExpr a
forall a. a -> AExpr a -> AExpr a -> AExpr a
AOr a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
forall a. a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a
ACase APattern a -> AExpr a -> ABranchExpr a
forall a. APattern a -> AExpr a -> ABranchExpr a
branch a -> AExpr a -> TypeExpr -> AExpr a
forall a. a -> AExpr a -> TypeExpr -> AExpr a
ATyped
 where
  comb :: a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
comb a :: a
a ct :: CombType
ct (name :: QName
name, a' :: a
a') args :: [AExpr a]
args = a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
forall a. a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
AComb a
a CombType
ct (QName -> QName
f QName
name, a
a') [AExpr a]
args
  branch :: APattern a -> AExpr a -> ABranchExpr a
branch = APattern a -> AExpr a -> ABranchExpr a
forall a. APattern a -> AExpr a -> ABranchExpr a
ABranch (APattern a -> AExpr a -> ABranchExpr a)
-> (APattern a -> APattern a)
-> APattern a
-> AExpr a
-> ABranchExpr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((QName, a) -> (QName, a)) -> APattern a -> APattern a
forall a. ((QName, a) -> (QName, a)) -> APattern a -> APattern a
updAPatCons (\(q :: QName
q, a :: a
a) -> (QName -> QName
f QName
q, a
a))

-- ABranchExpr ----------------------------------------------------------------

-- |transform branch expression
trABranch :: (APattern a -> AExpr a -> b) -> ABranchExpr a -> b
trABranch :: (APattern a -> AExpr a -> b) -> ABranchExpr a -> b
trABranch branch :: APattern a -> AExpr a -> b
branch (ABranch pat :: APattern a
pat e :: AExpr a
e) = APattern a -> AExpr a -> b
branch APattern a
pat AExpr a
e

-- Selectors

-- |get pattern from branch expression
aBranchAPattern :: ABranchExpr a -> APattern a
aBranchAPattern :: ABranchExpr a -> APattern a
aBranchAPattern = (APattern a -> AExpr a -> APattern a)
-> ABranchExpr a -> APattern a
forall a b. (APattern a -> AExpr a -> b) -> ABranchExpr a -> b
trABranch (\pat :: APattern a
pat _ -> APattern a
pat)

-- |get expression from branch expression
aBranchAExpr :: ABranchExpr a -> AExpr a
aBranchAExpr :: ABranchExpr a -> AExpr a
aBranchAExpr = (APattern a -> AExpr a -> AExpr a) -> ABranchExpr a -> AExpr a
forall a b. (APattern a -> AExpr a -> b) -> ABranchExpr a -> b
trABranch (\_ e :: AExpr a
e -> AExpr a
e)

-- Update Operations

-- |update branch expression
updABranch :: (APattern a -> APattern a) -> (AExpr a -> AExpr a) -> ABranchExpr a -> ABranchExpr a
updABranch :: (APattern a -> APattern a)
-> (AExpr a -> AExpr a) -> ABranchExpr a -> ABranchExpr a
updABranch fp :: APattern a -> APattern a
fp fe :: AExpr a -> AExpr a
fe = (APattern a -> AExpr a -> ABranchExpr a)
-> ABranchExpr a -> ABranchExpr a
forall a b. (APattern a -> AExpr a -> b) -> ABranchExpr a -> b
trABranch APattern a -> AExpr a -> ABranchExpr a
branch
 where
  branch :: APattern a -> AExpr a -> ABranchExpr a
branch pat :: APattern a
pat e :: AExpr a
e = APattern a -> AExpr a -> ABranchExpr a
forall a. APattern a -> AExpr a -> ABranchExpr a
ABranch (APattern a -> APattern a
fp APattern a
pat) (AExpr a -> AExpr a
fe AExpr a
e)

-- |update pattern of branch expression
updABranchAPattern :: Update (ABranchExpr a) (APattern a)
updABranchAPattern :: Update (ABranchExpr a) (APattern a)
updABranchAPattern f :: APattern a -> APattern a
f = (APattern a -> APattern a)
-> (AExpr a -> AExpr a) -> ABranchExpr a -> ABranchExpr a
forall a.
(APattern a -> APattern a)
-> (AExpr a -> AExpr a) -> ABranchExpr a -> ABranchExpr a
updABranch APattern a -> APattern a
f AExpr a -> AExpr a
forall a. a -> a
id

-- |update expression of branch expression
updABranchAExpr :: Update (ABranchExpr a) (AExpr a)
updABranchAExpr :: Update (ABranchExpr a) (AExpr a)
updABranchAExpr = (APattern a -> APattern a) -> Update (ABranchExpr a) (AExpr a)
forall a.
(APattern a -> APattern a)
-> (AExpr a -> AExpr a) -> ABranchExpr a -> ABranchExpr a
updABranch APattern a -> APattern a
forall a. a -> a
id

-- APattern -------------------------------------------------------------------

-- |transform pattern
trAPattern :: (a -> (QName, a) -> [(VarIndex, a)] -> b) -> (a -> Literal -> b) -> APattern a -> b
trAPattern :: (a -> (QName, a) -> [(VarIndex, a)] -> b)
-> (a -> Literal -> b) -> APattern a -> b
trAPattern pattern :: a -> (QName, a) -> [(VarIndex, a)] -> b
pattern _ (APattern a :: a
a name :: (QName, a)
name args :: [(VarIndex, a)]
args) = a -> (QName, a) -> [(VarIndex, a)] -> b
pattern a
a (QName, a)
name [(VarIndex, a)]
args
trAPattern _ lpattern :: a -> Literal -> b
lpattern (ALPattern a :: a
a l :: Literal
l) = a -> Literal -> b
lpattern a
a Literal
l

-- Selectors

-- |get annotation from pattern
aPatAnnot :: APattern a -> a
aPatAnnot :: APattern a -> a
aPatAnnot = (a -> (QName, a) -> [(VarIndex, a)] -> a)
-> (a -> Literal -> a) -> APattern a -> a
forall a b.
(a -> (QName, a) -> [(VarIndex, a)] -> b)
-> (a -> Literal -> b) -> APattern a -> b
trAPattern (\a :: a
a _ _ -> a
a) (\a :: a
a _ -> a
a)

-- |get name from constructor pattern
aPatCons :: APattern a -> (QName, a)
aPatCons :: APattern a -> (QName, a)
aPatCons = (a -> (QName, a) -> [(VarIndex, a)] -> (QName, a))
-> (a -> Literal -> (QName, a)) -> APattern a -> (QName, a)
forall a b.
(a -> (QName, a) -> [(VarIndex, a)] -> b)
-> (a -> Literal -> b) -> APattern a -> b
trAPattern (\_ name :: (QName, a)
name _ -> (QName, a)
name) a -> Literal -> (QName, a)
forall a. HasCallStack => a
undefined

-- |get arguments from constructor pattern
aPatArgs :: APattern a -> [(VarIndex, a)]
aPatArgs :: APattern a -> [(VarIndex, a)]
aPatArgs = (a -> (QName, a) -> [(VarIndex, a)] -> [(VarIndex, a)])
-> (a -> Literal -> [(VarIndex, a)])
-> APattern a
-> [(VarIndex, a)]
forall a b.
(a -> (QName, a) -> [(VarIndex, a)] -> b)
-> (a -> Literal -> b) -> APattern a -> b
trAPattern (\_ _ args :: [(VarIndex, a)]
args -> [(VarIndex, a)]
args) a -> Literal -> [(VarIndex, a)]
forall a. HasCallStack => a
undefined

-- |get literal from literal pattern
aPatLiteral :: APattern a -> Literal
aPatLiteral :: APattern a -> Literal
aPatLiteral = (a -> (QName, a) -> [(VarIndex, a)] -> Literal)
-> (a -> Literal -> Literal) -> APattern a -> Literal
forall a b.
(a -> (QName, a) -> [(VarIndex, a)] -> b)
-> (a -> Literal -> b) -> APattern a -> b
trAPattern a -> (QName, a) -> [(VarIndex, a)] -> Literal
forall a. HasCallStack => a
undefined ((Literal -> Literal) -> a -> Literal -> Literal
forall a b. a -> b -> a
const Literal -> Literal
forall a. a -> a
id)

-- Test Operations

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

-- Update Operations

-- |update pattern
updAPattern :: (a -> a) ->
               ((QName, a) -> (QName, a)) ->
               ([(VarIndex, a)] -> [(VarIndex, a)]) ->
               (Literal -> Literal) -> APattern a -> APattern a
updAPattern :: (a -> a)
-> ((QName, a) -> (QName, a))
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> (Literal -> Literal)
-> APattern a
-> APattern a
updAPattern fannot :: a -> a
fannot fn :: (QName, a) -> (QName, a)
fn fa :: [(VarIndex, a)] -> [(VarIndex, a)]
fa fl :: Literal -> Literal
fl = (a -> (QName, a) -> [(VarIndex, a)] -> APattern a)
-> (a -> Literal -> APattern a) -> APattern a -> APattern a
forall a b.
(a -> (QName, a) -> [(VarIndex, a)] -> b)
-> (a -> Literal -> b) -> APattern a -> b
trAPattern a -> (QName, a) -> [(VarIndex, a)] -> APattern a
pattern a -> Literal -> APattern a
lpattern
 where
  pattern :: a -> (QName, a) -> [(VarIndex, a)] -> APattern a
pattern a :: a
a name :: (QName, a)
name args :: [(VarIndex, a)]
args = a -> (QName, a) -> [(VarIndex, a)] -> APattern a
forall a. a -> (QName, a) -> [(VarIndex, a)] -> APattern a
APattern (a -> a
fannot a
a) ((QName, a) -> (QName, a)
fn (QName, a)
name) ([(VarIndex, a)] -> [(VarIndex, a)]
fa [(VarIndex, a)]
args)
  lpattern :: a -> Literal -> APattern a
lpattern a :: a
a l :: Literal
l = a -> Literal -> APattern a
forall a. a -> Literal -> APattern a
ALPattern (a -> a
fannot a
a) (Literal -> Literal
fl Literal
l)

-- |update annotation of pattern
updAPatAnnot :: (a -> a) -> APattern a -> APattern a
updAPatAnnot :: (a -> a) -> APattern a -> APattern a
updAPatAnnot f :: a -> a
f = (a -> a)
-> ((QName, a) -> (QName, a))
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> (Literal -> Literal)
-> APattern a
-> APattern a
forall a.
(a -> a)
-> ((QName, a) -> (QName, a))
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> (Literal -> Literal)
-> APattern a
-> APattern a
updAPattern a -> a
f (QName, a) -> (QName, a)
forall a. a -> a
id [(VarIndex, a)] -> [(VarIndex, a)]
forall a. a -> a
id Literal -> Literal
forall a. a -> a
id

-- |update constructors name of pattern
updAPatCons :: ((QName, a) -> (QName, a)) -> APattern a -> APattern a
updAPatCons :: ((QName, a) -> (QName, a)) -> APattern a -> APattern a
updAPatCons f :: (QName, a) -> (QName, a)
f = (a -> a)
-> ((QName, a) -> (QName, a))
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> (Literal -> Literal)
-> APattern a
-> APattern a
forall a.
(a -> a)
-> ((QName, a) -> (QName, a))
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> (Literal -> Literal)
-> APattern a
-> APattern a
updAPattern a -> a
forall a. a -> a
id (QName, a) -> (QName, a)
f [(VarIndex, a)] -> [(VarIndex, a)]
forall a. a -> a
id Literal -> Literal
forall a. a -> a
id

-- |update arguments of constructor pattern
updAPatArgs :: ([(VarIndex, a)] -> [(VarIndex, a)]) -> APattern a -> APattern a
updAPatArgs :: ([(VarIndex, a)] -> [(VarIndex, a)]) -> APattern a -> APattern a
updAPatArgs f :: [(VarIndex, a)] -> [(VarIndex, a)]
f = (a -> a)
-> ((QName, a) -> (QName, a))
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> (Literal -> Literal)
-> APattern a
-> APattern a
forall a.
(a -> a)
-> ((QName, a) -> (QName, a))
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> (Literal -> Literal)
-> APattern a
-> APattern a
updAPattern a -> a
forall a. a -> a
id (QName, a) -> (QName, a)
forall a. a -> a
id [(VarIndex, a)] -> [(VarIndex, a)]
f Literal -> Literal
forall a. a -> a
id

-- |update literal of pattern
updAPatLiteral :: (Literal -> Literal) -> APattern a -> APattern a
updAPatLiteral :: (Literal -> Literal) -> APattern a -> APattern a
updAPatLiteral f :: Literal -> Literal
f = (a -> a)
-> ((QName, a) -> (QName, a))
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> (Literal -> Literal)
-> APattern a
-> APattern a
forall a.
(a -> a)
-> ((QName, a) -> (QName, a))
-> ([(VarIndex, a)] -> [(VarIndex, a)])
-> (Literal -> Literal)
-> APattern a
-> APattern a
updAPattern a -> a
forall a. a -> a
id (QName, a) -> (QName, a)
forall a. a -> a
id [(VarIndex, a)] -> [(VarIndex, a)]
forall a. a -> a
id Literal -> Literal
f

-- Auxiliary Functions

-- |build expression from pattern
aPatExpr :: APattern a -> AExpr a
aPatExpr :: APattern a -> AExpr a
aPatExpr = (a -> (QName, a) -> [(VarIndex, a)] -> AExpr a)
-> (a -> Literal -> AExpr a) -> APattern a -> AExpr a
forall a b.
(a -> (QName, a) -> [(VarIndex, a)] -> b)
-> (a -> Literal -> b) -> APattern a -> b
trAPattern (\a :: a
a name :: (QName, a)
name -> a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
forall a. a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a
AComb a
a CombType
ConsCall (QName, a)
name ([AExpr a] -> AExpr a)
-> ([(VarIndex, a)] -> [AExpr a]) -> [(VarIndex, a)] -> AExpr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VarIndex, a) -> AExpr a) -> [(VarIndex, a)] -> [AExpr a]
forall a b. (a -> b) -> [a] -> [b]
map ((VarIndex -> a -> AExpr a) -> (VarIndex, a) -> AExpr a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> VarIndex -> AExpr a) -> VarIndex -> a -> AExpr a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> VarIndex -> AExpr a
forall a. a -> VarIndex -> AExpr a
AVar))) a -> Literal -> AExpr a
forall a. a -> Literal -> AExpr a
ALit