From be7352768035ab0dbc3d257d1cad9d5e3bce64c2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Tue, 13 Nov 2018 00:02:05 +0100
Subject: Move state-minimal to examples.

---
 examples/state-minimal.scm | 54 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 54 insertions(+)
 create mode 100644 examples/state-minimal.scm

(limited to 'examples/state-minimal.scm')

diff --git a/examples/state-minimal.scm b/examples/state-minimal.scm
new file mode 100644
index 0000000..8a88ac6
--- /dev/null
+++ b/examples/state-minimal.scm
@@ -0,0 +1,54 @@
+(use-modules (ice-9 curried-definitions)
+             (ice-9 match))
+
+;;; This is a minimal implementation of the state monad.
+;;; It is incompatible with the rest of my monad system,
+;;; since everything either has type <pair> or <procedure>.
+;;; But it should work as a nice base for the actual
+;;; implementation.
+
+;;; This implementation works, as far as I can tell, exactly
+;;; like the Haskell version (of MonadState). But obviously
+;;; without all the nice syntax.
+
+;;; Anything that takes an st-list and returns an st-list is
+;;; considered a State value.
+;;; An st-list is a list where the car is the last returned
+;;; value, and the cadr is the "state".
+
+;; newtype State = st-list -> st-list
+
+;; State
+(define ((get) st-list)
+  "Sets the return value to the state value"
+  (match st-list
+    ((v st)
+     (list st st))))
+
+;; v -> State
+(define ((put v) st-list)
+  "Sets the state value to v, sets the return value to ()"
+  (list '() v))
+
+;; State -> (v -> State) -> State
+(define ((bind st-proc proc) st-list)
+  (let ((new-st-list (st-proc st-list)))
+    (match new-st-list
+      ((v _)
+       ((proc v) new-st-list)))))
+
+;; State -> State -> State
+(define ((then st-proc-1 st-proc-b) st-list-a)
+  (let ((st-list-b (st-proc-1 st-list-a)))
+    (st-proc-b st-list-b)))
+
+;; v -> State
+(define ((return v) st-list)
+  "Sets the return value to v"
+  (cons v (cdr st-list)))
+
+;; State -> v -> (r v)
+(define (run-state st-proc init)
+  "Exec state with init as starting state value"
+  (st-proc (list init init)))
+
-- 
cgit v1.2.3