diff options
| -rw-r--r-- | monad.inc | 86 |
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 |