Idris2-boot/libs/prelude/Prelude.idr

1253 lines
25 KiB
Idris
Raw Normal View History

2019-06-13 15:23:21 +03:00
module Prelude
import public Builtin
import public PrimIO
{-
The Prelude is minimal (since it is effectively part of the language
specification, this seems to be desirable - we should, nevertheless, aim to
provide a good selection of base libraries). A rule of thumb is that it should
contain the basic functions required by almost any non-trivial program.
As such, it should contain:
- Anything the elaborator can desugar to (e.g. pairs, unit, =, laziness)
- Basic types Bool, Nat, List, Dec, Maybe, Either
- The most important utility functions: id, the, composition, etc
- Interfaces for arithmetic and implementations for the primitives and
basic types
- Char and String manipulation
- Show, Eq, Ord, and implementations for all types in the prelude
- Interfaces and functions for basic proof (cong, Uninhabited, etc) --
- Semigroup, Monoid
- Functor, Applicative, Monad and related functions
- Foldable
- [TODO: Enum for range syntax]
- Console IO
Everything else should be in the base libraries, and imported as required.
In particular, proofs of Nat/List properties that almost never get used in
practice would probably be better in base libraries.
(These guidelines will probably get revised a few times.)
-}
-- Numerical operators
infix 6 ==, /=, <, <=, >, >=
infixl 7 <<, >> -- unused
infixl 8 +, -
infixl 9 *, /
-- Boolean operators
infixr 4 &&
infixr 5 ||
-- List and String operators
infixr 7 ::, ++
-- Functor/Applicative/Monad/Algebra operators
infixl 1 >>=
infixr 2 <|>
infixl 3 <*>, *>, <*
infixr 4 <$>
infixl 6 <+>
-- Utility operators
infixr 9 .
infixr 0 $
infixl 9 `div`, `mod`
-----------------------
-- UTILITY FUNCTIONS --
-----------------------
public export %inline
the : (0 a : Type) -> (1 x : a) -> a
the _ x = x
public export %inline
id : (x : a) -> a
id x = x
public export %inline
const : a -> b -> a
const x = \value => x
public export %inline
(.) : (b -> c) -> (a -> b) -> a -> c
(.) f g = \x => f (g x)
public export
flip : (f : a -> b -> c) -> b -> a -> c
flip f x y = f y x
public export
apply : (a -> b) -> a -> b
apply f a = f a
-- $ is compiled specially to shortcut any tricky unification issues, but if
-- it did have a type this is what it would be, and it might be useful to
-- use directly sometimes (e.g. in higher order functions)
public export
($) : forall a, b . ((x : a) -> b x) -> (x : a) -> b x
($) f a = f a
-------------------
-- PROOF HELPERS --
-------------------
public export
cong : {0 f : t -> u} -> a = b -> f a = f b
cong Refl = Refl
public export
interface Uninhabited t where
uninhabited : t -> Void
%extern
public export
void : Void -> a
export
Uninhabited Void where
uninhabited = id
public export
absurd : Uninhabited t => (h : t) -> a
absurd h = void (uninhabited h)
public export
Not : Type -> Type
Not x = x -> Void
--------------
-- BOOLEANS --
--------------
public export
data Bool = True | False
public export
not : Bool -> Bool
not True = False
not False = True
public export
(&&) : Bool -> Lazy Bool -> Bool
(&&) True x = x
(&&) False x = False
public export
(||) : Bool -> Lazy Bool -> Bool
(||) True x = True
(||) False x = x
%inline
public export
intToBool : Int -> Bool
intToBool 0 = False
intToBool x = True
------------------------
-- EQUALITY, ORDERING --
------------------------
public export
interface Eq ty where
(==) : ty -> ty -> Bool
(/=) : ty -> ty -> Bool
x == y = not (x /= y)
x /= y = not (x == y)
public export
Eq () where
_ == _ = True
public export
Eq Bool where
True == True = True
False == False = True
_ == _ = False
public export
Eq Int where
x == y = intToBool (prim__eq_Int x y)
public export
Eq Integer where
x == y = intToBool (prim__eq_Integer x y)
public export
Eq Double where
x == y = intToBool (prim__eq_Double x y)
public export
Eq Char where
x == y = intToBool (prim__eq_Char x y)
public export
Eq String where
x == y = intToBool (prim__eq_String x y)
public export
Eq a => Eq b => Eq (a, b) where
(x1, y1) == (x2, y2) = x1 == x2 && y1 == y2
public export
data Ordering = LT | EQ | GT
public export
Eq Ordering where
LT == LT = True
EQ == EQ = True
GT == GT = True
_ == _ = False
public export
interface Eq ty => Ord ty where
compare : ty -> ty -> Ordering
(<) : ty -> ty -> Bool
(<) x y = compare x y == LT
(>) : ty -> ty -> Bool
(>) x y = compare x y == GT
(<=) : ty -> ty -> Bool
(<=) x y = compare x y /= GT
(>=) : ty -> ty -> Bool
(>=) x y = compare x y /= LT
max : ty -> ty -> ty
max x y = if x > y then x else y
min : ty -> ty -> ty
min x y = if (x < y) then x else y
public export
Ord () where
compare _ _ = EQ
public export
Ord Bool where
compare False False = EQ
compare False True = LT
compare True False = GT
compare True True = EQ
public export
Ord Int where
compare x y = if x < y then LT else if x == y then EQ else GT
(<) x y = intToBool (prim__lt_Int x y)
(<=) x y = intToBool (prim__lte_Int x y)
(>) x y = intToBool (prim__gt_Int x y)
(>=) x y = intToBool (prim__gte_Int x y)
public export
Ord Integer where
compare x y = if x < y then LT else if x == y then EQ else GT
(<) x y = intToBool (prim__lt_Integer x y)
(<=) x y = intToBool (prim__lte_Integer x y)
(>) x y = intToBool (prim__gt_Integer x y)
(>=) x y = intToBool (prim__gte_Integer x y)
public export
Ord Double where
compare x y = if x < y then LT else if x == y then EQ else GT
(<) x y = intToBool (prim__lt_Double x y)
(<=) x y = intToBool (prim__lte_Double x y)
(>) x y = intToBool (prim__gt_Double x y)
(>=) x y = intToBool (prim__gte_Double x y)
public export
Ord String where
compare x y = if x < y then LT else if x == y then EQ else GT
(<) x y = intToBool (prim__lt_String x y)
(<=) x y = intToBool (prim__lte_String x y)
(>) x y = intToBool (prim__gt_String x y)
(>=) x y = intToBool (prim__gte_String x y)
public export
Ord Char where
compare x y = if x < y then LT else if x == y then EQ else GT
(<) x y = intToBool (prim__lt_Char x y)
(<=) x y = intToBool (prim__lte_Char x y)
(>) x y = intToBool (prim__gt_Char x y)
(>=) x y = intToBool (prim__gte_Char x y)
public export
Ord a => Ord b => Ord (a, b) where
compare (x1, y1) (x2, y2)
= if x1 /= x2 then compare x1 x2
else compare y1 y2
------------------------
-- NUMERIC INTERFACES --
------------------------
%integerLit fromInteger
public export
interface Num ty where
(+) : ty -> ty -> ty
(*) : ty -> ty -> ty
fromInteger : Integer -> ty
%allow_overloads fromInteger
public export
interface Num ty => Neg ty where
negate : ty -> ty
(-) : ty -> ty -> ty
public export
interface Num ty => Abs ty where
abs : ty -> ty
public export
interface Num ty => Fractional ty where
(/) : ty -> ty -> ty
recip : ty -> ty
recip x = 1 / x
public export
interface Num ty => Integral ty where
div : ty -> ty -> ty
mod : ty -> ty -> ty
----- instances for primitives
-- Integer
public export
Num Integer where
(+) = prim__add_Integer
(*) = prim__mul_Integer
fromInteger = id
public export
2019-06-13 15:23:21 +03:00
Neg Integer where
negate x = prim__sub_Integer 0 x
(-) = prim__sub_Integer
public export
2019-06-13 15:23:21 +03:00
Abs Integer where
abs x = if x < 0 then -x else x
public export
2019-06-13 15:23:21 +03:00
Integral Integer where
div x y
= case y == 0 of
False => prim__div_Integer x y
mod x y
= case y == 0 of
False => prim__mod_Integer x y
-- This allows us to pick integer as a default at the end of elaboration if
-- all other possibilities fail. I don't plan to provide a nicer syntax for
-- this...
%defaulthint
public export
defaultInteger : Num Integer
defaultInteger = %search
-- Int
public export
Num Int where
(+) = prim__add_Int
(*) = prim__mul_Int
fromInteger = prim__cast_IntegerInt
public export
2019-06-13 15:23:21 +03:00
Neg Int where
negate x = prim__sub_Int 0 x
(-) = prim__sub_Int
public export
2019-06-13 15:23:21 +03:00
Abs Int where
abs x = if x < 0 then -x else x
public export
2019-06-13 15:23:21 +03:00
Integral Int where
div x y
= case y == 0 of
False => prim__div_Int x y
mod x y
= case y == 0 of
False => prim__mod_Int x y
-- Double
public export
Num Double where
(+) = prim__add_Double
(*) = prim__mul_Double
fromInteger = prim__cast_IntegerDouble
public export
2019-06-13 15:23:21 +03:00
Neg Double where
negate x = prim__negate_Double x
(-) = prim__sub_Double
public export
2019-06-13 15:23:21 +03:00
Abs Double where
abs x = if x < 0 then -x else x
public export
2019-06-13 15:23:21 +03:00
Fractional Double where
(/) = prim__div_Double
-------------
-- ALGEBRA --
-------------
public export
interface Semigroup ty where
(<+>) : ty -> ty -> ty
public export
interface Semigroup ty => Monoid ty where
neutral : ty
---------------------------------
-- FUNCTOR, APPLICATIVE, MONAD --
---------------------------------
public export
interface Functor f where
map : (a -> b) -> f a -> f b
public export
(<$>) : Functor f => (func : a -> b) -> f a -> f b
(<$>) func x = map func x
public export
interface Functor f => Applicative f where
pure : a -> f a
(<*>) : f (a -> b) -> f a -> f b
public export
(<*) : Applicative f => f a -> f b -> f a
a <* b = map const a <*> b
public export
(*>) : Applicative f => f a -> f b -> f b
a *> b = map (const id) a <*> b
%allow_overloads pure
%allow_overloads (<*)
%allow_overloads (*>)
public export
interface Applicative f => Alternative f where
empty : f a
(<|>) : f a -> f a -> f a
public export
interface Applicative m => Monad m where
(>>=) : m a -> (a -> m b) -> m b
join : m (m a) -> m a
-- default implementations
(>>=) x f = join (f <$> x)
join x = x >>= id
%allow_overloads (>>=)
public export
guard : Alternative f => Bool -> f ()
guard x = if x then pure () else empty
public export
when : Applicative f => Bool -> Lazy (f ()) -> f ()
when True f = f
when False f = pure ()
---------------------------
-- FOLDABLE, TRAVERSABLE --
---------------------------
public export
interface Foldable (t : Type -> Type) where
foldr : (func : elem -> acc -> acc) -> (init : acc) -> (input : t elem) -> acc
foldl : (func : acc -> elem -> acc) -> (init : acc) -> (input : t elem) -> acc
foldl f z t = foldr (flip (.) . flip f) id t z
public export
concat : (Foldable t, Monoid a) => t a -> a
concat = foldr (<+>) neutral
public export
concatMap : (Foldable t, Monoid m) => (a -> m) -> t a -> m
concatMap f = foldr ((<+>) . f) neutral
public export
and : Foldable t => t (Lazy Bool) -> Bool
and = foldl (&&) True
public export
or : Foldable t => t (Lazy Bool) -> Bool
or = foldl (||) False
public export
any : Foldable t => (a -> Bool) -> t a -> Bool
any p = foldl (\x,y => x || p y) False
public export
all : Foldable t => (a -> Bool) -> t a -> Bool
all p = foldl (\x,y => x && p y) True
public export
sum : (Foldable t, Num a) => t a -> a
sum = foldr (+) 0
public export
product : (Foldable t, Num a) => t a -> a
product = foldr (*) 1
-----------
-- NATS ---
-----------
public export
data Nat = Z | S Nat
%name Nat k, j, i
public export
integerToNat : Integer -> Nat
integerToNat x
= if intToBool (prim__eq_Integer x 0)
then Z
else S (assert_total (integerToNat (prim__sub_Integer x 1)))
-- Define separately so we can spot the name when optimising Nats
public export
plus : Nat -> Nat -> Nat
plus Z y = y
plus (S k) y = S (plus k y)
public export
mult : Nat -> Nat -> Nat
mult Z y = Z
mult (S k) y = plus y (mult k y)
public export
Num Nat where
(+) = plus
(*) = mult
fromInteger x = integerToNat x
public export
Eq Nat where
Z == Z = True
S j == S k = j == k
_ == _ = False
public export
Ord Nat where
compare Z Z = EQ
compare Z (S k) = LT
compare (S k) Z = GT
compare (S j) (S k) = compare j k
public export
natToInteger : Nat -> Integer
natToInteger Z = 0
natToInteger (S k) = 1 + natToInteger k
-----------
-- MAYBE --
-----------
public export
data Maybe : (ty : Type) -> Type where
Nothing : Maybe ty
Just : (1 x : ty) -> Maybe ty
public export
maybe : Lazy b -> Lazy (a -> b) -> Maybe a -> b
maybe n j Nothing = n
maybe n j (Just x) = j x
public export
Eq a => Eq (Maybe a) where
Nothing == Nothing = True
Nothing == (Just _) = False
(Just _) == Nothing = False
(Just a) == (Just b) = a == b
public export
Ord a => Ord (Maybe a) where
compare Nothing Nothing = EQ
compare Nothing (Just _) = LT
compare (Just _) Nothing = GT
compare (Just a) (Just b) = compare a b
public export
Semigroup (Maybe a) where
Nothing <+> m = m
(Just x) <+> _ = Just x
public export
Monoid (Maybe a) where
neutral = Nothing
public export
Functor Maybe where
map f (Just x) = Just (f x)
map f Nothing = Nothing
public export
Applicative Maybe where
pure = Just
Just f <*> Just a = Just (f a)
_ <*> _ = Nothing
public export
Alternative Maybe where
empty = Nothing
(Just x) <|> _ = Just x
Nothing <|> v = v
public export
Monad Maybe where
Nothing >>= k = Nothing
(Just x) >>= k = k x
public export
Foldable Maybe where
foldr _ z Nothing = z
foldr f z (Just x) = f x z
---------
-- DEC --
---------
public export
data Dec : Type -> Type where
Yes : (prf : prop) -> Dec prop
No : (contra : prop -> Void) -> Dec prop
------------
-- EITHER --
------------
public export
data Either : (a : Type) -> (b : Type) -> Type where
Left : forall a, b. (1 x : a) -> Either a b
Right : forall a, b. (1 x : b) -> Either a b
public export
either : Lazy (a -> c) -> Lazy (b -> c) -> Either a b -> c
either l r (Left x) = l x
either l r (Right x) = r x
public export
(Eq a, Eq b) => Eq (Either a b) where
Left x == Left x' = x == x'
Right x == Right x' = x == x'
_ == _ = False
public export
Functor (Either e) where
map f (Left x) = Left x
map f (Right x) = Right (f x)
public export
Applicative (Either e) where
pure = Right
(Left a) <*> _ = Left a
(Right f) <*> (Right r) = Right (f r)
(Right _) <*> (Left l) = Left l
public export
Monad (Either e) where
(Left n) >>= _ = Left n
(Right r) >>= f = f r
-----------
-- LISTS --
-----------
public export
data List a = Nil | (::) a (List a)
%name List xs, ys, zs
public export
Eq a => Eq (List a) where
[] == [] = True
x :: xs == y :: ys = x == y && xs == ys
_ == _ = False
public export
Ord a => Ord (List a) where
compare [] [] = EQ
compare [] (x :: xs) = LT
compare (x :: xs) [] = GT
compare (x :: xs) (y ::ys)
= case compare x y of
EQ => compare xs ys
c => c
namespace List
public export
(++) : List a -> List a -> List a
[] ++ ys = ys
(x :: xs) ++ ys = x :: xs ++ ys
public export
Functor List where
map f [] = []
map f (x :: xs) = f x :: map f xs
public export
Semigroup (List a) where
(<+>) = (++)
public export
Monoid (List a) where
neutral = []
public export
Foldable List where
foldr c n [] = n
foldr c n (x::xs) = c x (foldr c n xs)
foldl f q [] = q
foldl f q (x::xs) = foldl f (f q x) xs
public export
Applicative List where
pure x = [x]
fs <*> vs = concatMap (\f => map f vs) fs
public export
Alternative List where
empty = []
(<|>) = (++)
public export
Monad List where
m >>= f = concatMap f m
public export
elem : Eq a => a -> List a -> Bool
x `elem` [] = False
x `elem` (y :: ys) = if x == y then True else x `elem` ys
-------------
-- STREAMS --
-------------
namespace Stream
public export
data Stream : Type -> Type where
(::) : a -> Inf (Stream a) -> Stream a
public export
Functor Stream where
map f (x :: xs) = f x :: map f xs
public export
head : Stream a -> a
head (x :: xs) = x
public export
tail : Stream a -> Stream a
tail (x :: xs) = xs
public export
take : Nat -> Stream a -> List a
take Z xs = []
take (S k) (x :: xs) = x :: take k xs
-------------
-- STRINGS --
-------------
namespace Strings
public export
(++) : (1 x : String) -> (1 y : String) -> String
x ++ y = prim__strAppend x y
public export
length : String -> Nat
length str = fromInteger (prim__cast_IntInteger (prim__strLength str))
public export
reverse : String -> String
reverse = prim__strReverse
public export
substr : Nat -> Nat -> String -> String
substr s e = prim__strSubstr (prim__cast_IntegerInt (natToInteger s))
(prim__cast_IntegerInt (natToInteger e))
public export
strCons : Char -> String -> String
strCons = prim__strCons
public export
strUncons : String -> Maybe (Char, String)
strUncons "" = Nothing
strUncons str = Just (prim__strHead str, prim__strTail str)
export
pack : List Char -> String
pack [] = ""
pack (x :: xs) = strCons x (pack xs)
export
fastPack : List Char -> String
fastPack xs
= unsafePerformIO (schemeCall String "string" (toFArgs xs))
where
toFArgs : List Char -> FArgList
toFArgs [] = []
toFArgs (x :: xs) = x :: toFArgs xs
export
unpack : String -> List Char
unpack str = unpack' 0 (prim__cast_IntegerInt (natToInteger (length str))) str
where
unpack' : Int -> Int -> String -> List Char
unpack' pos len str
= if pos >= len
then []
else (prim__strIndex str pos) :: unpack' (pos + 1) len str
public export
Semigroup String where
(<+>) = (++)
public export
Monoid String where
neutral = ""
----------------
-- CHARACTERS --
----------------
public export
isUpper : Char -> Bool
isUpper x = x >= 'A' && x <= 'Z'
public export
isLower : Char -> Bool
isLower x = x >= 'a' && x <= 'z'
public export
isAlpha : Char -> Bool
isAlpha x = isUpper x || isLower x
public export
isDigit : Char -> Bool
isDigit x = (x >= '0' && x <= '9')
public export
isAlphaNum : Char -> Bool
isAlphaNum x = isDigit x || isAlpha x
public export
isSpace : Char -> Bool
isSpace x
= x == ' ' || x == '\t' || x == '\r' ||
x == '\n' || x == '\f' || x == '\v' ||
x == '\xa0'
public export
isNL : Char -> Bool
isNL x = x == '\r' || x == '\n'
public export
toUpper : Char -> Char
toUpper x
= if (isLower x)
then prim__cast_IntChar (prim__cast_CharInt x - 32)
else x
public export
toLower : Char -> Char
toLower x
= if (isUpper x)
then prim__cast_IntChar (prim__cast_CharInt x + 32)
else x
public export
isHexDigit : Char -> Bool
isHexDigit x = elem (toUpper x) hexChars where
hexChars : List Char
hexChars
2019-06-13 15:23:21 +03:00
= ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
'A', 'B', 'C', 'D', 'E', 'F']
public export
isOctDigit : Char -> Bool
isOctDigit x = (x >= '0' && x <= '7')
public export
isControl : Char -> Bool
isControl x
= (x >= '\x0000' && x <= '\x001f')
|| (x >= '\x007f' && x <= '\x009f')
----------
-- SHOW --
----------
public export
data Prec = Open | Equal | Dollar | Backtick | User Nat | PrefixMinus | App
public export
precCon : Prec -> Integer
precCon Open = 0
precCon Equal = 1
precCon Dollar = 2
precCon Backtick = 3
precCon (User n) = 4
precCon PrefixMinus = 5
precCon App = 6
export
2019-06-13 15:23:21 +03:00
Eq Prec where
(==) (User m) (User n) = m == n
(==) x y = precCon x == precCon y
export
2019-06-13 15:23:21 +03:00
Ord Prec where
compare (User m) (User n) = compare m n
compare x y = compare (precCon x) (precCon y)
public export
interface Show ty where
show : (x : ty) -> String
show x = showPrec Open x
showPrec : (d : Prec) -> (x : ty) -> String
showPrec _ x = show x
showParens : (b : Bool) -> String -> String
showParens False s = s
showParens True s = "(" ++ s ++ ")"
export
showCon : (d : Prec) -> (conName : String) -> (shownArgs : String) -> String
showCon d conName shownArgs = showParens (d >= App) (conName ++ shownArgs)
export
showArg : Show a => (x : a) -> String
showArg x = " " ++ showPrec App x
firstCharIs : (Char -> Bool) -> String -> Bool
firstCharIs p "" = False
firstCharIs p str = p (assert_total (prim__strHead str))
2019-06-13 15:23:21 +03:00
primNumShow : (a -> String) -> Prec -> a -> String
primNumShow f d x = let str = f x in showParens (d >= PrefixMinus && firstCharIs (== '-') str) str
export
Show Int where
showPrec = primNumShow prim__cast_IntString
export
Show Integer where
showPrec = primNumShow prim__cast_IntegerString
export
Show Double where
showPrec = primNumShow prim__cast_DoubleString
protectEsc : (Char -> Bool) -> String -> String -> String
protectEsc p f s = f ++ (if firstCharIs p s then "\\&" else "") ++ s
showLitChar : Char -> String -> String
showLitChar '\a' = ("\\a" ++)
showLitChar '\b' = ("\\b" ++)
showLitChar '\f' = ("\\f" ++)
showLitChar '\n' = ("\\n" ++)
showLitChar '\r' = ("\\r" ++)
showLitChar '\t' = ("\\t" ++)
showLitChar '\v' = ("\\v" ++)
showLitChar '\SO' = protectEsc (== 'H') "\\SO"
showLitChar '\DEL' = ("\\DEL" ++)
showLitChar '\\' = ("\\\\" ++)
showLitChar c
= case getAt (fromInteger (prim__cast_CharInteger c)) asciiTab of
Just k => strCons '\\' . (k ++)
Nothing => if (c > '\DEL')
then strCons '\\' . protectEsc isDigit (show (prim__cast_CharInt c))
else strCons c
where
asciiTab : List String
asciiTab
2019-06-13 15:23:21 +03:00
= ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
"BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",
"DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
"CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US"]
getAt : Nat -> List String -> Maybe String
getAt Z (x :: xs) = Just x
getAt (S k) (x :: xs) = getAt k xs
getAt _ [] = Nothing
showLitString : List Char -> String -> String
showLitString [] = id
showLitString ('"'::cs) = ("\\\"" ++) . showLitString cs
showLitString (c ::cs) = (showLitChar c) . showLitString cs
export
Show Char where
show '\'' = "'\\''"
show c = strCons '\'' (showLitChar c "'")
export
Show String where
show cs = strCons '"' (showLitString (unpack cs) "\"")
export
Show Nat where
show n = show (the Integer (natToInteger n))
export
Show Bool where
show True = "True"
show False = "False"
export
Show () where
show () = "()"
export
(Show a, Show b) => Show (a, b) where
show (x, y) = "(" ++ show x ++ ", " ++ show y ++ ")"
export
(Show a, {y : a} -> Show (p y)) => Show (DPair a p) where
show (y ** prf) = "(" ++ show y ++ " ** " ++ show prf ++ ")"
export
Show a => Show (List a) where
show xs = "[" ++ show' "" xs ++ "]"
where
show' : String -> List a -> String
show' acc [] = acc
show' acc [x] = acc ++ show x
show' acc (x :: xs) = show' (acc ++ show x ++ ", ") xs
export
Show a => Show (Maybe a) where
showPrec d Nothing = "Nothing"
showPrec d (Just x) = showCon d "Just" (showArg x)
--------
-- IO --
--------
public export
Functor IO where
map f io = io_bind io (\b => io_pure (f b))
public export
Applicative IO where
pure x = io_pure x
f <*> a
= io_bind f (\f' =>
io_bind a (\a' =>
io_pure (f' a')))
public export
Monad IO where
b >>= k = io_bind b k
export
print : Show a => a -> IO ()
print x = putStr $ show x
export
printLn : Show a => a -> IO ()
printLn x = putStrLn $ show x
-----------------------
-- DOUBLE PRIMITIVES --
-----------------------
public export
pi : Double
pi = 3.14159265358979323846
public export
euler : Double
euler = 2.7182818284590452354
public export
exp : Double -> Double
exp x = prim__doubleExp x
public export
log : Double -> Double
log x = prim__doubleLog x
public export
pow : Double -> Double -> Double
pow x y = exp (y * log x)
public export
sin : Double -> Double
sin x = prim__doubleSin x
public export
cos : Double -> Double
cos x = prim__doubleCos x
public export
tan : Double -> Double
tan x = prim__doubleTan x
public export
asin : Double -> Double
asin x = prim__doubleASin x
public export
acos : Double -> Double
acos x = prim__doubleACos x
public export
atan : Double -> Double
atan x = prim__doubleATan x
public export
sinh : Double -> Double
sinh x = (exp x - exp (-x)) / 2
public export
cosh : Double -> Double
cosh x = (exp x + exp (-x)) / 2
public export
tanh : Double -> Double
tanh x = sinh x / cosh x
public export
sqrt : Double -> Double
sqrt x = prim__doubleSqrt x
public export
floor : Double -> Double
floor x = prim__doubleFloor x
public export
ceiling : Double -> Double
ceiling x = prim__doubleCeiling x
2019-06-13 15:23:21 +03:00
-----------
-- CASTS --
-----------
-- Casts between primitives only here. They might be lossy.
-- To String
public export
interface Cast from to where
cast : from -> to
export
Cast Int String where
cast = prim__cast_IntString
export
Cast Integer String where
cast = prim__cast_IntegerString
export
Cast Char String where
cast = prim__cast_CharString
export
Cast Double String where
cast = prim__cast_DoubleString
-- To Integer
export
Cast Int Integer where
cast = prim__cast_IntInteger
export
Cast Char Integer where
cast = prim__cast_CharInteger
export
Cast Double Integer where
cast = prim__cast_DoubleInteger
export
Cast String Integer where
cast = prim__cast_StringInteger
export
Cast Nat Integer where
cast = natToInteger
2019-06-13 15:23:21 +03:00
-- To Int
export
Cast Integer Int where
cast = prim__cast_IntegerInt
export
Cast Char Int where
cast = prim__cast_CharInt
export
Cast Double Int where
cast = prim__cast_DoubleInt
export
Cast String Int where
cast = prim__cast_StringInt
export
Cast Nat Int where
cast = fromInteger . natToInteger
2019-06-13 15:23:21 +03:00
-- To Char
export
Cast Int Char where
cast = prim__cast_IntChar
-- To Double
export
Cast Int Double where
cast = prim__cast_IntDouble
export
Cast Integer Double where
cast = prim__cast_IntegerDouble
export
Cast String Double where
cast = prim__cast_StringDouble
export
Cast Nat Double where
cast = prim__cast_IntegerDouble . natToInteger