mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 05:48:07 -05:00
monads: Allow resolution of a monad's bind/return at expansion time.
* guix/monads.scm (<monad>): Turn in a raw SRFI-9 record type. (define-monad): New macro. (with-monad): Add a case for when MONAD is a macro. (identity-return, identity-bind, store-return, store-bind): Inline. (%identity-monad, %store-monad): Use 'define-monad'. * tests/monads.scm ("monad?"): New test.
This commit is contained in:
parent
d9f0a23704
commit
aeb7ec5c9a
2 changed files with 59 additions and 15 deletions
|
@ -17,14 +17,16 @@
|
|||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (guix monads)
|
||||
#:use-module (guix records)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module (guix packages)
|
||||
#:use-module ((system syntax)
|
||||
#:select (syntax-local-binding))
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (;; Monads.
|
||||
monad
|
||||
define-monad
|
||||
monad?
|
||||
monad-bind
|
||||
monad-return
|
||||
|
@ -72,11 +74,40 @@ (define-module (guix monads)
|
|||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define-record-type* <monad> monad make-monad
|
||||
;; Record type for monads manipulated at run time.
|
||||
(define-record-type <monad>
|
||||
(make-monad bind return)
|
||||
monad?
|
||||
(bind monad-bind)
|
||||
(return monad-return)) ; TODO: Add 'plus' and 'zero'
|
||||
|
||||
(define-syntax define-monad
|
||||
(lambda (s)
|
||||
"Define the monad under NAME, with the given bind and return methods."
|
||||
(define prefix (string->symbol "% "))
|
||||
(define (make-rtd-name name)
|
||||
(datum->syntax name
|
||||
(symbol-append prefix (syntax->datum name) '-rtd)))
|
||||
|
||||
(syntax-case s (bind return)
|
||||
((_ name (bind b) (return r))
|
||||
(with-syntax ((rtd (make-rtd-name #'name)))
|
||||
#`(begin
|
||||
(define rtd
|
||||
;; The record type, for use at run time.
|
||||
(make-monad b r))
|
||||
|
||||
(define-syntax name
|
||||
;; An "inlined record", for use at expansion time. The goal is
|
||||
;; to allow 'bind' and 'return' to be resolved at expansion
|
||||
;; time, in the common case where the monad is accessed
|
||||
;; directly as NAME.
|
||||
(lambda (s)
|
||||
(syntax-case s (%bind %return)
|
||||
((_ %bind) #'b)
|
||||
((_ %return) #'r)
|
||||
(_ #'rtd))))))))))
|
||||
|
||||
(define-syntax-parameter >>=
|
||||
;; The name 'bind' is already taken, so we choose this (obscure) symbol.
|
||||
(lambda (s)
|
||||
|
@ -91,6 +122,15 @@ (define-syntax with-monad
|
|||
"Evaluate BODY in the context of MONAD, and return its result."
|
||||
(syntax-case s ()
|
||||
((_ monad body ...)
|
||||
(eq? 'macro (syntax-local-binding #'monad))
|
||||
;; MONAD is a syntax transformer, so we can obtain the bind and return
|
||||
;; methods by directly querying it.
|
||||
#'(syntax-parameterize ((>>= (identifier-syntax (monad %bind)))
|
||||
(return (identifier-syntax (monad %return))))
|
||||
body ...))
|
||||
((_ monad body ...)
|
||||
;; MONAD refers to the <monad> record that represents the monad at run
|
||||
;; time, so use the slow method.
|
||||
#'(syntax-parameterize ((>>= (identifier-syntax
|
||||
(monad-bind monad)))
|
||||
(return (identifier-syntax
|
||||
|
@ -209,16 +249,15 @@ (define-syntax listm
|
|||
;;; Identity monad.
|
||||
;;;
|
||||
|
||||
(define (identity-return value)
|
||||
(define-inlinable (identity-return value)
|
||||
value)
|
||||
|
||||
(define (identity-bind mvalue mproc)
|
||||
(define-inlinable (identity-bind mvalue mproc)
|
||||
(mproc mvalue))
|
||||
|
||||
(define %identity-monad
|
||||
(monad
|
||||
(define-monad %identity-monad
|
||||
(bind identity-bind)
|
||||
(return identity-return)))
|
||||
(return identity-return))
|
||||
|
||||
|
||||
;;;
|
||||
|
@ -226,23 +265,23 @@ (define %identity-monad
|
|||
;;;
|
||||
|
||||
;; return:: a -> StoreM a
|
||||
(define (store-return value)
|
||||
(define-inlinable (store-return value)
|
||||
"Return VALUE from a monadic function."
|
||||
;; The monadic value is just this.
|
||||
(lambda (store)
|
||||
value))
|
||||
|
||||
;; >>=:: StoreM a -> (a -> StoreM b) -> StoreM b
|
||||
(define (store-bind mvalue mproc)
|
||||
(define-inlinable (store-bind mvalue mproc)
|
||||
"Bind MVALUE in MPROC."
|
||||
(lambda (store)
|
||||
(let* ((value (mvalue store))
|
||||
(mresult (mproc value)))
|
||||
(mresult store))))
|
||||
|
||||
(define %store-monad
|
||||
(monad
|
||||
(return store-return)
|
||||
(bind store-bind)))
|
||||
(define-monad %store-monad
|
||||
(bind store-bind)
|
||||
(return store-return))
|
||||
|
||||
|
||||
(define (store-lift proc)
|
||||
|
|
|
@ -48,6 +48,11 @@ (define %monad-run
|
|||
|
||||
(test-begin "monads")
|
||||
|
||||
(test-assert "monad?"
|
||||
(and (every monad? %monads)
|
||||
(every (compose procedure? monad-bind) %monads)
|
||||
(every (compose procedure? monad-return) %monads)))
|
||||
|
||||
;; The 3 "monad laws": <http://www.haskell.org/haskellwiki/Monad_laws>.
|
||||
|
||||
(test-assert "left identity"
|
||||
|
|
Loading…
Reference in a new issue