~jojo/Carth

ref: 55fb4f948f1f3797078b584dc60b4f7dd68b37ed Carth/std/io.carth -rw-r--r-- 1.3 KiB
55fb4f94JoJo Check `cast` in Infer instead of Gen 4 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
(import std)

(define: (io/for xs f)
    (forall (a) (Fun (Iter a) (Fun a (IO Unit)) (IO Unit)))
  (IO (fun (real-world)
        [Unit (foldl (fun (real-world a) (cadr (perform-io (f a) real-world)))
                     real-world
                     xs)])))

(define (io/pure a) (IO (fun (real-world) [a real-world])))

(define: (io/map f (IO ma))
    (forall (a b) (Fun (Fun a b) (IO a) (IO b)))
  (IO (o> ma (map-car f))))

(define: (io/bind f (IO ma))
    (forall (a b) (Fun (Fun a (IO b)) (IO a) (IO b)))
  (IO (o> ma (uncurry (o> f perform-io)))))

(define io/bindr (flip io/bind))

(define (io/thenl mb ma) (io/bind (const mb) ma))
(define (io/thenr ma mb) (io/bindr ma (const mb)))

(define: (unsafe-perform-io ma)
    (forall (a) (Fun (IO a) a))
  (car (perform-io ma UnsafeRealWorld)))

(define: (perform-io (IO ma))
    (forall (a) (Fun (IO a) RealWorld [a RealWorld]))
  ma)

(extern unsafe-display-inline (Fun Str Unit))

(define (display-inline s)
  (io/wrap (unsafe-display-inline s)))

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

(extern -get-contents (Fun RealWorld [Str RealWorld]))
(define get-contents (IO -get-contents))

(extern unsafe-read-file (Fun Str (Maybe Str)))
(define (read-file f) (IO (fun (real-world) [(unsafe-read-file f) real-world])))

(define (io/write-ref x ptr)
  (io/wrap (store x ptr)))