aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/control/contract.lux
blob: 941d4e1efc69340e6b61b75f4a88cdd4577f976f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
(;module:
  lux
  (lux (control monad)
       (data text/format)
       [macro #+ Monad<Lux>]
       (macro [code]
              ["s" syntax #+ syntax:])))

(def: #export (assert! message test)
  (-> Text Bool [])
  (if test
    []
    (error! message)))

(syntax: #export (@pre test expr)
  {#;doc (doc "Pre-conditions."
              "Given a test and an expression to run, only runs the expression if the test passes."
              "Otherwise, an error is raised."
              (@pre (i.= 4 (i.+ 2 2))
                    (foo 123 456 789)))}
  (wrap (list (` (exec (assert! (~ (code;text (format "Pre-condition failed: " (%ast test))))
                                (~ test))
                   (~ expr))))))

(syntax: #export (@post test expr)
  {#;doc (doc "Post-conditions."
              "Given a predicate and an expression to run, evaluates the expression and then tests the output with the predicate."
              "If the predicate returns true, returns the value of the expression."
              "Otherwise, an error is raised."
              (@post i.even?
                     (i.+ 2 2)))}
  (do @
    [g!output (macro;gensym "")]
    (wrap (list (` (let [(~ g!output) (~ expr)]
                     (exec (assert! (~ (code;text (format "Post-condition failed: " (%ast test))))
                                    ((~ test) (~ g!output)))
                       (~ g!output))))))))