aboutsummaryrefslogtreecommitdiff
path: root/data
diff options
context:
space:
mode:
Diffstat (limited to 'data')
-rw-r--r--data/either.scm30
-rw-r--r--data/monoid.scm26
-rw-r--r--data/optional.scm53
-rw-r--r--data/stack.scm24
-rw-r--r--data/writer.scm39
5 files changed, 0 insertions, 172 deletions
diff --git a/data/either.scm b/data/either.scm
deleted file mode 100644
index c597a60..0000000
--- a/data/either.scm
+++ /dev/null
@@ -1,30 +0,0 @@
-;;; TODO UNFINISHED
-
-(define-module (data either)
- #:use-module (oop goops)
- #:use-module (ice-9 match))
-
-(define-class <either> ()
- (slot #:init-keyword #:slot)
- (dir #:init-keyword #:dir #:init-value 'left))
-
-(define (left val)
- "Error values"
- (make <either> #:slot val #:dir 'left))
-
-(define (right val)
- "Good values"
- (make <either> #:slot val #:dir 'right))
-
-(define-method (write (this <either>) port)
- (format port "[~a ~s]"
- (slot-ref this 'dir)
- (slot-ref this 'slot)))
-
-(define-method (>>= (this <either>)
- (proc <procedure>))
- (case (slot-ref this 'dir)
- ((left) this)
- ((right) (match this (($ <either> slot) (proc slot))))))
-
-(define return-either right)
diff --git a/data/monoid.scm b/data/monoid.scm
deleted file mode 100644
index d33557e..0000000
--- a/data/monoid.scm
+++ /dev/null
@@ -1,26 +0,0 @@
-;;; ???
-(define-module (data monoid)
- #:use-module (oop goops)
- #:use-module (srfi srfi-1)
- #:export (null mappend <>))
-
-(define-generic null)
-(define-generic mappend)
-
-(define (<> . args)
- (fold mappend (null (car args)) (reverse args)))
-
-;;; Lists
-
-(define-method (mappend (a <pair>) (b <pair>))
- (append a b))
-(define-method (mappend (a <pair>) (b <null>)) a)
-(define-method (mappend (a <null>) (b <pair>)) b)
-(define-method (mappend (a <null>) (b <null>)) '())
-(define-method (null (a <pair>)) '())
-(define-method (null (a <null>)) '())
-
-;;; Strings
-(define-method (mappend (a <string>) (b <string>))
- (string-append a b))
-(define-method (null (a <string>)) "")
diff --git a/data/optional.scm b/data/optional.scm
deleted file mode 100644
index 61543d2..0000000
--- a/data/optional.scm
+++ /dev/null
@@ -1,53 +0,0 @@
-(define-module (data optional)
- #:use-module (oop goops)
- #:use-module (ice-9 match)
- #:use-module (control monad)
- #:use-module (ice-9 curried-definitions)
- #:export (from-just wrap-maybe
- nothing just
- nothing? just?)
- #:re-export (>>= >> return))
-
-(define-class <optional> ()
- (slot #:init-value #f
- #:init-keyword #:slot)
- (just #:init-value #t
- #:init-keyword #:just))
-
-(define (nothing) (make <optional> #:just #f))
-
-(define (just obj) (make <optional>
- #:just #t
- #:slot obj))
-
-(define (nothing? this)
- (not (slot-ref this 'just)))
-
-(define (just? this)
- (not (nothing? this)))
-
-(define (from-just default maybe-val)
- "Returns default if maybe-val is nothing, otherwise
-the value embedded in maybe-val"
- (if (just? maybe-val)
- (slot-ref maybe-val 'slot)
- default))
-
-(define ((wrap-maybe proc) . values)
- "Wraps a function in an optional monad, where #f returns are translated to nothing."
- (let ((v (apply proc values)))
- (if v (just v) (nothing))))
-
-(define-method (write (this <optional>) port)
- (if (just? this)
- (format port "[Just ~s]" (slot-ref this 'slot))
- (format port "[Nothing]")))
-
-(define-method (>>= (this <optional>)
- (proc <procedure>))
- (cond ((nothing? this) (nothing))
- ((just? this)
- (match this
- (($ <optional> slot) (proc slot))))))
-
-(define-method (return (a <optional>)) just)
diff --git a/data/stack.scm b/data/stack.scm
deleted file mode 100644
index d470394..0000000
--- a/data/stack.scm
+++ /dev/null
@@ -1,24 +0,0 @@
-(define-module (data stack)
- #:export (pop peek push)
- #:use-module (control monad)
- #:use-module (control monad state))
-
-;;; Simple stateful stack module for showing the state monad
-;;; in action. These functions assume that they are in a
-;;; (state list) monad. But dynamic types!
-
-;;; TODO test these for empty stack
-
-(define (pop)
- (do st <- (get)
- let top = (car st)
- (put (cdr st))
- (return-state top)))
-
-(define (peek)
- (do st <- (get)
- (return-state (car st))))
-
-(define (push v)
- (do st <- (get)
- (put (cons v st))))
diff --git a/data/writer.scm b/data/writer.scm
deleted file mode 100644
index bf391c2..0000000
--- a/data/writer.scm
+++ /dev/null
@@ -1,39 +0,0 @@
-(define-module (data writer)
- #:use-module (oop goops)
- #:use-module (ice-9 match)
- #:use-module (data monoid)
- #:use-module (control monad)
- #:export (writer return-writer))
-
-(read-enable 'curly-infix)
-
-(define-class <writer> ()
- (value #:init-keyword #:value)
- (monoid #:init-keyword #:monoid))
-
-(define (writer value context)
- (make <writer>
- #:value value
- #:monoid context))
-
-(define-method (>>= (this <writer>)
- (proc <procedure>))
- (match this (($ <writer> value monoid)
- (match (proc value)
- (($ <writer> nval ncontext)
- (writer nval { monoid <> ncontext }))))))
-
-(define-method (>> (a <writer>)
- (b <writer>))
- (match a (($ <writer> _ monoid-a)
- (match b (($ <writer> val monoid-b)
- (writer val (<> monoid-a monoid-b))
- )))))
-
-;;; TODO replace this
-(define (return-writer val)
- (writer val ""))
-
-(define-method (write (this <writer>) port)
- (match this (($ <writer> value monoid)
- (format port "[Writer ~s, ~s]" value monoid))))