blob: 6eb0cbf4d48272f4334d1c891a4925e0f320c443 (
about) (
plain)
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
|
;; these primitives support arbitrary sized tuples.
(define (prim.tupleSize x)
(vector-length x))
(define (prim.tupleSel tuple i n)
(force
(if (eqv? n 2)
(if (eqv? i 0)
(car tuple)
(cdr tuple))
(vector-ref tuple i))))
(define (prim.list->tuple l)
(let ((l (haskell-list->list/non-strict l)))
(if (null? (cddr l))
(cons (car l) (cadr l))
(list->vector l))))
(define (haskell-list->list/non-strict l)
(if (null? l)
'()
(cons (car l)
(haskell-list->list/non-strict (force (cdr l))))))
(define (prim.dict-sel dicts i)
(force (vector-ref dicts i)))
;;; These generate dictionaries.
(define-local-syntax (create-dict dicts vars other-dicts)
`(let ((dict-vector (box (list->vector ,dicts))))
(make-tuple
,@(map (lambda (v)
`(delay (funcall (dynamic ,v) dict-vector)))
vars)
,@(map (lambda (sd)
`(delay (,(car sd)
(map (lambda (d)
(tuple-select ,(cadr sd) ,(caddr sd) (force d)))
,dicts))))
other-dicts))))
(define prim.tupleEqdict
(lambda dicts
(tupleEqDict/l dicts)))
(define (tupleEqDict/l dicts)
(create-dict dicts
(|PreludeTuple:tupleEq| |PreludeTuple:tupleNeq|)
()))
(define prim.tupleOrdDict
(lambda dicts
(tupleOrdDict/l dicts)))
(define (tupleOrdDict/l d)
(create-dict d
(|PreludeTuple:tupleLe| |PreludeTuple:tupleLeq|
|PreludeTuple:tupleGe| |PreludeTuple:tupleGeq|
|PreludeTuple:tupleMax| |PreludeTuple:tupleMin|)
((tupleEqDict/l 7 6))))
(define prim.tupleIxDict
(lambda dicts
(create-dict dicts
(|PreludeTuple:tupleRange| |PreludeTuple:tupleIndex|
|PreludeTuple:tupleInRange|)
((tupleEqDict/l 6 3) (tupleTextDict/l 6 4) (tupleOrdDict/l 6 5)))))
(define prim.tupleTextDict
(lambda dicts
(tupleTextDict/l dicts)))
(define (tupleTextDict/l d)
(create-dict d
(|PreludeTuple:tupleReadsPrec| |PreludeTuple:tupleShowsPrec|
|PreludeTuple:tupleReadList| |PreludeTuple:tupleShowList|)
()))
(define prim.tupleBinaryDict
(lambda dicts
(create-dict dicts
(|PreludeTuple:tupleReadBin| |PreludeTuple:tupleShowBin|)
())))
|
