Commit bd72daad authored by Tim Steenvoorden's avatar Tim Steenvoorden
Browse files

add enum and lattice instances for Nat, Int, Char and Bool

parent 3ac3c057
...@@ -3,6 +3,8 @@ system module Data.Bool ...@@ -3,6 +3,8 @@ system module Data.Bool
from Algebra.Order import class Eq, class Ord from Algebra.Order import class Eq, class Ord
from Algebra.Lattice import class MeetSemilattice, class JoinSemilattice, class UpperBounded, class LowerBounded from Algebra.Lattice import class MeetSemilattice, class JoinSemilattice, class UpperBounded, class LowerBounded
from Data.Enum import class Enum
from Text.Show import class Show from Text.Show import class Show
/// # Definition /// # Definition
...@@ -19,10 +21,12 @@ instance Ord Bool ...@@ -19,10 +21,12 @@ instance Ord Bool
instance MeetSemilattice Bool instance MeetSemilattice Bool
instance JoinSemilattice Bool instance JoinSemilattice Bool
// IMPLICIT instance Lattice Bool
instance UpperBounded Bool instance UpperBounded Bool
instance LowerBounded Bool instance LowerBounded Bool
// IMPLICIT instance Bounded Bool
// instance Enum Bool instance Enum Bool
/// # Operations /// # Operations
......
...@@ -3,6 +3,10 @@ implementation module Data.Bool ...@@ -3,6 +3,10 @@ implementation module Data.Bool
import Algebra.Order import Algebra.Order
import Algebra.Lattice import Algebra.Lattice
import Data.Nat
import Data.Enum
import Data.Function
import Text.Show import Text.Show
/// # Definition /// # Definition
...@@ -12,7 +16,7 @@ import Text.Show ...@@ -12,7 +16,7 @@ import Text.Show
/// # Instances /// # Instances
/// ## Show /// ## Show and Parse
instance Show Bool where instance Show Bool where
show x = code inline { show x = code inline {
...@@ -79,13 +83,22 @@ instance LowerBounded Bool where ...@@ -79,13 +83,22 @@ instance LowerBounded Bool where
pushB FALSE pushB FALSE
} }
/// ## Enum
instance Enum Bool where
toEnum 0 = False
toEnum 1 = True
toEnum _ = abort "Data.Bool.toEnum: bad argument"
fromEnum False = 0
fromEnum True = 1
/// # Operations /// # Operations
not :: !Bool -> Bool not :: !Bool -> Bool
not x = code inline { not x = code inline {
notB notB
} }
(&&) infixr 3 :: !Bool Bool -> Bool (&&) infixr 3 :: !Bool Bool -> Bool
(&&) x y = code { (&&) x y = code {
......
system module Data.Char system module Data.Char
from Data.Enum import class Enum
from Algebra.Order import class Eq, class Ord from Algebra.Order import class Eq, class Ord
from Algebra.Lattice import class MeetSemilattice, class JoinSemilattice, class UpperBounded, class LowerBounded
from Data.Enum import class Enum
from Text.Show import class Show from Text.Show import class Show
...@@ -21,7 +22,14 @@ instance Show Char ...@@ -21,7 +22,14 @@ instance Show Char
instance Eq Char instance Eq Char
instance Ord Char instance Ord Char
// instance Enum Char instance MeetSemilattice Char
instance JoinSemilattice Char
//IMPLICIT instance Lattice Char
instance UpperBounded Char
instance LowerBounded Char
//IMPLICIT instance Bounded Char
instance Enum Char
/// # Classification /// # Classification
......
...@@ -44,6 +44,34 @@ instance Ord Char where ...@@ -44,6 +44,34 @@ instance Ord Char where
ltC ltC
} }
/// ## Lattices
instance MeetSemilattice Char where
(/\) x y = undefined /*code inline {
minC
}*/
instance JoinSemilattice Char where
(\/) x y = undefined /*code inline {
maxC
}*/
instance UpperBounded Char where
top = undefined
instance LowerBounded Char where
bottom = undefined
/// ## Enum
instance Enum Char where
toEnum n = code inline {
CtoI
}
fromEnum n = code inline {
ItoC
}
/// # Classification /// # Classification
setLowercaseBit :: !Char -> Char setLowercaseBit :: !Char -> Char
......
definition module Data.Enum definition module Data.Enum
from Data.Nat import :: Nat
/// # Overloading /// # Overloading
class Enum a where class Enum a where
toEnum :: !Nat -> a toEnum :: !Int -> a
fromEnum :: !a -> Nat fromEnum :: !a -> Int
succ :: !a -> a succ :: !a -> a | Enum a
pred :: !a -> a pred :: !a -> a | Enum a
enumFrom :: !a -> .[a] //TODO test [n..] for Bounded n
enumFromTo :: !a !a -> .[a] enumFrom :: !a -> .[a] | Enum a
enumFromThen :: a a -> .[a] enumFromTo :: !a !a -> .[a] | Enum a
enumFromThenTo :: !a !a !a -> .[a] enumFromThen :: !a !a -> .[a] | Enum a
enumFromThenTo :: !a !a !a -> .[a] | Enum a
//TODO patch compiler to use enum... functions //TODO patch compiler to use enum... functions
implementation module Data.Enum implementation module Data.Enum
import Algebra.Order
import Algebra.Group
import Data.Int
/// # Default implementations
//FIXME move to Enum.succ and Enum.pred when default members are thre
succ :: !a -> a | Enum a
succ x = toEnum (inc nx)
where
nx = fromEnum x
//FIXME move to Enum.succ and Enum.pred when default members are thre
pred :: !a -> a | Enum a
pred x = toEnum (dec nx)
where
nx = fromEnum x
enumFrom :: !a -> .[a] | Enum a
enumFrom x = enumFrom nx
where
// enumFrom :: !Int -> .[a]
enumFrom n = [toEnum n : enumFrom (inc n)]
nx = fromEnum x
enumFromThen :: !a !a -> .[a] | Enum a
enumFromThen x y = [x : enumFromBy nx (ny - nx)]
where
// enumFromBy :: !Int !Int -> .[a]
enumFromBy n d = [toEnum n : enumFromBy (n + d) d]
nx = fromEnum x
ny = fromEnum y
// enumFromTo :: !a !a -> .[a] | Enum a
// enumFromTo x y
// | nx <= ny = [x : enumFromTo (inc x) y]
// | otherwise = []
// where
// nx = fromEnum x
// ny = fromEnum y
enumFromTo :: !a !a -> .[a] | Enum a
enumFromTo x z = enumFromTo nx nz
where
// enumFromTo :: !Int !Int -> .[a]
enumFromTo n m
| n <= m = [toEnum n : enumFromTo (inc n) m]
| otherwise = []
nx = fromEnum x
nz = fromEnum z
enumFromThenTo :: !a !a !a -> .[a] | Enum a
enumFromThenTo x y z
| nx <= ny = enumFromByUpto nx (ny - nx) nz
| otherwise = enumFromByDownto nx (nx - ny) nz
where
// enumFromByUpto :: !Int !Int !Int -> .[Int]
enumFromByUpto n d m
| n <= m = [toEnum n : enumFromByUpto (n + d) d m]
| otherwise = []
// enumFromByDownto :: !Int !Int !Int -> .[Int]
enumFromByDownto n d m
| n >= m = [toEnum n : enumFromByDownto (n - d) d m]
| otherwise = []
nx = fromEnum x
ny = fromEnum y
nz = fromEnum z
...@@ -36,3 +36,8 @@ instance LowerBounded Int ...@@ -36,3 +36,8 @@ instance LowerBounded Int
//IMPLICIT instance Bounded Int //IMPLICIT instance Bounded Int
instance Enum Int instance Enum Int
/// # Helpers
inc :: !Int -> Int
dec :: !Int -> Int
...@@ -113,6 +113,8 @@ instance Domain Int where ...@@ -113,6 +113,8 @@ instance Domain Int where
lcm 0 _ = 0 lcm 0 _ = 0
lcm x y = abs ((x `quot` gcd x y) * y) lcm x y = abs ((x `quot` gcd x y) * y)
/// ## Lattices
instance MeetSemilattice Int where instance MeetSemilattice Int where
(/\) x y = undefined /*code inline { (/\) x y = undefined /*code inline {
minI minI
...@@ -139,35 +141,14 @@ instance Enum Int where ...@@ -139,35 +141,14 @@ instance Enum Int where
no_op no_op
} }
succ x = code inline { /// # Helpers
incI
} inc :: !Int -> Int
pred x = code inline { inc x = code inline {
decI incI
} }
//TODO move to class (defaults extension) or instance on Ord Ring (flexibles extension) dec :: !Int -> Int
enumFrom x = [x : enumFrom (succ x)] dec x = code inline {
decI
enumFromTo x y }
| x <= y = [x : enumFromTo (succ x) y]
| otherwise = []
enumFromThen x y = [x : enumFromBy x (y - x)]
where
// enumFromBy x s :: Int Int -> .[Int]
enumFromBy x s = [x : enumFromBy (x + s) s]
enumFromThenTo x y z
| x <= y = enumFromByUpto x (y - x) z
| otherwise = enumFromByDownto x (x - y) z
where
// enumFromByUpto :: !Int !Int !Int -> .[Int]
enumFromByUpto x s z
| x <= z = [x : enumFromByUpto (x + s) s z]
| otherwise = []
// enumFromByDownto :: !Int !Int !Int -> .[Int]
enumFromByDownto x s z
| x >= z = [x : enumFromByDownto (x - s) s z]
| otherwise = []
...@@ -5,10 +5,14 @@ from Algebra.Group import class Semigroup, class Monoid ...@@ -5,10 +5,14 @@ from Algebra.Group import class Semigroup, class Monoid
from Algebra.Ring import class Semiring, class Domain from Algebra.Ring import class Semiring, class Domain
from Algebra.Lattice import class MeetSemilattice, class JoinSemilattice, class UpperBounded, class LowerBounded from Algebra.Lattice import class MeetSemilattice, class JoinSemilattice, class UpperBounded, class LowerBounded
from Data.Enum import class Enum
from Text.Show import class Show from Text.Show import class Show
/// # Definition /// # Definition
//FIXME Introduce new type in ABC-machine and Code Generator, mapping Nat to unsigned integers?
// :: Nat = 0 | 1 | 2 | ...
:: Nat (:== Int) :: Nat (:== Int)
nat :: !Int -> Nat nat :: !Int -> Nat
...@@ -31,6 +35,8 @@ instance JoinSemilattice Nat ...@@ -31,6 +35,8 @@ instance JoinSemilattice Nat
instance UpperBounded Nat instance UpperBounded Nat
instance LowerBounded Nat instance LowerBounded Nat
instance Enum Nat
// instance Enum Nat // instance Enum Nat
/// # Special Algebra /// # Special Algebra
......
...@@ -20,8 +20,10 @@ nat n = code { ...@@ -20,8 +20,10 @@ nat n = code {
push_b 1 push_b 1
ltI ltI
jmp_true abort_n jmp_true abort_n
.d 0 1 i .d 0 1 i
rtn rtn
:abort_n :abort_n
buildAC "Data.Nat.nat: negative integer" buildAC "Data.Nat.nat: negative integer"
.d 1 0 .d 1 0
...@@ -152,6 +154,16 @@ instance LowerBounded Nat where ...@@ -152,6 +154,16 @@ instance LowerBounded Nat where
pushI 0 pushI 0
} }
/// ## Enum
instance Enum Nat where
toEnum n = code inline {
no_op
}
fromEnum n = code inline {
no_op
}
/// # Special Algebra /// # Special Algebra
(.-) infixl 6 :: !Nat !Nat -> Nat (.-) infixl 6 :: !Nat !Nat -> Nat
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment