<commit_before>#lang racket/base
(provide
  (struct-out monad)
  pure
  bind
  identity-monad
  with-monad
  let1/monad
  let/monad
  let/with-monad
  begin/monad
  begin/with-monad
  )

(require
  (for-syntax racket/base)
  "match.rkt"
  "record.rkt"
  racket/match
  )

(record monad pure bind)

(record identity x)

(define identity-monad
  (monad
    identity
    (lambda/destruct ((identity value) next) (next value))))

(define current-monad (make-parameter identity-monad))

(define (pure value) ((monad-pure (current-monad)) value))
(define (bind prev next) ((monad-bind (current-monad)) prev next))

(define-syntax with-monad
  (syntax-rules ()
    ((_ monad body ...)
     (parameterize ((current-monad monad)) body ...))))

(define-syntax let1/monad
  (syntax-rules (<- =)
    ((_ (pattern <- value) body ...)
     (bind value (lambda/destruct (pattern) body ...)))
    ((_ (pattern = value) body ...)
     (match-let ((pattern value)) body ...))))

(define-syntax (let/monad stx)
  (syntax-case stx ()
    ((_ (binding ...) body ...)
     (for/fold ((body #'(begin body ...)))
               ((binding (reverse (syntax->list #'(binding ...)))))
      #`(let1/monad #,binding #,body)))))

(define-syntax let/with-monad
  (syntax-rules ()
    ((_ monad bindings body ...)
     (with-monad monad
      (let/monad bindings body ...)))))

(define-syntax begin/monad
  (syntax-rules ()
    ((_ pattern bind-sym value body ...)
     (let1/monad (pattern bind-sym value) (begin/monad body ...)))
    ((_ body)
     body)))

(define-syntax begin/with-monad
  (syntax-rules ()
    ((_ monad body ...)
     (with-monad monad
      (begin/monad body ...)))))<commit_msg>Add an example for begin/with-monad<commit_after>#lang racket/base
(provide
  (struct-out monad)
  pure
  bind
  identity-monad
  with-monad
  let1/monad
  let/monad
  let/with-monad
  begin/monad
  begin/with-monad
  )

(require
  (for-syntax racket/base)
  "match.rkt"
  "record.rkt"
  racket/match
  )

(module+ test
  (require rackunit))

(record monad pure bind)

(record identity x)

(define identity-monad
  (monad
    identity
    (lambda/destruct ((identity value) next) (next value))))

(define current-monad (make-parameter identity-monad))

(define (pure value) ((monad-pure (current-monad)) value))
(define (bind prev next) ((monad-bind (current-monad)) prev next))

(define-syntax with-monad
  (syntax-rules ()
    ((_ monad body ...)
     (parameterize ((current-monad monad)) body ...))))

(define-syntax let1/monad
  (syntax-rules (<- =)
    ((_ (pattern <- value) body ...)
     (bind value (lambda/destruct (pattern) body ...)))
    ((_ (pattern = value) body ...)
     (match-let ((pattern value)) body ...))))

(define-syntax (let/monad stx)
  (syntax-case stx ()
    ((_ (binding ...) body ...)
     (for/fold ((body #'(begin body ...)))
               ((binding (reverse (syntax->list #'(binding ...)))))
      #`(let1/monad #,binding #,body)))))

(define-syntax let/with-monad
  (syntax-rules ()
    ((_ monad bindings body ...)
     (with-monad monad
      (let/monad bindings body ...)))))

(define-syntax begin/monad
  (syntax-rules ()
    ((_ pattern bind-sym value body ...)
     (let1/monad (pattern bind-sym value) (begin/monad body ...)))
    ((_ body)
     body)))

(define-syntax begin/with-monad
  (syntax-rules ()
    ((_ monad body ...)
     (with-monad monad
      (begin/monad body ...)))))

(module+ test
  (check-equal?
    7
    (begin/with-monad identity-monad
      x <- (pure 4)
      y = 3
      (+ x y))))
{'fraction_non_alphanumeric': 0.18256672345258376, 'fraction_numerical': 0.0031232254400908573, 'mean_word_length': 2.6621621621621623, 'pattern_counts': {'":': 0, '<': 8, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7262034', 'n_tokens_mistral': 1295, 'n_tokens_neox': 1224, 'n_words': 291}