Rough Monadic Implementation

1 files changed, 86 insertions, 0 deletions

diff --git a/monad.inc b/monad.inc
new file mode 100644
index 0000000..6c5f676
--- /dev/null
+++ b/monad.inc
@@ -0,0 +1,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 1
+	free	%1,	Monad_size
+%endm
+
+%endif