Line | |
---|
1 | module Exp where |
---|
2 | |
---|
3 | import Lambda |
---|
4 | import Ops |
---|
5 | import Data.Supply as S |
---|
6 | |
---|
7 | class LOps l => Exp l where |
---|
8 | nil :: l [a] |
---|
9 | cons :: l a -> l [a] -> l [a] |
---|
10 | cons = infixopr ":" 5 (:) |
---|
11 | match :: l [a] -> l b -> (l a -> l [a] -> l b) -> l b |
---|
12 | cond :: l Bool -> l a -> l a -> l a |
---|
13 | undefined :: l a |
---|
14 | |
---|
15 | instance Exp Q where |
---|
16 | nil = Q [] |
---|
17 | cons x xs = Q ( unQ x : unQ xs ) |
---|
18 | match l nbranch cbranch = case unQ l of |
---|
19 | [] -> nbranch |
---|
20 | (x:xs) -> cbranch (Q x) (Q xs) |
---|
21 | cond c tbranch fbranch = if unQ c then tbranch else fbranch |
---|
22 | undefined = Prelude.undefined |
---|
23 | instance Exp S where |
---|
24 | nil = S $ \_ _ -> showString "[]" |
---|
25 | undefined = S $ \_ _ -> showString "undefined" |
---|
26 | match list nbranch cbranch = S $ \s p -> |
---|
27 | let (s1, s2, ss) = S.split3 s |
---|
28 | (s3, s4, s5) = S.split3 ss |
---|
29 | v1 = S.supplyValue s4 |
---|
30 | showV1 = S $ \_ _ -> showVar v1 |
---|
31 | v2 = S.supplyValue s5 |
---|
32 | showV2 = S $ \_ _ -> showVar v2 |
---|
33 | in showParen (p>0) $ |
---|
34 | showString "case ". |
---|
35 | unS list s1 0 . |
---|
36 | showString " of [] => ". |
---|
37 | unS nbranch s2 0 . |
---|
38 | showString "; (" . showVar v1 . showChar ':' . showVar v2 . showString ") => " . |
---|
39 | unS (cbranch showV1 showV2) s3 0 |
---|
Note: See
TracBrowser
for help on using the repository browser.