1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96

-----------------------------------------------------------------------------
--- Auxiliaries to build FlatCurry types and expressions.
---
--- @author  Michael Hanus
--- @version December 2023
---------------------------------------------------------------------------

module FlatCurry.Build
  --( fcTrue, fcFalse, fcNot, fcOr, fcAnd, fcAnds )
 where

import FlatCurry.Types

------------------------------------------------------------------------------
-- Types:

--- The FlatCurry type `Bool`.
fcBool :: TypeExpr
fcBool = TCons (pre "Bool") []

--- The FlatCurry type `Int`.
fcInt:: TypeExpr
fcInt = TCons (pre "Int") []

--- The FlatCurry type `Float`.
fcFloat:: TypeExpr
fcFloat = TCons (pre "Float") []

--- The FlatCurry type `Char`.
fcChar :: TypeExpr
fcChar = TCons (pre "Char") []

--- The FlatCurry type `Ordering`.
fcOrdering :: TypeExpr
fcOrdering = TCons (pre "Ordering") []

--- Constructs a FlatCurry type list.
fcList :: TypeExpr -> TypeExpr
fcList te = TCons (pre "[]") [te]

------------------------------------------------------------------------------
-- Expressions:

--- `Prelude.True`
fcTrue :: Expr
fcTrue = Comb ConsCall (pre "True") []

--- `Prelude.False`
fcFalse :: Expr
fcFalse = Comb ConsCall (pre "False") []

--- Negation of an expression.
fcNot :: Expr -> Expr
fcNot e = case e of
  Comb ConsCall qf []      | qf == pre "False" -> fcTrue
                           | qf == pre "True"  -> fcFalse
  Comb FuncCall qf [e1]    | qf == pre "not"   -> e1
  Comb FuncCall qf [e1,e2] | qf == pre "&&"    -> fcOr  (fcNot e1) (fcNot e2)
                           | qf == pre "||"    -> fcAnd (fcNot e1) (fcNot e2)
  Case ct ce brs -> Case ct ce (map (\(Branch p be) -> Branch p (fcNot be)) brs)
  _                                            -> Comb FuncCall (pre "not") [e]

-- Disjunction of two expressions.
fcOr :: Expr -> Expr -> Expr
fcOr e1 e2 | e1 == fcFalse = e2
           | e2 == fcFalse = e1
           | e1 == fcTrue  = fcTrue
           | e2 == fcTrue  = fcTrue
           | otherwise     = Comb FuncCall (pre "||") [e1,e2]

-- Conjunction of two expressions.
fcAnd :: Expr -> Expr -> Expr
fcAnd e1 e2 | e1 == fcTrue  = e2
            | e2 == fcTrue  = e1
            | e1 == fcFalse = fcFalse
            | e2 == fcFalse = fcFalse
            | otherwise     = Comb FuncCall (pre "&&") [e1,e2]

-- Conjunction of a list of expressions.
fcAnds :: [Expr] -> Expr
fcAnds = foldr fcAnd fcTrue

-- Equality between two expressions.
fcEqu :: Expr -> Expr -> Expr
fcEqu e1 e2 = Comb FuncCall (pre "==") [e1,e2]

-- `Prelude.failed`
fcFailed :: Expr
fcFailed = Comb FuncCall (pre "failed") []

----------------------------------------------------------------------------
--- Transform name into Prelude-qualified name.
pre :: String -> QName
pre f = ("Prelude",f)

----------------------------------------------------------------------------