Rev | Line | |
---|
[21] | 1 | {-# LANGUAGE FlexibleInstances #-} |
---|
| 2 | |
---|
[20] | 3 | module Ops where |
---|
| 4 | |
---|
[21] | 5 | import qualified Data.Supply as S |
---|
| 6 | import Prelude (String, Int, ($), (.)) |
---|
| 7 | import qualified Prelude |
---|
[20] | 8 | import Lambda |
---|
[21] | 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.