author | Tony Garnock-Jones <tonygarnockjones@gmail.com> |
Tue, 25 May 2010 08:09:57 +1200 | |
changeset 285 | 034958cf32d9 |
parent 136 | d6959e110ed0 |
permissions | -rw-r--r-- |
134
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1 |
module PatRewrite where |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2 |
|
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
3 |
import qualified Maybe |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
4 |
|
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
5 |
type Literal = String -- good enough for now |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
6 |
|
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
7 |
type Varname = String |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
8 |
|
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
9 |
data ConcretePat = CAnd ConcretePat ConcretePat |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
10 |
| CDiscard |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
11 |
| CBinding Varname |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
12 |
| CTuple [ConcretePat] |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
13 |
| CLiteral Literal |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
14 |
deriving Show |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
15 |
|
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
16 |
data Value = VLiteral Literal |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
17 |
| VTuple [Value] |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
18 |
deriving Show |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
19 |
|
135 | 20 |
-- Pattern matcher: |
21 |
-- v -> sk -> fk -> result |
|
22 |
-- Value -> (Bindings -> a) -> (() -> a) -> a |
|
23 |
-- Value -> ([(Varname, Value)] -> a) -> (() -> a) -> a |
|
24 |
||
25 |
-- data MatchTree = MDiscard Outcome |
|
26 |
-- | MBinding Varname Outcome |
|
27 |
-- | MTuple Integer Outcome |
|
28 |
-- | MLiteral Literal Outcome |
|
29 |
-- | MOr [MatchTree] |
|
30 |
||
134
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
31 |
names (CAnd l r) = names l ++ names r |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
32 |
names (CDiscard) = [] |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
33 |
names (CBinding n) = [n] |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
34 |
names (CTuple ps) = concatMap names ps |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
35 |
names (CLiteral l) = [] |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
36 |
|
136
d6959e110ed0
Flip arg order to expose matcher type
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
135
diff
changeset
|
37 |
match (CAnd l r) v sk fk = match l v (\lbs -> match r v (\rbs -> sk (lbs ++ rbs)) fk) fk |
d6959e110ed0
Flip arg order to expose matcher type
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
135
diff
changeset
|
38 |
match (CDiscard) v sk fk = sk [] |
d6959e110ed0
Flip arg order to expose matcher type
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
135
diff
changeset
|
39 |
match (CBinding n) v sk fk = sk [(n, v)] |
d6959e110ed0
Flip arg order to expose matcher type
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
135
diff
changeset
|
40 |
match (CTuple ps) v sk fk = matchTuple ps v sk fk |
d6959e110ed0
Flip arg order to expose matcher type
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
135
diff
changeset
|
41 |
match (CLiteral l) v sk fk = matchLiteral l v sk fk |
134
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
42 |
|
136
d6959e110ed0
Flip arg order to expose matcher type
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
135
diff
changeset
|
43 |
matchLiteral pl (VLiteral vl) sk fk = if vl == pl then sk [] else fk () |
d6959e110ed0
Flip arg order to expose matcher type
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
135
diff
changeset
|
44 |
matchLiteral p (VTuple _) sk fk = fk () |
134
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
45 |
|
136
d6959e110ed0
Flip arg order to expose matcher type
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
135
diff
changeset
|
46 |
matchTuple ps (VLiteral _) sk fk = fk () |
d6959e110ed0
Flip arg order to expose matcher type
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
135
diff
changeset
|
47 |
matchTuple ps (VTuple vs) sk fk = matchTuple' ps vs sk fk |
134
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
48 |
|
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
49 |
matchTuple' [] [] sk fk = sk [] |
136
d6959e110ed0
Flip arg order to expose matcher type
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
135
diff
changeset
|
50 |
matchTuple' (p:ps) (v:vs) sk fk = match p v (\bs -> matchTuple' ps vs (\bss -> sk (bs ++ bss)) fk) fk |
d6959e110ed0
Flip arg order to expose matcher type
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
135
diff
changeset
|
51 |
matchTuple' _ _ sk fk = fk () |
134
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
52 |
|
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
53 |
-- We want a compiled matcher to be of type |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
54 |
-- Value -> Maybe ([Value], ClosureBody, ClosureEnv) |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
55 |
|
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
56 |
-- (a, (b1,b2)#(c,_)) |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
57 |
t1 = CTuple [CBinding "a", |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
58 |
CAnd (CTuple [CBinding "b1", CBinding "b2"]) |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
59 |
(CTuple [CBinding "c", CDiscard])] |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
60 |
|
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
61 |
v1 = VTuple [VLiteral "x", |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
62 |
VTuple [VLiteral "y", VLiteral "z"]] |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
63 |
|
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
64 |
-- a#(_,_) |
b9fec4ef5582
Experiment with pattern-expansion in Haskell
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
65 |
t2 = CAnd (CBinding "a") (CTuple [CDiscard, CDiscard]) |