aboutsummaryrefslogtreecommitdiff
path: root/monad.inc
blob: 18d8552b3ddc82ecb83f8247aaa9eac6869bfd21 (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
%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