~jojo/Carth

ref: 3f71c019bc3fd13360c650cd69e5e211660db158 Carth/examples/std.carth -rw-r--r-- 1.5 KiB
3f71c019JoJo Delay StartNotDefined error until after typechecking 1 year, 10 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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
(define fst
  (fun-match (case (Pair a _) a)))
(define snd
  (fun-match (case (Pair _ b) b)))

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

(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))
(define (rem a b)
  (rem-int (Pair a b)))

(extern add-int (Fun (Pair Int Int) Int))
(define (+ a b)
  (add-int (Pair a b)))

(extern sub-int (Fun (Pair Int Int) Int))
(define (- a b)
  (sub-int (Pair a b)))

(extern eq-int (Fun (Pair Int Int) Bool))
(define (= a b)
  (eq-int (Pair a b)))

(extern gt-int (Fun (Pair Int Int) Bool))
(define (> a b)
  (gt-int (Pair a b)))

(define (>= a b)
  (or (> a b) (= a b)))

(define (and p q)
  (if p q false))
(define (or p q)
  (if p true q))

(define (divisible? n m)
  (= (rem n m) 0))

;;; Strings

(extern show-int (Fun Int Str))

(extern -str-append (Fun (Pair Str Str) Str))
(define (str-append s1 s2)
  (-str-append (Pair s1 s2)))

;;; IO

(extern display-inline (Fun Str Unit))

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

;;; 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
  (fun-match (case (Iter it) (lively 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)))))