Line | |
---|
1 | {-# LANGUAGE FlexibleInstances #-} |
---|
2 | |
---|
3 | module Ops where |
---|
4 | |
---|
5 | import qualified Data.Supply as S |
---|
6 | import Prelude (String, Int, ($), (.)) |
---|
7 | import qualified Prelude |
---|
8 | import Lambda |
---|
9 | |
---|
10 | class (Lambda l) => LOps l where |
---|
11 | infixop :: String -> Int -> (a -> b -> c) -> l a -> l b -> l c |
---|
12 | fun :: String -> a -> l a |
---|
13 | |
---|
14 | (+) :: l Int -> l Int -> l Int |
---|
15 | (+) = infixop "+" 4 (Prelude.+) |
---|
16 | |
---|
17 | (-) :: l Int -> l Int -> l Int |
---|
18 | (-) = infixop "-" 4 (Prelude.-) |
---|
19 | |
---|
20 | (*) :: l Int -> l Int -> l Int |
---|
21 | (*) = infixop "*" 5 (Prelude.*) |
---|
22 | |
---|
23 | |
---|
24 | instance LOps Q where |
---|
25 | infixop _ _ f lhs rhs = Q (eval lhs `f` eval rhs) |
---|
26 | fun _ = Q |
---|
27 | |
---|
28 | instance LOps S where |
---|
29 | fun name _ = S (\_ p -> Prelude.showsPrec p name) |
---|
30 | |
---|
31 | infixop name prec _ lhs rhs = S(\s p -> |
---|
32 | let (s1, s2) = S.split2 s |
---|
33 | in Prelude.showParen (p Prelude.> prec) $ |
---|
34 | unS lhs s1 prec . |
---|
35 | Prelude.showString name . |
---|
36 | unS rhs s2 (Prelude.succ prec) |
---|
37 | ) |
---|
Note: See
TracBrowser
for help on using the repository browser.