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
|
%ifndef MONAD_INC
%define MONAD_INC
%ifndef ALLOC_INC
%include "alloc.inc"
%endif
struc Monad
just: resq 1
exist: resb 1
endstruc
%macro m_make 1-3 0,0
;; %1 = Name
;; %2 = Address of Structure
;; %3 = Something > 0, Nothing = 0
m_%1:
istruc Monad
at just, dq %2 ; The address of the Monad-wrapped structure
at exist, db %3 ; Something > 0, Nothing = 0
iend
%endm
%macro m_Just 1-3 0,0
;; %1 = Name
;; %2 = New Structure Address
;; %3 = Something > 0, Nothing = 0
%if %2 != 0
lea rax, [rel %2]
mov qword [%1+just], rax
%else
mov qword [%1+just], 0
%endif
%if %3 != 0
mov byte [%1+exist], %3
%else
mov byte [%1+exist], 0
%endif
lea rax, [%1]
%endm
%macro m_Nothing 1
;; %1 = Name
m_Just %1
%endm
%macro m_return 1-2 rax
m_Just %1, %2, 1
%endm
%macro m_bind 1-2 rax
;; %1 = Callable Function with Single Argument, the Unwrapped Monad
;; %2 = Monad
;; m a -> (a -> m b) -> m b
lea rax, [%2]
mov rcx, rax
mov al, byte [rcx + exist]
cmp al, 0
je %%exit
mov rax, [rcx + just]
call %1
%%exit:
%endmacro
%macro m_call 1-2 rax
;; %1 = Callable Function with Single Argument, the Unwrapped Monad
;; %2 = Monad
;; m a -> (a -> !) -> !
lea rax, [%2]
mov rcx, rax
mov al, byte [rcx + exist]
cmp al, 0
je %%exit
mov rax, [rcx + just]
call %1
%%exit:
%endmacro
%macro alloc_m 0
alloc Monad_size
%endm
%macro free_m 0-1 rax
free %1, Monad_size
%endm
%endif
|
