Carp/core/Control.carp at master · carp-lang/Carp · GitHub

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
;; This module contains functions that deal with functions, control flow, etc.

(doc Control "contains functions that deal with functions, control flow, and
other higher order concepts.")
(defmodule Control

  (doc iterate "Apply function `f` `n` times, first to `start` and then to the result of `f`. TODO: Mention fix points.")
  (sig iterate (Fn [Int, (Ref (Fn [a] a b) c), a] a))
  (defn iterate [n f start]
    (let-do [result start]
      (for [i 0 n]
        (set! result (~f result)))
      result))

  (doc iterate-until "Like `iterate`, but f is applied repeatedly until the predicate `pred` is true.")
  (sig iterate-until (Fn [(Ref (Fn [b] b c) d), (Ref (Fn [b] Bool c) e), b] b))
  (defn iterate-until [f pred start]
    (let-do [result start]
      (while (not (~pred result))
        (set! result (~f result)))
      result))

  (doc when-success
    "Executes a side effect, `f`, when `result` is `Success`ful."
    "```"
    "(def suc (the (Result Int Int) (Result.Success 0)))"
    "(def err (the (Result Int Int) (Result.Error 0)))"
    ""
    "(when-success &(fn [] (IO.println \"success!\")) suc)"
    "=> success!"
    "(when-success &(fn [] (IO.println \"success!\")) err)"
    "=> "
    "```")
  (sig when-success (Fn [&(Fn [] ()) (Result a b)] ()))
  (defn when-success [f result]
    (match result
      (Result.Success _) (~f)
      _ ()))

  (doc when-error
    "Executes a side effect, `f`, when `result` is `Error`oneus."
    "```"
    "(def suc (the (Result Int Int) (Result.Success 0)))"
    "(def err (the (Result Int Int) (Result.Error 0)))"
    ""
    "(when-error &(fn [] (IO.println \"error!\")) err)"
    "=> error!"
    "(when-error &(fn [] (IO.println \"error!\")) suc)"
    "=> "
    "```")
  (sig when-error (Fn [&(Fn [] ()) (Result a b)] ()))
  (defn when-error [f result]
    (match result
      (Result.Error _) (~f)
      _ ()))

  (doc when-just
    "Executes a side-effect, `f`, when `maybe` is `Just`."
    "```"
    "(def just (Maybe.Just 2))"
    "(def nothing (the (Maybe Int) (Maybe.Nothing)))"
    ""
    "(when-just &(fn [] (IO.println \"just!\")) just)"
    "=> just!"
    "(when-just &(fn [] (IO.println \"just!\")) nothing)"
    "=> "
    "```")
  (sig when-just (Fn [&(Fn [] ()) (Maybe a)] ()))
  (defn when-just [f maybe]
    (match maybe
      (Maybe.Just _) (~f)
      _ ()))

  (doc when-nothing
    "Executes a side-effect, `f`, when `maybe` is `Nothing`."
    "```"
    "(def just (Maybe.Just 2))"
    "(def nothing (the (Maybe Int) (Maybe.Nothing)))"
    ""
    "(when-nothing &(fn [] (IO.println \"nothing!\")) nothing)"
    "=> nothing!"
    "(when-nothing &(fn [] (IO.println \"nothing!\")) just)"
    "=> "
    "```")
  (sig when-nothing (Fn [&(Fn [] ()) (Maybe a)] ()))
  (defn when-nothing [f maybe]
    (match maybe
      (Maybe.Nothing) (~f)
      _ ()))
  )