aboutsummaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@hornquist.se>2018-11-13 00:02:05 +0100
committerHugo Hörnquist <hugo@hornquist.se>2018-11-13 00:02:05 +0100
commitbe7352768035ab0dbc3d257d1cad9d5e3bce64c2 (patch)
treed8ae7f3e46d35726c2c64271ff2977164d3184ab /examples
parentAdd propper (control monad state). (diff)
downloadscheme-monad-be7352768035ab0dbc3d257d1cad9d5e3bce64c2.tar.gz
scheme-monad-be7352768035ab0dbc3d257d1cad9d5e3bce64c2.tar.xz
Move state-minimal to examples.
Diffstat (limited to 'examples')
-rw-r--r--examples/state-minimal.scm54
1 files changed, 54 insertions, 0 deletions
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)))
+