~jojo/Carth

ref: 2d64043ef7cdff3d025dfe01dfc69e9c69236b68 Carth/examples/fizzbuzz.carth -rw-r--r-- 1.5 KiB
2d64043eJoJo Verify LLVM module before compiling to catch errors 1 year, 11 months ago
                                                                                
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
(type (Pair a b)
  (Pair a b))

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

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

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


(define (start _) (fizzbuzz unit))

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

(define (fizzbuzz' n)
  (if (and (divisible? n 3) (divisible? n 5))
      "Fizzbuzz"
    (if (divisible? n 3)
        "Fizz"
      (if (divisible? n 5)
          "Buzz"
        (show-int n)))))

(define (display s)
  (display-inline (str-append s "\n")))

(define (for xs f)
  (match (next xs)
    [None unit]
    [(Some (Pair x xs'))
     (seq (f x) (for xs' f))]))

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

(define next (fun-match [(Iter it) (lively it)]))
(define lively (fun-match [(Lazy f) (f unit)]))
(define (seq a b) b)
(define (comp f g a) (f (g a)))
(define (and p q) (if p q false))
(define (divisible? n m) (= (rem n m) 0))


;;; Extern wrappers

(define (str-append s1 s2) (-str-append (Pair s1 s2)))
(define (> a b) (gt-int (Pair a b)))
(define (= a b) (eq-int (Pair a b)))
(define (+ a b) (add-int (Pair a b)))
(define (rem a b) (rem-int (Pair a b)))


;;; Externs

(extern display-inline (Fun Str Unit))
(extern -str-append (Fun (Pair Str Str) Str))
(extern show-int (Fun Int Str))
(extern gt-int (Fun (Pair Int Int) Bool))
(extern eq-int (Fun (Pair Int Int) Bool))
(extern add-int (Fun (Pair Int Int) Int))
(extern rem-int (Fun (Pair Int Int) Int))