Defining an algebraic data type in SBCL using defstruct, deftype, and trivia:match: data Maybe a = Nothing | Just a

maybe.lisp

(in-package :cl-user)

;; (ql:quickload '("alexandria" "trivia"))

;; Let's define maybe as an algebraic data type.
(defstruct (nothing (:constructor nothing ())))
(defstruct (just (:constructor just (value))) value)
(deftype maybe () '(or nothing just))

;; (>>=) :: Monad m => m a -> (a -> m b) -> m b
(defun bind (a b)
  (declare (optimize speed (safety 0) (debug 0)))
  (declare (type maybe a)
           (type function b))
  (trivia:match a
    ((nothing) (nothing))
    ((just value) (funcall b value))))

;;; trivia does a nice job here matching our maybe type defined as (or
;;; nothing just). Note that we are using trivia:match, not
;;; trivia:ematch. trivia:match would return NIL if none of the
;;; clauses matches. The disassembly of bind below shows, however,
;;; that we have code that will match exactly a nothing or a just
;;; value. -- Well, the heavy lifting probably comes from the
;;; underlying SBCL compiler.

;; (disassemble 'bind)
;; ; disassembly for BIND
;; ; Size: 37 bytes. Origin: #x537A4679                          ; BIND
;; ; 79:       8B5A01           MOV EBX, [RDX+1]
;; ; 7C:       817B4D56010000   CMP DWORD PTR [RBX+77], 342
;; ; 83:       740F             JEQ L0
;; ; 85:       488B5205         MOV RDX, [RDX+5]
;; ; 89:       B902000000       MOV ECX, 2
;; ; 8E:       FF7508           PUSH QWORD PTR [RBP+8]
;; ; 91:       FF60FD           JMP [RAX-3]
;; ; 94: L0:   31C9             XOR ECX, ECX
;; ; 96:       FF7508           PUSH QWORD PTR [RBP+8]
;; ; 99:       E9A4E0B7FC       JMP #x50322742                   ; #<FDEFN NOTHING>

;;; Probably (nothing) should be changed to return a constant +nothing+
;;; value.

(defun nothing= (a b)
  (and (nothing-p a) (nothing-p b)))

(alexandria:define-constant +nothing+ (nothing) :test #'nothing=)

;; And then we can also have:

(define-compiler-macro nothing () '+nothing+)

;;; This would give for bind (removing the JMP to #<FDEFN NOTHING>):

;; (disassemble 'bind)
;; ; disassembly for BIND
;; ; Size: 37 bytes. Origin: #x5379B609                          ; BIND
;; ; 09:       8B5A01           MOV EBX, [RDX+1]
;; ; 0C:       817B4D56010000   CMP DWORD PTR [RBX+77], 342
;; ; 13:       740F             JEQ L0
;; ; 15:       488B5205         MOV RDX, [RDX+5]
;; ; 19:       B902000000       MOV ECX, 2
;; ; 1E:       FF7508           PUSH QWORD PTR [RBP+8]
;; ; 21:       FF60FD           JMP [RAX-3]
;; ; 24: L0:   488B15B5FFFFFF   MOV RDX, [RIP-75]                ; #S(NOTHING)
;; ; 2B:       C9               LEAVE
;; ; 2C:       F8               CLC
;; ; 2D:       C3               RET

;; return :: Monad m => a -> m a
(defun result (a) (just a))

;; fromJust :: Maybe a -> a
(defun from-just (a)
  (declare (type maybe a))
  (trivia:ematch a
    ((just value) value)))

(assert (eql 126 (from-just (bind (result 123) (lambda (x) (result (+ x 3)))))))
(assert (nothing-p (bind (nothing) (lambda (x) (result (+ x 3))))))