-
Notifications
You must be signed in to change notification settings - Fork 74
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Loading status checks…
lisp -> coal
hash.coal builtin.coal math/arith.coal num.coal bounded.coal
Showing
14 changed files
with
1,294 additions
and
1,307 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,60 @@ | ||
(package coalton-library/builtin | ||
(import | ||
coalton-library/classes) | ||
(export | ||
unreachable | ||
undefined | ||
error ; re-export from classes | ||
not | ||
xor | ||
boolean-not | ||
boolean-or | ||
boolean-and | ||
boolean-xor)) | ||
|
||
(lisp-toplevel () | ||
(cl:eval-when (:compile-toplevel) | ||
(cl:defmacro unreachable (cl:&optional (datum "Unreachable") cl:&rest arguments) | ||
"Signal an error with CL format string DATUM and optional format arguments ARGUMENTS." | ||
`(lisp :a () | ||
(cl:error ,datum ,@arguments))))) | ||
|
||
(define (undefined _) | ||
"A function which can be used in place of any value, throwing an error at runtime." | ||
(error "Undefined")) | ||
|
||
(define not | ||
"Synonym for `boolean-not`." | ||
boolean-not) | ||
|
||
(define xor | ||
"Synonym for `boolean-xor`." | ||
boolean-xor) | ||
|
||
(declare boolean-not (Boolean -> Boolean)) | ||
(define (boolean-not x) | ||
"The logical negation of `x`. Is `x` false?" | ||
(match x | ||
((True) False) | ||
((False) True))) | ||
|
||
(declare boolean-or (Boolean -> Boolean -> Boolean)) | ||
(define (boolean-or x y) | ||
"Is either `x` or `y` true? Note that this is a *function* which means both `x` and `y` will be evaluated. Use the `or` macro for short-circuiting behavior." | ||
(match x | ||
((True) True) | ||
((False) y))) | ||
|
||
(declare boolean-and (Boolean -> Boolean -> Boolean)) | ||
(define (boolean-and x y) | ||
"Are both `x` and `y` true? Note that this is a *function* which means both `x` and `y` will be evaluated. Use the `and` macro for short-circuiting behavior." | ||
(match x | ||
((True) y) | ||
((False) False))) | ||
|
||
(declare boolean-xor (Boolean -> Boolean -> Boolean)) | ||
(define (boolean-xor x y) | ||
"Are `x` or `y` true, but not both?" | ||
(match x | ||
((True) (boolean-not y)) | ||
((False) y))) |
This file was deleted.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,340 @@ | ||
(package coalton-library/classes | ||
(import | ||
(coalton-library/types as types)) | ||
(export | ||
Signalable | ||
error | ||
Tuple | ||
Optional Some None | ||
Result Ok Err | ||
Eq == | ||
Ord LT EQ GT | ||
<=> > < >= <= | ||
max | ||
min | ||
Num + - * fromInt | ||
Semigroup <> | ||
Monoid mempty | ||
Functor map | ||
Applicative pure liftA2 | ||
Monad >>= | ||
>> | ||
MonadFail fail | ||
Alternative alt empty | ||
Foldable fold foldr mconcat | ||
Traversable traverse | ||
Bifunctor bimap map-fst map-snd | ||
sequence | ||
Into | ||
TryInto | ||
Iso | ||
Unwrappable unwrap-or-else with-default unwrap expect as-optional | ||
default defaulting-unwrap default?)) | ||
|
||
;;; | ||
;;; Signaling errors and warnings | ||
;;; | ||
|
||
;; | ||
;; Signalling errors on supported types | ||
;; | ||
(define-class (Signalable :a) | ||
"Signals errors or warnings by calling their respective lisp conditions." | ||
(error "Signal an error with a type-specific error string." (:a -> :b))) | ||
|
||
(define-instance (Signalable String) | ||
(define (error str) | ||
(lisp :a (str) | ||
(cl:error str)))) | ||
|
||
;; | ||
;; Base Types | ||
;; | ||
|
||
(define-struct (Tuple :a :b) | ||
"A heterogeneous collection of items." | ||
(first :a) | ||
(second :b)) | ||
|
||
(define-type (Optional :a) | ||
"Represents something that may not have a value." | ||
(Some :a) | ||
None) | ||
|
||
(define-type (Result :bad :good) | ||
"Represents something that may have failed." | ||
;; We write (Result :bad :good) instead of (Result :good :bad) | ||
;; because of the limitations of how we deal with higher-kinded | ||
;; types; we want to implement Functor on this. | ||
(Ok :good) | ||
(Err :bad)) | ||
|
||
;; | ||
;; Eq | ||
;; | ||
|
||
(define-class (Eq :a) | ||
"Types which have equality defined." | ||
(== (:a -> :a -> Boolean))) | ||
|
||
(define-instance (Eq types:LispType) | ||
(define (== a b) | ||
(lisp Boolean (a b) | ||
(cl:equalp a b)))) | ||
|
||
(define-class (Eq :a => Num :a) | ||
"Types which have numeric operations defined." | ||
(+ (:a -> :a -> :a)) | ||
(- (:a -> :a -> :a)) | ||
(* (:a -> :a -> :a)) | ||
(fromInt (Integer -> :a))) | ||
|
||
(define-instance (Eq Unit) | ||
(define (== _ _) True)) | ||
|
||
;; | ||
;; Ord | ||
;; | ||
|
||
(repr :enum) | ||
(define-type Ord | ||
"The result of an ordered comparison." | ||
LT | ||
EQ | ||
GT) | ||
|
||
(define-instance (Eq Ord) | ||
(define (== a b) | ||
(match (Tuple a b) | ||
((Tuple (LT) (LT)) True) | ||
((Tuple (EQ) (EQ)) True) | ||
((Tuple (GT) (GT)) True) | ||
(_ False)))) | ||
|
||
(define-instance (Ord Ord) | ||
(define (<=> a b) | ||
(match (Tuple a b) | ||
((Tuple (LT) (LT)) EQ) | ||
((Tuple (LT) (EQ)) LT) | ||
((Tuple (LT) (GT)) LT) | ||
((Tuple (EQ) (LT)) GT) | ||
((Tuple (EQ) (EQ)) EQ) | ||
((Tuple (EQ) (GT)) LT) | ||
((Tuple (GT) (LT)) GT) | ||
((Tuple (GT) (EQ)) GT) | ||
((Tuple (GT) (GT)) EQ)))) | ||
|
||
(define-class (Eq :a => Ord :a) | ||
"Types whose values can be ordered." | ||
(<=> (:a -> :a -> Ord))) | ||
|
||
(declare > (Ord :a => :a -> :a -> Boolean)) | ||
(define (> x y) | ||
"Is `x` greater than `y`?" | ||
(match (<=> x y) | ||
((GT) True) | ||
(_ False))) | ||
|
||
(declare < (Ord :a => :a -> :a -> Boolean)) | ||
(define (< x y) | ||
"Is `x` less than `y`?" | ||
(match (<=> x y) | ||
((LT) True) | ||
(_ False))) | ||
|
||
(declare >= (Ord :a => :a -> :a -> Boolean)) | ||
(define (>= x y) | ||
"Is `x` greater than or equal to `y`?" | ||
(match (<=> x y) | ||
((LT) False) | ||
(_ True))) | ||
|
||
(declare <= (Ord :a => :a -> :a -> Boolean)) | ||
(define (<= x y) | ||
"Is `x` less than or equal to `y`?" | ||
(match (<=> x y) | ||
((GT) False) | ||
(_ True))) | ||
|
||
(declare max (Ord :a => :a -> :a -> :a)) | ||
(define (max x y) | ||
"Returns the greater element of `x` and `y`." | ||
(if (> x y) | ||
x | ||
y)) | ||
|
||
(declare min (Ord :a => :a -> :a -> :a)) | ||
(define (min x y) | ||
"Returns the lesser element of `x` and `y`." | ||
(if (< x y) | ||
x | ||
y)) | ||
|
||
;; | ||
;; Haskell | ||
;; | ||
|
||
(define-class (Semigroup :a) | ||
"Types with an associative binary operation defined." | ||
(<> (:a -> :a -> :a))) | ||
|
||
(define-class (Semigroup :a => Monoid :a) | ||
"Types with an associative binary operation and identity defined." | ||
(mempty :a)) | ||
|
||
(define-class (Functor :f) | ||
"Types which can map an inner type where the mapping adheres to the identity and composition laws." | ||
(map ((:a -> :b) -> :f :a -> :f :b))) | ||
|
||
(define-class (Functor :f => Applicative :f) | ||
"Types which are a functor which can embed pure expressions and sequence operations." | ||
(pure (:a -> (:f :a))) | ||
(liftA2 ((:a -> :b -> :c) -> :f :a -> :f :b -> :f :c))) | ||
|
||
(define-class (Applicative :m => Monad :m) | ||
"Types which are monads as defined in Haskell. See https://wiki.haskell.org/Monad for more information." | ||
(>>= (:m :a -> (:a -> :m :b) -> :m :b))) | ||
|
||
(declare >> (Monad :m => (:m :a) -> (:m :b) -> (:m :b))) | ||
(define (>> a b) | ||
(>>= a (fn (_) b))) | ||
|
||
(define-class (Monad :m => MonadFail :m) | ||
(fail (String -> :m :a))) | ||
|
||
(define-class (Applicative :f => Alternative :f) | ||
"Types which are monoids on applicative functors." | ||
(alt (:f :a -> :f :a -> :f :a)) | ||
(empty (:f :a))) | ||
|
||
(define-class (Foldable :container) | ||
"Types which can be folded into a single element." | ||
(fold "A left tail-recursive fold." ((:accum -> :elt -> :accum) -> :accum -> :container :elt -> :accum)) | ||
(foldr "A right non-tail-recursive fold."((:elt -> :accum -> :accum) -> :accum -> :container :elt -> :accum))) | ||
|
||
(declare mconcat ((Foldable :f) (Monoid :a) => :f :a -> :a)) | ||
(define mconcat | ||
"Fold a container of monoids into a single element." | ||
(fold <> mempty)) | ||
|
||
(define-class (Traversable :t) | ||
(traverse (Applicative :f => (:a -> :f :b) -> :t :a -> :f (:t :b)))) | ||
|
||
(declare sequence ((Traversable :t) (Applicative :f) => :t (:f :b) -> :f (:t :b))) | ||
(define sequence (traverse (fn (x) x))) | ||
|
||
(define-class (Bifunctor :f) | ||
"Types which take two type arguments and are functors on both." | ||
(bimap ((:a -> :b) -> (:c -> :d) -> :f :a :c -> :f :b :d))) | ||
|
||
(declare map-fst (Bifunctor :f => (:a -> :b) -> :f :a :c -> :f :b :c)) | ||
(define (map-fst f b) | ||
"Map over the first argument of a `Bifunctor`." | ||
(bimap f (fn (x) x) b)) | ||
|
||
(declare map-snd (Bifunctor :f => (:b -> :c) -> :f :a :b -> :f :a :c)) | ||
(define (map-snd f b) | ||
"Map over the second argument of a `Bifunctor`." | ||
(bimap (fn (x) x) f b)) | ||
|
||
;; | ||
;; Conversions | ||
;; | ||
|
||
(define-class (Into :a :b) | ||
"`INTO` imples *every* element of `:a` can be represented by an element of `:b`. This conversion might not be bijective (i.e., there may be elements in `:b` that don't correspond to any in `:a`)." | ||
(into (:a -> :b))) | ||
|
||
(define-class ((Into :a :b) (Into :b :a) => Iso :a :b) | ||
"Opting into this marker typeclass imples that the instances for `(Into :a :b)` and `(Into :b :a)` form a bijection.") | ||
|
||
(define-instance (Into :a :a) | ||
(define (into x) x)) | ||
|
||
(define-class (TryInto :a :b :c (:a :b -> :c)) | ||
"`TRY-INTO` implies some elements of `:a` can be represented exactly by an element of `:b`, but sometimes not. If not, an error of type `:c` is returned." | ||
(tryInto (:a -> (Result :c :b)))) | ||
|
||
(define-instance (Iso :a :a)) | ||
|
||
;; | ||
;; Unwrappable for fallible unboxing | ||
;; | ||
|
||
(define-class (Unwrappable :container) | ||
"Containers which can be unwrapped to get access to their contents. | ||
`(unwrap-or-else succeed fail container)` should invoke the `succeed` continuation on the unwrapped contents of | ||
`container` when successful, or invoke the `fail` continuation with no arguments (i.e., with `Unit` as an argument) | ||
when unable to unwrap a value. | ||
The `succeed` continuation will often, but not always, be the identity function. `as-optional` passes `Some` to | ||
construct an `Optional`. | ||
Typical `fail` continuations are: | ||
- Return a default value, or | ||
- Signal an error." | ||
(unwrap-or-else ((:elt -> :result) | ||
-> (Unit -> :result) | ||
-> (:container :elt) | ||
-> :result))) | ||
|
||
(declare expect ((Unwrappable :container) => | ||
String | ||
-> (:container :element) | ||
-> :element)) | ||
(define (expect reason container) | ||
"Unwrap `container`, signaling an error with the description `reason` on failure." | ||
(unwrap-or-else (fn (elt) elt) | ||
(fn () (error reason)) | ||
container)) | ||
|
||
(declare unwrap ((Unwrappable :container) => | ||
(:container :element) | ||
-> :element)) | ||
(define (unwrap container) | ||
"Unwrap `container`, signaling an error on failure." | ||
(unwrap-or-else (fn (elt) elt) | ||
(fn () (error (lisp String (container) | ||
(cl:format cl:nil "Unexpected ~a in UNWRAP" | ||
container)))) | ||
container)) | ||
|
||
(declare with-default ((Unwrappable :container) => | ||
:element | ||
-> (:container :element) | ||
-> :element)) | ||
(define (with-default default container) | ||
"Unwrap `container`, returning `default` on failure." | ||
(unwrap-or-else (fn (elt) elt) | ||
(fn () default) | ||
container)) | ||
|
||
(declare as-optional ((Unwrappable :container) => (:container :elt) -> (Optional :elt))) | ||
(define (as-optional container) | ||
"Convert any Unwrappable container into an `Optional`, constructing Some on a successful unwrap and None on a failed unwrap." | ||
(unwrap-or-else Some | ||
(fn () None) | ||
container)) | ||
|
||
|
||
;; | ||
;; Default | ||
;; | ||
|
||
(define-class (Default :a) | ||
"Types which have default values." | ||
(default (Unit -> :a))) | ||
|
||
(declare defaulting-unwrap ((Unwrappable :container) (Default :element) => | ||
(:container :element) -> :element)) | ||
(define (defaulting-unwrap container) | ||
"Unwrap an `unwrappable`, returning `(default)` of the wrapped type on failure. " | ||
(unwrap-or-else (fn (elt) elt) | ||
(fn () (default)) | ||
container)) | ||
|
||
(declare default? ((Default :a) (Eq :a) => :a -> Boolean)) | ||
(define (default? x) | ||
"Is `x` the default item of its type?" | ||
(== x (default))) |
This file was deleted.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,84 @@ | ||
(package coalton-library/hash | ||
(import | ||
coalton-library/classes) | ||
(export | ||
Hash | ||
combine-hashes | ||
combine-hashes-order-independent)) | ||
|
||
#+sbcl | ||
(repr :native (cl:unsigned-byte 62)) | ||
|
||
#+allegro | ||
(repr :native (cl:unsigned-byte 0 32)) | ||
|
||
;; https://github.com/Clozure/ccl/blob/ff51228259d9dbc8a9cc7bbb08858ef4aa9fe8d0/level-0/l0-hash.lisp#L1885 | ||
#+ccl | ||
(repr :native (cl:and cl:fixnum cl:unsigned-byte)) | ||
|
||
#+(not (or sbcl allegro ccl)) | ||
#.(cl:error "hashing is not supported on ~A" (cl:lisp-implementation-type)) | ||
|
||
(define-type Hash | ||
"Implementation dependent hash code") | ||
|
||
(define-class (Eq :a => Hash :a) | ||
"Types which can be hashed for storage in hash tables. | ||
The hash function must satisfy the invariant that `(== left right)` implies `(== (hash left) (hash right))`." | ||
(hash (:a -> Hash))) | ||
|
||
(declare combine-hashes (Hash -> Hash -> Hash)) | ||
(define (combine-hashes lhs rhs) | ||
(lisp Hash (lhs rhs) | ||
;; SBCL has a hash combination function | ||
#+sbcl (sb-int:mix lhs rhs) | ||
|
||
;; | ||
;; Generic hash combination functions copied from: | ||
;; https://stackoverflow.com/questions/5889238/why-is-xor-the-default-way-to-combine-hashes/27952689#27952689 | ||
;; | ||
|
||
;; 32bit hash combination | ||
#+allegro (cl:logxor lhs (cl:+ rhs #x9e3779b9 (cl:ash lhs 6) (cl:ash lhs -2))) | ||
|
||
;; 64bit hash combination | ||
;; logand required on ccl to force the output to be a fixnum | ||
#+ccl (cl:logand (cl:logxor lhs (cl:+ rhs #x517cc1b727220a95 (cl:ash lhs 6) (cl:ash lhs -2))) cl:most-positive-fixnum))) | ||
|
||
(declare combine-hashes-order-independent (Hash -> Hash -> Hash)) | ||
(define (combine-hashes-order-independent lhs rhs) | ||
(lisp Hash (lhs rhs) | ||
(cl:logxor lhs rhs))) | ||
|
||
(define-instance (Eq Hash) | ||
(define (== a b) | ||
(lisp Boolean (a b) | ||
(cl:= a b)))) | ||
|
||
(define-instance (Ord Hash) | ||
(define (<=> a b) | ||
(if (== a b) | ||
EQ | ||
(if (lisp Boolean (a b) (to-boolean (cl:> a b))) | ||
GT | ||
LT)))) | ||
|
||
(define-instance (Semigroup Hash) | ||
(define (<> a b) | ||
(combine-hashes a b))) | ||
|
||
(define-instance (Monoid Hash) | ||
(define mempty | ||
(lisp Hash () | ||
0))) | ||
|
||
(define-instance (Default Hash) | ||
(define (default) | ||
(lisp Hash () | ||
0))) | ||
|
||
(define-instance (Hash Hash) | ||
(define (hash item) | ||
(lisp Hash (item) | ||
(cl:sxhash item)))) |
This file was deleted.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,192 @@ | ||
;;;; Number types and basic arithmetic. | ||
|
||
(package coalton-library/math/arith | ||
(import | ||
coalton-library/builtin | ||
coalton-library/classes | ||
coalton-library/functions | ||
coalton-library/utils) | ||
(export | ||
Reciprocable | ||
/ | ||
reciprocal | ||
Dividable | ||
general/ | ||
/ | ||
Transfinite | ||
infinity | ||
infinite? | ||
finite? | ||
negative-infinity | ||
nan | ||
nan? | ||
negate | ||
abs | ||
sign | ||
ash | ||
1+ | ||
1- | ||
positive? | ||
negative? | ||
nonpositive? | ||
nonnegative? | ||
zero? | ||
nonzero?)) | ||
|
||
;; | ||
;; Division | ||
;; | ||
|
||
(define-class (Num :a => Reciprocable :a) | ||
"Any number with a multiplicative inverse (reciprocal) where: | ||
1 = (* (reciprocal x) x) = (* x (reciprocal x)) | ||
(/ x y) = (* x (reciprocal y)) | ||
If no reciprocal exists for an element, produce a run-time error (e.g., zero). | ||
" | ||
(/ (:a -> :a -> :a)) | ||
(reciprocal (:a -> :a))) | ||
|
||
(define-class (Dividable :arg-type :res-type) | ||
"The representation of a type such that division within that type possibly results in another type. For instance, | ||
(Dividable Integer Fraction) | ||
establishes that division of two `Integer`s can result in a `Fraction`, whereas | ||
(Dividable Single-Float Single-Float) | ||
establishes that division of two `Single-Float`s can result in a `Single-Float`. | ||
Note that `Dividable` does *not* establish a default result type; you must constrain the result type yourself. | ||
The function `general/` is partial, and will error produce a run-time error if the divisor is zero. | ||
" | ||
;; This is a type that is more pragmatic and less mathematical in | ||
;; nature. It expresses a division relationship between one input | ||
;; type and one output type. | ||
(general/ (:arg-type -> :arg-type -> :res-type))) | ||
|
||
(define-instance (Reciprocable :a => Dividable :a :a) | ||
(define (general/ a b) (/ a b))) | ||
|
||
(define-class (Transfinite :a) | ||
"Numeric type with a value for (positive) infinity and/or NaN." | ||
(infinity :a) | ||
(infinite? (:a -> Boolean)) | ||
(nan :a) | ||
(nan? (:a -> Boolean))) | ||
|
||
(declare finite? ((Transfinite :a) => :a -> Boolean)) | ||
(define (finite? x) | ||
"Neither infinite or NaN." | ||
(or (infinite? x) (nan? x))) | ||
|
||
(declare negative-infinity ((Transfinite :a) (Num :a) => :a)) | ||
(define negative-infinity | ||
(negate infinity)) | ||
|
||
(define-instance (Transfinite Single-Float) | ||
(define infinity | ||
(lisp Single-Float () | ||
float-features:single-float-positive-infinity)) | ||
(define nan | ||
(lisp Single-Float () | ||
float-features:single-float-nan)) | ||
(define (nan? x) | ||
(Lisp Boolean (x) | ||
#+(not allegro) | ||
(float-features:float-NaN-p x) | ||
#+allegro | ||
(cl:and (float-features:float-NaN-p x) cl:t))) | ||
(define (infinite? x) | ||
(Lisp Boolean (x) | ||
(float-features:float-infinity-p x)))) | ||
|
||
(define-instance (Transfinite Double-Float) | ||
(define infinity | ||
(lisp Double-Float () | ||
float-features:double-float-positive-infinity)) | ||
(define nan | ||
(lisp Double-Float () | ||
float-features:double-float-nan)) | ||
(define (nan? x) | ||
(Lisp Boolean (x) | ||
#+(not allegro) | ||
(float-features:float-NaN-p x) | ||
#+allegro | ||
(cl:and (float-features:float-NaN-p x) cl:t))) | ||
(define (infinite? x) | ||
(Lisp Boolean (x) | ||
(float-features:float-infinity-p x)))) | ||
|
||
(declare negate (Num :a => :a -> :a)) | ||
(define (negate x) | ||
"The negation, or additive inverse, of `x`." | ||
(- 0 x)) | ||
|
||
(declare abs ((Ord :a) (Num :a) => :a -> :a)) | ||
(define (abs x) | ||
"Absolute value of `x`." | ||
(if (< x 0) | ||
(negate x) | ||
x)) | ||
|
||
(declare sign ((Ord :a) (Num :a) (Num :b) => :a -> :b)) | ||
(define (sign x) | ||
"The sign of `x`, where `(sign 0) = 1`." | ||
(if (< x 0) | ||
-1 | ||
1)) | ||
|
||
(declare ash (Integer -> Integer -> Integer)) | ||
(define (ash x n) | ||
"Compute the \"arithmetic shift\" of `x` by `n`. " | ||
(lisp Integer (x n) (cl:ash x n))) | ||
|
||
(declare 1+ ((Num :num) => :num -> :num)) | ||
(define (1+ num) | ||
"Increment `num`." | ||
(+ num 1)) | ||
|
||
(declare 1- ((Num :num) => :num -> :num)) | ||
(define (1- num) | ||
"Decrement `num`." | ||
(- num 1)) | ||
|
||
(declare positive? ((Num :a) (Ord :a) => :a -> Boolean)) | ||
(define (positive? x) | ||
"Is `x` positive?" | ||
(> x 0)) | ||
|
||
(declare negative? ((Num :a) (Ord :a) => :a -> Boolean)) | ||
(define (negative? x) | ||
"Is `x` negative?" | ||
(< x 0)) | ||
|
||
(declare nonpositive? ((Num :a) (Ord :a) => :a -> Boolean)) | ||
(define (nonpositive? x) | ||
"Is `x` not positive?" | ||
(<= x 0)) | ||
|
||
(declare nonnegative? ((Num :a) (Ord :a) => :a -> Boolean)) | ||
(define (nonnegative? x) | ||
"Is `x` not negative?" | ||
(>= x 0)) | ||
|
||
(declare zero? (Num :a => :a -> Boolean)) | ||
(define (zero? x) | ||
"Is `x` zero?" | ||
(== x 0)) | ||
|
||
(declare nonzero? (Num :a => :a -> Boolean)) | ||
(define (nonzero? x) | ||
"Is `x` not zero?" | ||
(/= x 0)) |
This file was deleted.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,62 @@ | ||
;;;; Numerical types with fixed bounds | ||
|
||
(package coalton-library/math/bounded | ||
(import | ||
coalton-library/builtin | ||
coalton-library/classes | ||
coalton-library/functions) | ||
(export | ||
Bounded | ||
minBound | ||
maxBound)) | ||
|
||
(define-class (Bounded :a) | ||
"Types which have a maximum and minumum bound." | ||
(minBound :a) | ||
(maxBound :a)) | ||
|
||
(define-instance (Bounded U8) | ||
(define minBound 0) ; 0 | ||
(define maxBound 255)) ; 2^8-1 | ||
|
||
(define-instance (Bounded I8) | ||
(define minBound -128) ; -1 * ceiling((2^8-1)/2) | ||
(define maxBound 127)) ; ceiling((2^8-1)/2) | ||
|
||
(define-instance (Bounded U16) | ||
(define minBound 0) ; 0 | ||
(define maxBound 65535)) ; 2^16-1 | ||
|
||
(define-instance (Bounded I16) | ||
(define minBound -32768) ; -1 * floor((2^16-1)/2) | ||
(define maxBound 32767)) ; ceiling((2^16-1)/2) | ||
|
||
(define-instance (Bounded U32) | ||
(define minBound 0) ; 0 | ||
(define maxBound 4294967295)) ; 2^32-1 | ||
|
||
(define-instance (Bounded I32) | ||
(define minBound -2147483648) ; -1 * ceiling((2^32-1)/2) | ||
(define maxBound 2147483647)) ; floor((2^32-1)/2) | ||
|
||
(define-instance (Bounded U64) | ||
(define minBound 0) ; 0 | ||
(define maxBound 18446744073709551615)) ; 2^64-1 | ||
|
||
(define-instance (Bounded I64) | ||
(define minBound -9223372036854775808) ; -1 * ceiling((2^64-1)/2) | ||
(define maxBound 9223372036854775807)) ; floor((2^32-1)/2) | ||
|
||
(define-instance (Bounded IFix) | ||
(define minBound | ||
(lisp IFix () | ||
cl:most-negative-fixnum)) | ||
(define maxBound | ||
(lisp IFix () | ||
cl:most-positive-fixnum))) | ||
|
||
(define-instance (Bounded UFix) | ||
(define minBound 0) | ||
(define maxBound | ||
(lisp UFix () | ||
cl:most-positive-fixnum))) |
This file was deleted.
Oops, something went wrong.
Large diffs are not rendered by default.
Oops, something went wrong.
This file was deleted.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters