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
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
/// # Definition
......@@ -19,10 +21,12 @@ instance Ord Bool
instance MeetSemilattice Bool
instance JoinSemilattice Bool
// IMPLICIT instance Lattice Bool
instance UpperBounded Bool
instance LowerBounded Bool
// IMPLICIT instance Bounded Bool
// instance Enum Bool
instance Enum Bool
/// # Operations
......
......@@ -3,6 +3,10 @@ implementation module Data.Bool
import Algebra.Order
import Algebra.Lattice
import Data.Nat
import Data.Enum
import Data.Function
import Text.Show
/// # Definition
......@@ -12,7 +16,7 @@ import Text.Show
/// # Instances
/// ## Show
/// ## Show and Parse
instance Show Bool where
show x = code inline {
......@@ -79,13 +83,22 @@ instance LowerBounded Bool where
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
not :: !Bool -> Bool
not x = code inline {
notB
}
notB
}
(&&) infixr 3 :: !Bool Bool -> Bool
(&&) x y = code {
......
system module Data.Char
from Data.Enum import class Enum
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
......@@ -21,7 +22,14 @@ instance Show Char
instance Eq 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
......
......@@ -44,6 +44,34 @@ instance Ord Char where
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
setLowercaseBit :: !Char -> Char
......
definition module Data.Enum
from Data.Nat import :: Nat
/// # Overloading
class Enum a where
toEnum :: !Nat -> a
fromEnum :: !a -> Nat
toEnum :: !Int -> a
fromEnum :: !a -> Int
succ :: !a -> a
pred :: !a -> a
succ :: !a -> a | Enum a
pred :: !a -> a | Enum a
enumFrom :: !a -> .[a]
enumFromTo :: !a !a -> .[a]
enumFromThen :: a a -> .[a]
enumFromThenTo :: !a !a !a -> .[a]
//TODO test [n..] for Bounded n
enumFrom :: !a -> .[a] | Enum a
enumFromTo :: !a !a -> .[a] | Enum a
enumFromThen :: !a !a -> .[a] | Enum a
enumFromThenTo :: !a !a !a -> .[a] | Enum a
//TODO patch compiler to use enum... functions
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
//IMPLICIT instance Bounded Int
instance Enum Int
/// # Helpers
inc :: !Int -> Int
dec :: !Int -> Int
......@@ -113,6 +113,8 @@ instance Domain Int where
lcm 0 _ = 0
lcm x y = abs ((x `quot` gcd x y) * y)
/// ## Lattices
instance MeetSemilattice Int where
(/\) x y = undefined /*code inline {
minI
......@@ -139,35 +141,14 @@ instance Enum Int where
no_op
}
succ x = code inline {
incI
}
pred x = code inline {
decI
}
/// # Helpers
inc :: !Int -> Int
inc x = code inline {
incI
}
//TODO move to class (defaults extension) or instance on Ord Ring (flexibles extension)
enumFrom x = [x : enumFrom (succ x)]
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 = []
dec :: !Int -> Int
dec x = code inline {
decI
}
......@@ -5,10 +5,14 @@ from Algebra.Group import class Semigroup, class Monoid
from Algebra.Ring import class Semiring, class Domain
from Algebra.Lattice import class MeetSemilattice, class JoinSemilattice, class UpperBounded, class LowerBounded
from Data.Enum import class Enum
from Text.Show import class Show
/// # 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
......@@ -31,6 +35,8 @@ instance JoinSemilattice Nat
instance UpperBounded Nat
instance LowerBounded Nat
instance Enum Nat
// instance Enum Nat
/// # Special Algebra
......
......@@ -20,8 +20,10 @@ nat n = code {
push_b 1
ltI
jmp_true abort_n
.d 0 1 i
rtn
:abort_n
buildAC "Data.Nat.nat: negative integer"
.d 1 0
......@@ -152,6 +154,16 @@ instance LowerBounded Nat where
pushI 0
}
/// ## Enum
instance Enum Nat where
toEnum n = code inline {
no_op
}
fromEnum n = code inline {
no_op
}
/// # Special Algebra
(.-) 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