From cf8c4c93fd891018185f8a0cf0757f454a0e09a6 Mon Sep 17 00:00:00 2001 From: Christian Cunningham Date: Sat, 13 Jul 2024 21:33:21 -0700 Subject: Rough Monadic Implementation --- monad.inc | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 86 insertions(+) create mode 100644 monad.inc 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 -- cgit v1.2.1