~jojo/Carth

85b3f19132554a49358b87778c7e4831054620f1 — JoJo 1 year, 5 months ago ce5d4ca
Split std into separate files
6 files changed, 101 insertions(+), 108 deletions(-)

M examples/fizzbuzz.carth
A std/iter.carth
A std/list.carth
A std/maybe.carth
A std/nonstrict.carth
M std/std.carth
M examples/fizzbuzz.carth => examples/fizzbuzz.carth +2 -2
@@ 4,7 4,7 @@

(define (fizzbuzz _)
  (for (range 1 100)
       (comp display fizzbuzz')))
       (<o display fizzbuzz')))

(define (fizzbuzz' n)
  (match (Pair (divisible? n 3) (divisible? n 5))


@@ 14,7 14,7 @@
    (case (Pair True True) "Fizzbuzz")))

(define my-show-int
  (fun-match
  (fmatch
    (case 1 "one")
    (case 2 "two")
    (case n (show-int n))))

A std/iter.carth => std/iter.carth +27 -0
@@ 0,0 1,27 @@
(import std)
(import nonstrict)
(import list)
(import maybe)

(type (Iter a)
  (Iter (NonStrict (Maybe (Pair a (Iter a))))))

(define (next (Iter it)) (strict it))
(define (next! it) (unwrap! (next it)))

(define (range a b)
  (Iter (NonStrict (if (> a b)
                       (fun (_) None)
                     (fun (_) (Some (Pair a (range (+ a 1) b))))))))

(define (for xs f) (fold (const f) Unit xs))

(define: (fold f acc xs)
    (forall (acc x) (Fun (Fun acc x acc) acc (Iter x) acc))
  (let ((tail-fold (fun ((Pair acc xs))
                     (match (next xs)
                       (case (Some (Pair x xs'))
                             (tail-fold (Pair (f acc x) xs')))
                       (case None
                             acc)))))
    (tail-fold (Pair acc xs))))

A std/list.carth => std/list.carth +50 -0
@@ 0,0 1,50 @@
(type (List a)
  (Cons (Box (Pair a (List a))))
  Nil)

(define first
  (fmatch (case (Cons (Box (Pair x _))) (Some x))
          (case Nil None)))
(define first!
  (fmatch (case (Cons (Box (Pair x _))) x)
          (case Nil (panic "first! of empty list"))))

(define rest
  (fmatch (case (Cons (Box (Pair _ xs))) (Some xs))
          (case Nil None)))
(define rest!
  (fmatch (case (Cons (Box (Pair _ xs))) xs)
          (case Nil (panic "rest! of empty list"))))

(define last
  (fmatch (case (Cons (Box (Pair x Nil))) (Some x))
          (case (Cons (Box (Pair _ xs))) (last xs))
          (case Nil None)))
(define last!
  (fmatch (case (Cons (Box (Pair x Nil))) x)
          (case (Cons (Box (Pair _ xs))) (last! xs))
          (case Nil (panic "last! of empty list"))))

(define init
  (fmatch (case Nil None)
          (case xs (Some (init! xs)))))
(define init!
  (fmatch (case (Cons (Box (Pair _ Nil))) Nil)
          (case (Cons (Box (Pair x xs))) (cons x (init! xs)))
          (case Nil (panic "init! of empty list"))))

(define (cons x xs)
  (Cons (box (Pair x xs))))

(define (list1 x)
  (cons x Nil))
(define (list2 x0 x1)
  (cons x0 (list1 x1)))
(define (list3 x0 x1 x2)
  (cons x0 (list2 x1 x2)))
(define (list4 x0 x1 x2 x3)
  (cons x0 (list3 x1 x2 x3)))
(define (list5 x0 x1 x2 x3 x4)
  (cons x0 (list4 x1 x2 x3 x4)))
(define (list6 x0 x1 x2 x3 x4 x5)
  (cons x0 (list5 x1 x2 x3 x4 x5)))

A std/maybe.carth => std/maybe.carth +7 -0
@@ 0,0 1,7 @@
(type (Maybe a)
  None
  (Some a))

(define unwrap!
  (fmatch (case (Some x) x)
          (case None (panic "unwrap! of None"))))

A std/nonstrict.carth => std/nonstrict.carth +4 -0
@@ 0,0 1,4 @@
(type (NonStrict a)
  (NonStrict (Fun Unit a)))

(define (strict (NonStrict f)) (f Unit))

M std/std.carth => std/std.carth +11 -106
@@ 1,3 1,8 @@
(import nonstrict)
(import iter)
(import list)
(import maybe)

(define (fst (Pair a _)) a)
(define (snd (Pair _ b)) b)



@@ 9,20 14,6 @@
(define (panic msg)
  (seq (-panic msg) (undefined Unit)))

(type (Maybe a)
  None
  (Some a))

(define unwrap!
  (fun-match (case (Some x) x)
             (case None (panic "unwrap! of None"))))

(type (Lazy a)
  (Lazy (Fun Unit a)))

(define lively
  (fun-match (case (Lazy f) (f Unit))))

;;; Math

(extern rem-int (Fun (Pair Int Int) Int))


@@ 81,100 72,14 @@

;;; Function

(define (seq a b)
  b)

(define (comp f g a)
  (f (g a)))

;;; Iter

(type (Iter a)
  (Iter (Lazy (Maybe (Pair a (Iter a))))))

(define (next (Iter it)) (lively it))
(define (next! it) (unwrap! (next it)))

(define (range a b)
  (Iter (Lazy (if (> a b)
                  (fun _ None)
                (fun _ (Some (Pair a (range (+ a 1) b))))))))

(define (for xs f)
  (match (next xs)
    (case None Unit)
    (case (Some (Pair x xs'))
          (seq (f x) (for xs' f)))))

;;; List

(type (List a)
  (Cons (Box (Pair a (List a))))
  Nil)

(define first
  (fun-match
    (case (Cons (Box (Pair x _))) (Some x))
    (case Nil None)))
(define first!
  (fun-match
    (case (Cons (Box (Pair x _))) x)
    (case Nil (panic "first! of empty list"))))

(define rest
  (fun-match
    (case (Cons (Box (Pair _ xs))) (Some xs))
    (case Nil None)))
(define rest!
  (fun-match
    (case (Cons (Box (Pair _ xs))) xs)
    (case Nil (panic "rest! of empty list"))))

(define last
  (fun-match
    (case (Cons (Box (Pair x Nil))) (Some x))
    (case (Cons (Box (Pair _ xs))) (last xs))
    (case Nil None)))
(define last!
  (fun-match
    (case (Cons (Box (Pair x Nil))) x)
    (case (Cons (Box (Pair _ xs))) (last! xs))
    (case Nil (panic "last! of empty list"))))

(define init
  (fun-match
    (case Nil None)
    (case xs (Some (init! xs)))))
(define init!
  (fun-match
    (case (Cons (Box (Pair _ Nil))) Nil)
    (case (Cons (Box (Pair x xs))) (cons x (init! xs)))
    (case Nil (panic "init! of empty list"))))

(define (cons x xs)
  (Cons (box (Pair x xs))))

(define (list1 x)
  (cons x Nil))
(define (list2 x0 x1)
  (cons x0 (list1 x1)))
(define (list3 x0 x1 x2)
  (cons x0 (list2 x1 x2)))
(define (list4 x0 x1 x2 x3)
  (cons x0 (list3 x1 x2 x3)))
(define (list5 x0 x1 x2 x3 x4)
  (cons x0 (list4 x1 x2 x3 x4)))
(define (list6 x0 x1 x2 x3 x4 x5)
  (cons x0 (list5 x1 x2 x3 x4 x5)))

(define: (foldl f acc xs)
    (forall (a b) (Fun (Fun b a b) b (List a) b))
  (match xs
    (case (Cons (Box (Pair x xs'))) (foldl f (f acc x) xs'))
    (case Nil acc)))
(define (const a b) a)
(define (seq   a b) b)

(define (<o f g a) (f (g a)))
(define (o> f g a) (g (f a)))

(type Void)

(define: void-elim
    (forall (a) (Fun Void a))
  (fun-match))
  (fmatch))