extended-define.shen

(datatype option-type
  ______________
  @nothing : (option A);

  X : Type;
  ______________
  (@just X) : (option Type);

  _____________
  (just? X) : verified >> X : (option A);)

(declare @just [A --> [option A]])

(define @just
  { A --> (option A) }
  X -> (let Option (absvector 2)
         (do (address-> Option 0 option)
             (address-> Option 1 X))))

(declare option-value [[option A] --> A])

(define option-value
  { (option A) --> A }
  X -> (<-address X 1))

(declare just? [A --> boolean])

(define just?
  { A --> boolean }
  J -> (trap-error (and (absvector? J) (= option (<-address J 0))) (/. E false)))

(define test-pattern
  { text --> boolean }
  T -> false where (= 0 (text-length T))
  T -> true)

(define adjust-pattern
  [Nothing Sep Expr] -> [@nothing Sep Expr] where (= @nothing Nothing)

  [JustV Sep Expr] ->
          (let V (head (tail JustV))
               Tmp (gensym (intern "Temp"))
            [Tmp Sep [let V [option-value Tmp] Expr] where [just? Tmp]])
          where (trap-error (= (intern "@just") (head JustV)) (/. E false))

  [Pat Sep Expr] -> [Pat Sep Expr])

(define adjust-patterns
  [] -> []
  [X Sep Expr where Cond | XS] -> (append (adjust-pattern [X Sep Expr])
                                          (adjust-patterns XS))
                                       where (= -> Sep)
  [X Sep Expr | XS] -> (append (adjust-pattern [X Sep Expr])
                               (adjust-patterns XS))
                                       where (= -> Sep))

(defmacro extended-define-macro
  [define* Name | Patterns] -> [define Name | (adjust-patterns Patterns)])

(define* test-matcher
  (@just N) -> (* N N)
  @nothing -> 0)

(declare test-matcher [ [option number] --> number ])

(tc +)

(test-matcher @nothing)
(test-matcher (@just 10))
(test-matcher "invalid")