Skip to content

Commit 39d5404

Browse files
jbouwmanjbouwman
committed
Add .coal versions of library files
1 parent 8f80992 commit 39d5404

16 files changed

+2398
-7
lines changed

‎coalton.asd

+7-7
Original file line numberDiff line numberDiff line change
@@ -43,14 +43,14 @@
4343
:serial t
4444
:components ((:file "set-float-traps")
4545
(:file "utils")
46-
(:file "types")
46+
(:coalton-file "types")
4747
(:file "primitive-types")
4848
(:file "classes")
4949
(:file "hash")
5050
(:file "builtin")
51-
(:file "functions")
52-
(:file "boolean")
53-
(:file "bits")
51+
(:coalton-file "functions")
52+
(:coalton-file "boolean")
53+
(:coalton-file "bits")
5454
(:module "math"
5555
:serial t
5656
:components ((:file "arith")
@@ -65,15 +65,15 @@
6565
(:file "dyadic")
6666
(:file "dual")))
6767
(:file "randomaccess")
68-
(:file "cell")
68+
(:coalton-file "cell")
6969
(:file "tuple")
7070
(:file "iterator")
7171
(:file "optional")
7272
(:file "result")
7373
(:file "lisparray")
7474
(:file "list")
75-
(:file "vector")
76-
(:file "char")
75+
(:coalton-file "vector")
76+
(:coalton-file "char")
7777
(:file "string")
7878
(:file "slice")
7979
(:file "hashtable")

‎library/bits.coal

+25
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
(package coalton-library/bits
2+
(shadow
3+
and
4+
or
5+
xor
6+
not)
7+
(import-from
8+
coalton-library/classes
9+
Num)
10+
(export
11+
Bits
12+
and
13+
or
14+
xor
15+
not
16+
shift))
17+
18+
(define-class (Num :int => Bits :int)
19+
"Operations on the bits of twos-complement integers"
20+
(and (:int -> :int -> :int))
21+
(or (:int -> :int -> :int))
22+
(xor (:int -> :int -> :int))
23+
(not (:int -> :int))
24+
(shift (Integer -> :int -> :int)))
25+

‎library/boolean.coal

+33
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
1+
(package coalton-library/boolean
2+
(import
3+
coalton-library/classes
4+
coalton-library/hash))
5+
6+
;;
7+
;; Boolean instances
8+
;;
9+
10+
(define-instance (Hash Boolean)
11+
(define (hash item)
12+
(lisp Hash (item)
13+
(cl:sxhash item))))
14+
15+
(define-instance (Eq Boolean)
16+
(define (== x y)
17+
(lisp Boolean (x y)
18+
(cl:eq x y))))
19+
20+
(define-instance (Ord Boolean)
21+
(define (<=> x y)
22+
(match x
23+
((True)
24+
(match y
25+
((True) EQ)
26+
((False) GT)))
27+
((False)
28+
(match y
29+
((True) LT)
30+
((False) EQ))))))
31+
32+
(define-instance (Default Boolean)
33+
(define (default) False))

‎library/builtin.coal

+60
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
(package coalton-library/builtin
2+
(import
3+
coalton-library/classes)
4+
(export
5+
unreachable
6+
undefined
7+
error ; re-export from classes
8+
not
9+
xor
10+
boolean-not
11+
boolean-or
12+
boolean-and
13+
boolean-xor))
14+
15+
(lisp-toplevel ()
16+
(cl:eval-when (:compile-toplevel)
17+
(cl:defmacro unreachable (cl:&optional (datum "Unreachable") cl:&rest arguments)
18+
"Signal an error with CL format string DATUM and optional format arguments ARGUMENTS."
19+
`(lisp :a ()
20+
(cl:error ,datum ,@arguments)))))
21+
22+
(define (undefined _)
23+
"A function which can be used in place of any value, throwing an error at runtime."
24+
(error "Undefined"))
25+
26+
(define not
27+
"Synonym for `boolean-not`."
28+
boolean-not)
29+
30+
(define xor
31+
"Synonym for `boolean-xor`."
32+
boolean-xor)
33+
34+
(declare boolean-not (Boolean -> Boolean))
35+
(define (boolean-not x)
36+
"The logical negation of `x`. Is `x` false?"
37+
(match x
38+
((True) False)
39+
((False) True)))
40+
41+
(declare boolean-or (Boolean -> Boolean -> Boolean))
42+
(define (boolean-or x y)
43+
"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."
44+
(match x
45+
((True) True)
46+
((False) y)))
47+
48+
(declare boolean-and (Boolean -> Boolean -> Boolean))
49+
(define (boolean-and x y)
50+
"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."
51+
(match x
52+
((True) y)
53+
((False) False)))
54+
55+
(declare boolean-xor (Boolean -> Boolean -> Boolean))
56+
(define (boolean-xor x y)
57+
"Are `x` or `y` true, but not both?"
58+
(match x
59+
((True) (boolean-not y))
60+
((False) y)))

‎library/cell.coal

+141
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,141 @@
1+
(package coalton-library/cell
2+
(import
3+
coalton-library/builtin
4+
coalton-library/classes)
5+
(export
6+
Cell
7+
new
8+
read
9+
swap!
10+
write!
11+
update!
12+
update-swap!
13+
push!
14+
pop!
15+
increment!
16+
decrement!))
17+
18+
(lisp-toplevel ()
19+
(cl:eval-when (:compile-toplevel :load-toplevel)
20+
21+
(cl:declaim (cl:inline make-cell-internal))
22+
23+
(cl:defstruct cell-internal
24+
(inner (cl:error "") :type cl:t))
25+
26+
(cl:defmethod cl:print-object ((self cell-internal) stream)
27+
(cl:format stream "#.(CELL ~A)" (cell-internal-inner self))
28+
self)
29+
30+
#+sbcl
31+
(cl:declaim (sb-ext:freeze-type cell-internal))))
32+
33+
(repr :native cell-internal)
34+
(define-type (Cell :a)
35+
"Internally mutable cell")
36+
37+
(declare new (:a -> Cell :a))
38+
(define (new data)
39+
"Create a new mutable cell"
40+
(lisp (Cell :a) (data)
41+
(make-cell-internal :inner data)))
42+
43+
(declare read (Cell :a -> :a))
44+
(define (read cel)
45+
"Read the value of a mutable cell"
46+
(lisp :a (cel)
47+
(cell-internal-inner cel)))
48+
49+
(declare swap! (Cell :a -> :a -> :a))
50+
(define (swap! cel data)
51+
"Replace the value of a mutable cell with a new value, then return the old value"
52+
(lisp :a (data cel)
53+
(cl:let* ((old (cell-internal-inner cel)))
54+
(cl:setf (cell-internal-inner cel) data)
55+
old)))
56+
57+
(declare write! (Cell :a -> :a -> :a))
58+
(define (write! cel data)
59+
"Set the value of a mutable cell, returning the new value"
60+
(lisp :a (data cel)
61+
(cl:setf (cell-internal-inner cel) data)))
62+
63+
(declare update! ((:a -> :a) -> Cell :a -> :a))
64+
(define (update! f cel)
65+
"Apply F to the contents of CEL, storing and returning the result"
66+
(write! cel (f (read cel))))
67+
68+
(declare update-swap! ((:a -> :a) -> Cell :a -> :a))
69+
(define (update-swap! f cel)
70+
"Apply F to the contents of CEL, swapping the result for the old value"
71+
(swap! cel (f (read cel))))
72+
73+
;;; operators on cells of lists
74+
(declare push! (Cell (List :elt) -> :elt -> List :elt))
75+
(define (push! cel new-elt)
76+
"Push NEW-ELT onto the start of the list in CEL."
77+
(update! (Cons new-elt) cel))
78+
79+
(declare pop! (Cell (List :elt) -> Optional :elt))
80+
(define (pop! cel)
81+
"Remove and return the first element of the list in CEL."
82+
(match (read cel)
83+
((Cons fst rst)
84+
(write! cel rst)
85+
(Some fst))
86+
((Nil) None)))
87+
88+
;;; operators on cells of numbers
89+
(declare increment! (Num :counter => Cell :counter -> :counter))
90+
(define (increment! cel)
91+
"Add one to the contents of CEL, storing and returning the new value"
92+
(update! (+ 1) cel))
93+
94+
(declare decrement! (Num :counter => (Cell :counter) -> :counter))
95+
(define (decrement! cel)
96+
"Subtract one from the contents of CEL, storing and returning the new value"
97+
(update! (+ -1) cel))
98+
99+
;; i am very skeptical of these instances
100+
(define-instance (Eq :a => Eq (Cell :a))
101+
(define (== c1 c2)
102+
(== (read c1) (read c2))))
103+
104+
(define-instance (Ord :a => Ord (Cell :a))
105+
(define (<=> c1 c2)
106+
(match (<=> (read c1) (read c2))
107+
((LT) LT)
108+
((GT) GT)
109+
((EQ) EQ))))
110+
111+
(define-instance (Num :a => Num (Cell :a))
112+
(define (+ c1 c2)
113+
(new (+ (read c1) (read c2))))
114+
(define (- c1 c2)
115+
(new (- (read c1) (read c2))))
116+
(define (* c1 c2)
117+
(new (* (read c1) (read c2))))
118+
(define (fromInt i)
119+
(new (fromInt i))))
120+
121+
(define-instance (Semigroup :a => Semigroup (Cell :a))
122+
(define (<> a b)
123+
(new (<> (read a) (read b)))))
124+
125+
(define-instance (Functor Cell)
126+
(define (map f c)
127+
(new (f (read c)))))
128+
129+
(define-instance (Applicative Cell)
130+
(define pure new)
131+
(define (liftA2 f c1 c2)
132+
(new (f (read c1) (read c2)))))
133+
134+
(define-instance (Into :a (Cell :a))
135+
(define into new))
136+
137+
(define-instance (Into (Cell :a) :a)
138+
(define into read))
139+
140+
(define-instance (Default :a => Default (Cell :a))
141+
(define (default) (new (default))))

0 commit comments

Comments
 (0)