blob: a88b93fc8a12b05d8a9ae4aa99c4d798f8bd1b75 (
plain)
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
|
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoStarIsType #-}
module TH_unresolvedInfix_Lib where
import Language.Haskell.TH
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Quote
infixl 6 :+
infixl 7 :*
data Tree = N
| Tree :+ Tree
| Tree :* Tree
-- custom instance, including redundant parentheses
instance Show Tree where
show N = "N"
show (a :+ b) = "(" ++ show a ++ " :+ " ++ show b ++ ")"
show (a :* b) = "(" ++ show a ++ " :* " ++ show b ++ ")"
-- VarE versions
infixl 6 +:
infixl 7 *:
(+:) = (:+)
(*:) = (:*)
n = conE (mkName "N")
plus = conE (mkName ":+")
times = conE (mkName ":*")
a +? b = uInfixE a plus b
a *? b = uInfixE a times b
a +! b = infixApp a plus b
a *! b = infixApp a times b
plus2 = varE (mkName "+:")
times2 = varE (mkName "*:")
plus3 = conE ('(:+))
--------------------------------------------------------------------------------
-- Patterns --
--------------------------------------------------------------------------------
-- The only way to test pattern splices is using QuasiQuotation
mkQQ pat = QuasiQuoter undefined (const pat) undefined undefined
p = conP (mkName "N") []
plus' = mkName ":+"
times' = mkName ":*"
a ^+? b = uInfixP a plus' b
a ^*? b = uInfixP a times' b
a ^+! b = infixP a plus' b
a ^*! b = infixP a times' b
-------------- Completely-unresolved patterns
p1 = mkQQ ( p ^+? (p ^*? p) )
p2 = mkQQ ( (p ^+? p) ^*? p )
p3 = mkQQ ( p ^+? (p ^+? p) )
p4 = mkQQ ( (p ^+? p) ^+? p )
-------------- Completely-resolved patterns
p5 = mkQQ ( p ^+! (p ^*! p) )
p6 = mkQQ ( (p ^+! p) ^*! p )
p7 = mkQQ ( p ^+! (p ^+! p) )
p8 = mkQQ ( (p ^+! p) ^+! p )
-------------- Mixed resolved/unresolved
p9 = mkQQ ( (p ^+! p) ^*? (p ^+? p) )
p10 = mkQQ ( (p ^+? p) ^*? (p ^+! p) )
p11 = mkQQ ( (p ^+? p) ^*! (p ^+! p) )
p12 = mkQQ ( (p ^+? p) ^*! (p ^+? p) )
-------------- Parens
p13 = mkQQ ( ((parensP ((p ^+? p) ^*? p)) ^+? p) ^*? p )
p14 = mkQQ ( (parensP (p ^+? p)) ^*? (parensP (p ^+? p)) )
p15 = mkQQ ( parensP ((p ^+? p) ^*? (p ^+? p)) )
-------------- Dropping constructors
p16 = mkQQ ( p ^*? (tupP [p ^+? p]) )
--------------------------------------------------------------------------------
-- Types --
--------------------------------------------------------------------------------
infixl 6 +
infixl 7 *
data (+) a b = Plus a b
data (*) a b = Times a b
int = conT (mkName "Int")
tyPlus = mkName "+"
tyTimes = mkName "*"
a $+? b = uInfixT a tyPlus b
a $*? b = uInfixT a tyTimes b
a $+! b = infixT a tyPlus b
a $*! b = infixT a tyTimes b
|
