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
97
98
99
100
101
102
103
104
105
106
107
108
109
|
{-# LANGUAGE QuasiQuotes #-}
module Main where
import TH_unresolvedInfix_Lib
import Language.Haskell.TH
--------------------------------------------------------------------------------
-- Expressions --
--------------------------------------------------------------------------------
exprs = [
-------------- Completely-unresolved bindings
$( n +? (n *? n) ),
$( (n +? n) *? n ),
$( n +? (n +? n) ),
$( (n +? n) +? n ),
-- VarE version
$( uInfixE n plus2 (uInfixE n plus2 n) ),
$( uInfixE (uInfixE n plus2 n) plus2 n ),
$( uInfixE n plus3 (uInfixE n plus3 n) ),
$( uInfixE (uInfixE n plus3 n) plus3 n ),
--------------- Completely-resolved bindings
$( n +! (n *! n) ),
$( (n +! n) *! n ),
$( n +! (n +! n) ),
$( (n +! n) +! n ),
-------------- Mixed resolved/unresolved
$( (n +! n) *? (n +? n) ),
$( (n +? n) *? (n +! n) ),
$( (n +? n) *! (n +! n) ),
$( (n +? n) *! (n +? n) ),
-------------- Parens
$( ((parensE ((n +? n) *? n)) +? n) *? n ),
$( (parensE (n +? n)) *? (parensE (n +? n)) ),
$( parensE ((n +? n) *? (n +? n)) ),
-------------- Sections
$( infixE (Just $ n +? n) plus Nothing ) N,
-- see B.hs for the (non-compiling) other version of the above
$( infixE Nothing plus (Just $ parensE $ uInfixE n plus n) ) N,
-------------- Dropping constructors
$( n *? tupE [n +? n] )
]
--------------------------------------------------------------------------------
-- Patterns --
--------------------------------------------------------------------------------
patterns = [
-------------- Completely-unresolved patterns
case N :+ (N :* N) of
[p1|unused|] -> True,
case N :+ (N :* N) of
[p2|unused|] -> True,
case (N :+ N) :+ N of
[p3|unused|] -> True,
case (N :+ N) :+ N of
[p4|unused|] -> True,
-------------- Completely-resolved patterns
case N :+ (N :* N) of
[p5|unused|] -> True,
case (N :+ N) :* N of
[p6|unused|] -> True,
case N :+ (N :+ N) of
[p7|unused|] -> True,
case (N :+ N) :+ N of
[p8|unused|] -> True,
-------------- Mixed resolved/unresolved
case ((N :+ N) :* N) :+ N of
[p9|unused|] -> True,
case N :+ (N :* (N :+ N)) of
[p10|unused|] -> True,
case (N :+ N) :* (N :+ N) of
[p11|unused|] -> True,
case (N :+ N) :* (N :+ N) of
[p12|unused|] -> True,
-------------- Parens
case (N :+ (N :* N)) :+ (N :* N) of
[p13|unused|] -> True,
case (N :+ N) :* (N :+ N) of
[p14|unused|] -> True,
case (N :+ (N :* N)) :+ N of
[p15|unused|] -> True,
-------------- Dropping constructors
case (N :* (N :+ N)) of
[p16|unused|] -> True
]
main = do
mapM_ print exprs
mapM_ print patterns
-- check that there are no Parens or UInfixes in the output
runQ [|N :* N :+ N|] >>= print
runQ [|(N :* N) :+ N|] >>= print
runQ [p|N :* N :+ N|] >>= print
runQ [p|(N :* N) :+ N|] >>= print
-- pretty-printing of unresolved infix expressions
let ne = ConE $ mkName "N"
np = ConP (mkName "N") []
plusE = ConE (mkName ":+")
plusP = (mkName ":+")
putStrLn $ pprint (InfixE (Just ne) plusE (Just $ UInfixE ne plusE (UInfixE ne plusE ne)))
putStrLn $ pprint (ParensE ne)
putStrLn $ pprint (InfixP np plusP (UInfixP np plusP (UInfixP np plusP np)))
putStrLn $ pprint (ParensP np)
|
