~jojo/Carth

4b560621b59b8b0bc4bb3e4aeaf0274a900dfd06 — JoJo a month ago b95659b
Add example list-monad to demo macro features & the do macro
4 files changed, 52 insertions(+), 0 deletions(-)

A examples/list-monad.carth
M std/list.carth
M std/macros.carth
M std/math.carth
A examples/list-monad.carth => examples/list-monad.carth +15 -0
@@ 0,0 1,15 @@
(import list)
(import io)

(define main
  (flip io/for (<o display show-triple)
        (list/iter (let1 ns (list 1 2 3 4 5 6 7 8 9)
                     (do list/bind
                         (<- x ns)
                         (<- y ns)
                         (<- z ns)
                         (list/when (=s x y z)
                                    (list [x y z])))))))

(define (show-triple [a b c])
  (apps str-append "[" (show-int a) " " (show-int b) " " (show-int c) "]"))

M std/list.carth => std/list.carth +25 -0
@@ 56,3 56,28 @@
                  (Some [y (list/iter ys)]))
            (case Nil
                  None)))))

(define (list/append xs ys)
  (match xs
    (case (LCons (Box [x xs'])) (list/cons x (list/append xs' ys)))
    (case Nil ys)))

(define list/concat
  (fmatch (case (LCons (Box [xs xss])) (list/append xs (list/concat xss)))
          (case Nil Nil)))

(define (list/map f)
  (fmatch (case (LCons (Box [x xs])) (list/cons (f x) (list/map f xs)))
          (case Nil Nil)))

(define (list/bind f xs)
  (list/concat (list/map f xs)))

(define (list/bindr xs f)
  (list/concat (list/map f xs)))

(define (list/when condition xs)
  (if condition xs Nil))

(define (list/singleton x)
  (list/cons x Nil))

M std/macros.carth => std/macros.carth +9 -0
@@ 10,6 10,8 @@
  (case (xs ...) (appsr list/cons xs ... Nil)))

(defmacro +s () (case (xs ...) (apps + xs ...)))
(defmacro =s ()
  (case (x xs ...) (all (= x) (list/iter (list xs ...)))))

(defmacro io/wrap ()
  (case (computation) (IO (fun (real-world) [computation real-world]))))


@@ 17,3 19,10 @@
(defmacro lazy ()
  (case (computation) (Lazy [(unsafe-perform-io mutex/new)
                             (box (Left (fun (Unit) computation)))])))

(defmacro do (<-)
  (case (do-bind ma) ma)
  (case (do-bind (<- a ma) mbs ...)
        (do-bind (fun (a) (do do-bind mbs ...)) ma))
  (case (do-bind ma mbs ...)
        (do-bind (fun (_) (do do-bind mbs ...)) ma)))

M std/math.carth => std/math.carth +3 -0
@@ 20,6 20,9 @@
(define (and p q) (if p q    False))
(define (or  p q) (if p True q))

(define (ands xs) (foldl and True xs))
(define (all f xs) (ands (map f xs)))

(define not (fmatch (case True False)
                    (case False True)))