Convert standard library files

Author: Jesse Bouwman

coalton.asd

@@ -38,7 +38,7 @@
   :serial t
   :components ((:file "set-float-traps")
                (:file "utils")
-               (:file "types")
+               (:coalton-file "types")
                (:file "primitive-types")
                (:file "classes")
                (:file "hash")
@@ -59,17 +59,17 @@
                              (:file "elementary")
                              (:file "dyadic")
                              (:file "dual")))
-               (:file "randomaccess")
-               (:file "cell")
+               (:coalton-file "randomaccess")
+               (:coalton-file "cell")
                (:file "tuple")
                (:file "iterator")
-               (:file "optional")
+               (:coalton-file "optional")
                (:file "result")
                (:file "lisparray")
-               (:file "list")
+               (:coalton-file "list")
                (:file "vector")
-               (:file "char")
-               (:file "string")
+               (:coalton-file "char")
+               (:coalton-file "string")
                (:file "slice")
                (:file "hashtable")
                (:file "queue")
@@ -78,7 +78,7 @@
                (:file "ord-map")
                (:file "monad/free")
                (:file "seq")
-               (:file "system")
+               (:coalton-file "system")
                (:file "file")
                (:file "prelude")))
 

library/cell.coal

@@ -0,0 +1,139 @@
+(package coalton-library/cell
+  (import
+   coalton-library/builtin
+   coalton-library/classes)
+  (export
+   Cell
+   new
+   read
+   swap!
+   write!
+   update!
+   update-swap!
+   push!
+   pop!
+   increment!
+   decrement!))
+
+(lisp-toplevel
+ (cl:declaim (cl:inline make-cell-internal))
+
+ (cl:defstruct cell-internal
+   (inner (cl:error "") :type cl:t))
+
+ (cl:defmethod cl:print-object ((self cell-internal) stream)
+   (cl:format stream "#.(CELL ~A)" (cell-internal-inner self))
+   self)
+
+ #+sbcl
+ (cl:declaim (sb-ext:freeze-type cell-internal)))
+
+(repr :native cell-internal)
+(define-type (Cell :a)
+  "Internally mutable cell")
+
+(declare new (:a -> Cell :a))
+(define (new data)
+  "Create a new mutable cell"
+  (lisp (Cell :a) (data)
+    (make-cell-internal :inner data)))
+
+(declare read (Cell :a -> :a))
+(define (read cel)
+  "Read the value of a mutable cell"
+  (lisp :a (cel)
+    (cell-internal-inner cel)))
+
+(declare swap! (Cell :a -> :a -> :a))
+(define (swap! cel data)
+  "Replace the value of a mutable cell with a new value, then return the old value"
+  (lisp :a (data cel)
+    (cl:let* ((old (cell-internal-inner cel)))
+      (cl:setf (cell-internal-inner cel) data)
+      old)))
+
+(declare write! (Cell :a -> :a -> :a))
+(define (write! cel data)
+  "Set the value of a mutable cell, returning the new value"
+  (lisp :a (data cel)
+    (cl:setf (cell-internal-inner cel) data)))
+
+(declare update! ((:a -> :a) -> Cell :a -> :a))
+(define (update! f cel)
+  "Apply F to the contents of CEL, storing and returning the result"
+  (write! cel (f (read cel))))
+
+(declare update-swap! ((:a -> :a) -> Cell :a -> :a))
+(define (update-swap! f cel)
+  "Apply F to the contents of CEL, swapping the result for the old value"
+  (swap! cel (f (read cel))))
+
+;;; operators on cells of lists
+(declare push! (Cell (List :elt) -> :elt -> List :elt))
+(define (push! cel new-elt)
+  "Push NEW-ELT onto the start of the list in CEL."
+  (update! (Cons new-elt) cel))
+
+(declare pop! (Cell (List :elt) -> Optional :elt))
+(define (pop! cel)
+  "Remove and return the first element of the list in CEL."
+  (match (read cel)
+    ((Cons fst rst)
+     (write! cel rst)
+     (Some fst))
+    ((Nil) None)))
+
+;;; operators on cells of numbers
+(declare increment! (Num :counter => Cell :counter -> :counter))
+(define (increment! cel)
+  "Add one to the contents of CEL, storing and returning the new value"
+  (update! (+ 1) cel))
+
+(declare decrement! (Num :counter => (Cell :counter) -> :counter))
+(define (decrement! cel)
+  "Subtract one from the contents of CEL, storing and returning the new value"
+  (update! (+ -1) cel))
+
+;; i am very skeptical of these instances
+(define-instance (Eq :a => Eq (Cell :a))
+  (define (== c1 c2)
+    (== (read c1) (read c2))))
+
+(define-instance (Ord :a => Ord (Cell :a))
+  (define (<=> c1 c2)
+    (match (<=> (read c1) (read c2))
+      ((LT) LT)
+      ((GT) GT)
+      ((EQ) EQ))))
+
+(define-instance (Num :a => Num (Cell :a))
+  (define (+ c1 c2)
+    (new (+ (read c1) (read c2))))
+  (define (- c1 c2)
+    (new (- (read c1) (read c2))))
+  (define (* c1 c2)
+    (new (* (read c1) (read c2))))
+  (define (fromInt i)
+    (new (fromInt i))))
+
+(define-instance (Semigroup :a => Semigroup (Cell :a))
+  (define (<> a b)
+    (new (<> (read a) (read b)))))
+
+(define-instance (Functor Cell)
+  (define (map f c)
+    (new (f (read c)))))
+
+(define-instance (Applicative Cell)
+  (define pure new)
+  (define (liftA2 f c1 c2)
+    (new (f (read c1) (read c2)))))
+
+(define-instance (Into :a (Cell :a))
+  (define into new))
+
+(define-instance (Into (Cell :a) :a)
+  (define into read))
+
+(define-instance (Default :a => Default (Cell :a))
+  (define (default) (new (default))))