fortran-wasm-compiler/main.f90

program varaq_wasm_compiler
    use types_mod
    use opcodes_mod
    use tokenizer_mod
    implicit none
    
    integer :: u, ios
    character, dimension(:), allocatable :: tape

    character, dimension(4) :: magic_module_header = [ achar(0), achar(97), achar(115), achar(109) ]
    character, dimension(4) :: module_version = [ achar(1), achar(0), achar(0), achar(0) ]
    character, dimension(:), allocatable :: add_function_type 
    character, dimension(:), allocatable :: type_section
    character, dimension(:), allocatable :: func_section
    character, dimension(:), allocatable :: export_section
    character, dimension(:), allocatable :: code_code
    character, dimension(:), allocatable :: function_body
    character, dimension(:), allocatable :: code_section
    character, allocatable :: main_string(:)
    character(len = :), allocatable :: main_text
    integer :: a, b

    character(:), allocatable :: input_code
    type(token), dimension(:), allocatable :: tokens
    character(256) :: file_input, file_output
    integer :: i, sz

    call getarg(1, file_input)
    call getarg(2, file_output)

    open(u, file=file_input)
    inquire(unit=u, size=sz)
    close(u)

    allocate(character(len=sz) :: input_code)

    open(unit=u,file=file_input, status='old', access='stream')
    do i=1,sz
        read(u) input_code(i:i)
    end do

    tokens = tokenize(input_code)

    do i=1,size(tokens)
        print *, tokens(i)%index, tokens(i)%value, " ", tokens(i)%type
    end do
    
    add_function_type = [type_function, encodeVector([f32, f32]), encodeVector([f32])]
    
    ! the type section is a vector of function types
    type_section = createSection(section_type, encodeVector(add_function_type, 1))

    ! the function section is a vector of type indices that indicate the type of each function
    ! in the code section
    func_section = createSection(section_func, encodeVector([achar(0)]))

    ! the export section is a vector of exported functions
    main_text = "main"
    main_string = transfer(main_text, ' ', size = len(main_text))

    export_section = createSection(section_export, encodeVector([encodeString(main_string), export_func, achar(0)], 1))
    a = 0
    b = 1
    code_code = [LOCAL_GET, unsignedLEB128(a), LOCAL_GET, unsignedLEB128(b), F32_ADD]
    function_body = encodeVector([type_empty_array, code_code, END])
    code_section = createSection(section_code, encodeVector([function_body], 1))
    
    tape = [magic_module_header]
    tape = [tape, module_version]
    tape = [tape, type_section]
    tape = [tape, func_section]
    tape = [tape, export_section]
    tape = [tape, code_section]

    open(unit=u, file=file_output, access='stream', status='replace', action='write', iostat=ios)
    write(u, iostat=ios) tape
    close(u, iostat=ios)
    
    deallocate(tape)
    
contains

function signedLEB128(n) result(buffer)
    logical :: more
    integer :: n
    character :: byte
    character, dimension(:), allocatable :: buffer

    more = .true.
    do while (more)
        byte = achar(iand(n, 127))
        n = rshift(n, 7)
        if (((n .ne. 0) .and. (iand(ichar(byte), 64) .eq. 0) .or. ((n .eq. -1) .and. (iand(ichar(byte), 64) .ne. 0)))) then
            more = .false.
        else
            byte = achar(ior(ichar(byte), 128))
        end if

        if (allocated(buffer)) then
            buffer = [buffer, byte]
        else
            buffer = [byte]
        end if
    end do
end function signedLEB128

function unsignedLEB128(n) result(buffer)
    integer :: n
    character :: byte
    character, dimension(:), allocatable :: buffer

    do
      byte = achar(iand(n, 127))
      n = rshift(n, 7)
      if (n .ne. 0) then
        byte = achar(ior(ichar(byte), 128))
      end if
      if (allocated(buffer)) then
        buffer = [buffer, byte]
      else
        buffer = [byte]
      end if
      if (n .eq. 0) then
        exit
      end if
    end do
end function unsignedLEB128

function encodeString(data, length) result(arr)
    character, dimension(:) :: data
    character, dimension(:), allocatable :: arr
    integer, optional :: length
    integer :: length_local

    if (present(length)) then
        length_local = length
    else
        length_local = size(data)
    end if

    arr = [unsignedLEB128(length_local), data]
end function encodeString

function encodeVector(data, length) result(arr)
    character, dimension(:) :: data
    character, dimension(:), allocatable :: arr
    integer, optional :: length
    integer :: length_local

    if (present(length)) then
        length_local = length
    else
        length_local = size(data)
    end if

    arr = [unsignedLEB128(length_local), data]
end function encodeVector

function createSection(section, data) result (arr)
    character, dimension(:) :: data
    character, dimension(:), allocatable :: arr
    character :: section

    arr = [section, encodeVector(data)]
end function createSection

end program varaq_wasm_compiler