Line | |
---|
1 | module Size where |
---|
2 | |
---|
3 | import Lambda |
---|
4 | import Ops |
---|
5 | import Data.Supply as S |
---|
6 | |
---|
7 | data Unsized |
---|
8 | |
---|
9 | class (LOps l) => Size l where |
---|
10 | list :: l Int -> l (Int -> a) -> l [a] |
---|
11 | slam :: (l Int -> l (Int -> a) -> l b) -> l ([a] -> b) |
---|
12 | shift :: l (Int -> a) -> l Int -> l (Int -> a) -> l (Int -> a) |
---|
13 | unsized :: l Unsized |
---|
14 | bottom :: l a |
---|
15 | |
---|
16 | instance Size S where |
---|
17 | unsized = S $ \_ _ -> showChar 'U' |
---|
18 | bottom = S $ \_ _ -> showChar 'âŽ' |
---|
19 | list size sexp = S $ \s p -> |
---|
20 | let (s1, s2) = S.split2 s |
---|
21 | in showParen (p>0) $ |
---|
22 | showString "List " . |
---|
23 | unS size s1 9 . |
---|
24 | showChar ' ' . |
---|
25 | unS sexp s2 9 |
---|
26 | slam f = S $ \s p -> |
---|
27 | let (s1, s2, s3) = S.split3 s |
---|
28 | v1 = S.supplyValue s1 |
---|
29 | showV1 = S $ \_ _ -> showVar v1 |
---|
30 | v2 = S.supplyValue s2 |
---|
31 | showV2 = S $ \_ _ -> showVar v2 |
---|
32 | in showParen (p>0) $ |
---|
33 | showChar 'Î' . |
---|
34 | showVar v1 . |
---|
35 | showChar ',' . |
---|
36 | showVar v2 . |
---|
37 | showChar '.' . |
---|
38 | unS (f showV1 showV2) s3 0 |
---|
39 | shift e1 ss e2 = S $ \s p -> |
---|
40 | let (s1, s2, s3) = S.split3 s |
---|
41 | in showParen (p>0) |
---|
42 | $ showString "Shift " |
---|
43 | . unS e1 s1 2 |
---|
44 | . showChar ' ' |
---|
45 | . unS ss s2 2 |
---|
46 | . showChar ' ' |
---|
47 | . unS e2 s3 2 |
---|
Note: See
TracBrowser
for help on using the repository browser.