GenLexOrd.dcl 924 Bytes
Newer Older
Camil Staps's avatar
Camil Staps committed
1
definition module Data.GenLexOrd
2

Camil Staps's avatar
Camil Staps committed
3
import StdGeneric, Data.GenEq
4

Steffen Michels's avatar
Steffen Michels committed
5
:: LexOrd = LT | EQ | GT
6 7
derive gEq LexOrd

Steffen Michels's avatar
Steffen Michels committed
8
generic gLexOrd a :: !a !a -> LexOrd
9 10

// base cases
Steffen Michels's avatar
Steffen Michels committed
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
gLexOrd{|UNIT|} UNIT UNIT = EQ
gLexOrd{|PAIR|} fx fy (PAIR x1 y1) (PAIR x2 y2) = case fx x1 x2 of
	EQ -> fy y1 y2
	LT -> LT
	GT -> GT

gLexOrd{|EITHER|} fl fr (LEFT x) (LEFT y) = fl x y
gLexOrd{|EITHER|} fl fr (LEFT x) (RIGHT y) = LT
gLexOrd{|EITHER|} fl fr (RIGHT x) (LEFT y) = GT
gLexOrd{|EITHER|} fl fr (RIGHT x) (RIGHT y) = fr x y

gLexOrd{|CONS|} f (CONS x) (CONS y) = f x y
gLexOrd{|FIELD|} f (FIELD x) (FIELD y) = f x y
gLexOrd{|OBJECT|} f (OBJECT x) (OBJECT y) = f x y
gLexOrd{|RECORD|} f (RECORD x) (RECORD y) = f x y

derive gLexOrd Char, Bool, Int, Real, String, [], {}, {!}
28 29 30 31

// standard types
derive gLexOrd (,), (,,),  (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)

32
//* @type a a -> LexOrd | gLexOrd{|*|} a
Steffen Michels's avatar
Steffen Michels committed
33 34
(=?=) infix 4
(=?=) x y :== gLexOrd{|*|} x y