diff --git a/lib/chibi/monad/environment.scm b/lib/chibi/monad/environment.scm
new file mode 100644
index 00000000..b46a5fe9
--- /dev/null
+++ b/lib/chibi/monad/environment.scm
@@ -0,0 +1,176 @@
+;; environment.scm - the environment (reader) monad for Scheme
+;; Copyright (c) 2013 Alex Shinn.  All rights reserved.
+;; BSD-style license: http://synthcode.com/license.txt
+
+;;> A Scheme take on the environment monad, focusing more on being
+;;> efficient and convenient than pure.  In addition, we use syntax to
+;;> hide the implementation, allowing the use of records, dynamic
+;;> parameters, or explicit value passing.
+;;>
+;;> The following obey the definition of a monad:
+;;>
+;;> sequence: sequence (>>) - Essentially a semi-colon, this joins two
+;;>  operations together.
+;;>
+;;> fn: bind (>>=) - Runs a normal function.  As a syntactic
+;;>  convenience, `fn' behaves like a lambda, but the parameters of the
+;;>  fn are bound as Scheme variables with the values of the
+;;>  corresponding environment variables.  Thus you fetch the values of
+;;>  foo and bar with:
+;;>
+;;>    (fn (foo bar) ...)
+;;>
+;;>  hiding the need for an explicit `ask'.  If you want to bind the
+;;>  values to some other name, you can use it like a `let':
+;;>
+;;>    (fn ((my-foo foo) (my-bar bar)) ...)
+;;>
+;;> return: return - Returns a pure (non-monadic) value.
+;;>
+;;> run: Start the monad.
+;;>
+;;> The following are specific to the environment monad:
+;;>
+;;> ask: Ask the current value of an environment variable.  This is not
+;;>  meant to be used directly - use the `fn' syntax to query bindings.
+;;>
+;;> local: Shadow the value one or more environment variables,
+;;>  analogous to `let'.
+;;>
+;;> In addition, support for optional mutation is provided:
+;;>
+;;> update!: (update! (var val) ...) will update the environment with
+;;>  the corresponding variable bindings.  In a sequence, successive
+;;>  operations will see the result of the update, unlike with `local'.
+;;>  This is allowed, but not required, to perform mutation.
+;;>
+;;> fn-fork: (fn-fork a b) runs `a' followed by `b', passing `b' the
+;;>  original state before `a' was run.
+
+(define-syntax define-environment-monad
+  (syntax-rules ()
+    ((define-environment-monad name clauses ...)
+     (dem name (ask %ask) (tell %tell) c f! f s r w u z () clauses ...))))
+
+(define-syntax dem
+  (syntax-rules (fields: sequence: bind: bind-fork:
+                 local: local!: run: return: ask: tell: copy:)
+    ((dem n ask tell c f! f s r w u z (fls ...)
+          (fields: (fl get put) . fl-r) . x)
+     (dem n ask tell c f! f s r w u z (fls ... (fl #f get put))
+          (fields: . fl-r) . x))
+    ((dem n ask tell c f! f s r w u z (fls ...) (fields:) . x)
+     (dem n ask tell c f! f s r w u z (fls ...) . x))
+    ((dem n ask tell c f! f s r w u z ())
+     (syntax-error "missing fields clause in define-state-monad"))
+    ((dem n ask tell c f! f s r w u z fls (bind: fn!) . x)
+     (dem n ask tell c fn! f s r w u z fls . x))
+    ((dem n ask tell c f! f s r w u z fls (bind-fork: fn) . x)
+     (dem n ask tell c f! fn s r w u z fls . x))
+    ((dem n ask tell c f! f s r w u z fls (sequence: seq) . x)
+     (dem n ask tell c f! f seq r w u z fls . x))
+    ((dem n ask tell c f! f s r w u z fls (run: run) . x)
+     (dem n ask tell c f! f s run w u z fls . x))
+    ((dem n ask tell c f! f s r w u z fls (return: return) . x)
+     (dem n ask tell c f! f s r w u return fls . x))
+    ((dem n ask tell c f! f s r w u z fls (local: local) . x)
+     (dem n ask tell c f! f s r local u z fls . x))
+    ((dem n ask tell c f! f s r w u z fls (local!: local!) . x)
+     (dem n ask tell c f! f s r w local! z fls . x))
+    ((dem n ask tell c f! f s r w u z fls (ask: a %a) . x)
+     (dem n (a %a) tell c f! f s r w u z fls . x))
+    ((dem n ask tell c f! f s r w u z fls (tell: t %t) . x)
+     (dem n ask (t %t) c f! f s r w u z fls . x))
+    ((dem n ask tell c f! f s r w u z fls (copy: copy) . x)
+     (dem n ask tell copy f! f s r w u z fls . x))
+    ((dem n ask tell c f! f s r w u z fls clause . x)
+     (syntax-error "unknown clause" 'clause))
+    ((dem n (ask %ask) (tell %tell) c f! f s r w u z ((field init get put) ...))
+     (begin
+       ;; Internals
+       (define-record-type n
+         (make-state field ... %props)
+         state?
+         (field get put) ...
+         (%props get-props set-props!))
+       (define (%ask st x)
+         (case x
+           ((field) (get st)) ...
+           (else (cond ((assq x (get-props st)) => cdr) (else #f)))))
+       (define-syntax ask
+         (syntax-rules (quote field ...)
+           ((ask st 'field) (get st)) ...
+           ((ask st x) (%ask st x))))
+       (define (%tell st x val)
+         (case x
+           ((field) (put st val)) ...
+           (else
+            (cond
+             ((assq x (get-props st))
+              => (lambda (cell) (set-cdr! cell val)))
+             (else
+              (set-props! st (cons (cons x val) (get-props st))))))))
+       (define-syntax tell
+         (syntax-rules (quote field ...)
+           ((tell st 'field val) (put st val)) ...
+           ((tell st x val) (%tell st x val))))
+       ;; External API
+       ;;
+       ;; copy
+       (define (c st)
+         (make-state
+          (get st) ...
+          (map (lambda (x) (cons (car x) (cdr x))) (get-props st))))
+       ;; bind - a function
+       (define-syntax f!
+         (syntax-rules ::: ()
+           ((f! ("step") (params :::) ((p param) . rest) . body)
+            (f! ("step") (params ::: (p param)) rest . body))
+           ((f! ("step") (params :::) ((param) . rest) . body)
+            (f! ("step") (params ::: (param param)) rest . body))
+           ((f! ("step") (params :::) (param . rest) . body)
+            (f! ("step") (params ::: (param param)) rest . body))
+           ((f! ("step") ((p param) :::) () . body)
+            (lambda (st)
+              (let ((p (ask st 'param)) :::)
+                ((begin . body) st))))
+           ((f! params . body)
+            (f! ("step") () params . body))))
+       ;; fork - run on a copy of the state
+       (define-syntax f
+         (syntax-rules ()
+           ((f a) a)
+           ((f a b) (lambda (st) (a (c st)) (b st)))
+           ((f a b . c) (f a (f b . c)))))
+       ;; sequence
+       (define-syntax s
+         (syntax-rules ()
+           ((s f) f)
+           ((s f . g) (lambda (st) ((s . g) (f st))))))
+       ;; update in place
+       (define-syntax u
+         (syntax-rules ::: ()
+           ((u (prop value) :::)
+            (lambda (st)
+              (tell st 'prop value) :::
+              st))))
+       ;; local binding - update temporarily
+       (define-syntax w
+         (syntax-rules ::: ()
+           ((w ("step") ((p tmp v) :::) () . b)
+            (lambda (st)
+              (let ((tmp (ask st 'p)) :::)
+                (tell st 'p v) :::
+                (let ((st ((begin . b) st)))
+                  (tell st 'p tmp) :::
+                  st))))
+           ((w ("step") (props :::) ((p v) . rest) . b)
+            (w ("step") (props ::: (p tmp v)) rest . b))
+           ((w ((prop value) :::) . body)
+            (w ("step") () ((prop value) :::) . body))))
+       ;; run
+       (define (r proc)
+         (proc (make-state init ... '())))
+       ;; return
+       (define (z x)
+         (lambda (st) x))))))
diff --git a/lib/chibi/monad/environment.sld b/lib/chibi/monad/environment.sld
new file mode 100644
index 00000000..d8674453
--- /dev/null
+++ b/lib/chibi/monad/environment.sld
@@ -0,0 +1,5 @@
+
+(define-library (chibi monad environment)
+  (export define-environment-monad)
+  (import (scheme base))
+  (include "environment.scm"))