-
Notifications
You must be signed in to change notification settings - Fork 0
/
demo-fixpoint.cat
93 lines (86 loc) · 1.76 KB
/
demo-fixpoint.cat
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
90
91
92
93
// Dedicated to the public domain by Christopher Diggins
// This file is free to be used, modified or redistributed for any purpose,
// without restriction, obligation or warantee.
// http://www.cdiggins.com
// Fix-point combinator tests
define m
{{
desc:
The self application combinator, sometimes referred to as the U combinator
tags:
demo,fixpoint
}}
{
dup apply
}
define m_fact : (int -> int)
{{
desc:
A factorial written using the m (a.k.a. U) combinator
test:
in: 5 m_fact
out: 120
tags:
demo,fixpoint
}}
{
[
over 0 eq
[pop2 1]
[[dup dec] dip m mul_int]
if
]
m
}
define m_while : ('A ('A -> 'A) ('A -> 'A bool) -> 'A)
{{
desc:
A while function written using the M combinator
test:
in: 1 5 [[2 mul_int] dip dec] [is_neqz] m_while pop
out: 32
tags:
demo,fixpoint
}}
{
// [$A] [$B]
[dip swap] papply // [$A] [[$B] dip swap]
swap // [[$B] dip swap] [$A]
[dip m] papply // [[$B] dip swap] [[$A] swap m]
quote compose // [[$B] dip swap [[$A] dip m]]
[[pop] if] compose // [[$B] dip swap [[$A] dip m] [pop] if]
m
}
define y
{{
desc:
This is the famous y combinator. It executes a function with itself as an argument.
The function is expected to terminate on its own when a "fixpoint" is reached.
tags:
demo,fixpoint
}}
{
[dup papply] swap compose dup apply
}
/*
TEMP: removed because it violates new type system
define y_fact : (int -> int)
{{
desc:
A factorial written using the y combinator
test:
in: 5 y_fact
out: 120
tags:
demo,fixpoint
}}
{
[
dupd swap 0 eq
[pop2 1]
[[dup dec] dip apply mul_int]
if
]
y
}
*/