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 MaybeMonad
mm_v: resq 1
mm_e: resb 1
endstruc
%macro m_make 1-3 0,0
;; %1 = Name
;; %2 = Address of Structure
;; %3 = Something > 0, Nothing = 0
m_%1:
istruc MaybeMonad
at mm_v, dq %2 ; The address of the MaybeMonad-wrapped structure
at mm_e, 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+mm_v], rax
%else
mov qword [%1+mm_v], 0
%endif
%if %3 != 0
mov byte [%1+mm_e], %3
%else
mov byte [%1+mm_e], 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 MaybeMonad
;; %2 = MaybeMonad
;; m a -> (a -> m b) -> m b
lea rax, [%2]
mov rcx, rax
mov al, byte [rcx + mm_e]
cmp al, 0
je %%exit
mov rax, [rcx + mm_v]
call %1
%%exit:
%endmacro
%macro m_call 1-2 rax
;; %1 = Callable Function with Single Argument, the Unwrapped MaybeMonad
;; %2 = MaybeMonad
;; m a -> (a -> !) -> !
lea rax, [%2]
mov rcx, rax
mov al, byte [rcx + mm_e]
cmp al, 0
je %%exit
mov rax, [rcx + mm_v]
call %1
%%exit:
%endmacro
%macro alloc_m 0
alloc MaybeMonad_size
%endm
%macro free_m 0-1 rax
free %1, MaybeMonad_size
%endm
%endif
|
