llvm idris rts

rts.ll

; TODO load int32 etc by value instead of jumping through a pointer
; like we currently do for consistency

target triple = "x86_64-unknown-linux-gnu"

%Arglist = type { i32, i32, %Value* } ; pointer to a list of values
%Func = type void (%Value*, %Arglist*)*

%Value = type { i8, [24 x i8] }

; variants
%Int32 = type { i8, i32 }
%Int64 = type { i8, i32 }
%Char = type { i8, i8 }
%String = type { i8, i8* }
%Closure = type { i8, %Func, %Arglist* }
%Constr = type { i8, i32, %Arglist* }

; sentinel variants
%FeedMe = type { i8 }
%Void = type { i8 }

;; globals

@int-fmt-str 
  = private unnamed_addr constant [19 x i8] c"the number is: %d\0A\00", align 1
@char-fmt-str 
  = private unnamed_addr constant [17 x i8] c"the char is: %c\0A\00", align 1

;; externs

declare i8* @malloc(i64)
declare i8* @calloc(i64, i64)
declare i8* @memcpy(i8*, i8*, i64)
declare i32 @printf(i8*, ...)
declare i32 @puts(i8*)
declare void @free(i8*)

;; make

define void @value_make_int32(%Value* sret %ret, i32 %arg) {
  %tag-addr = getelementptr inbounds %Value, %Value* %ret, i32 0, i32 0
  store i8 0, i8* %tag-addr

  %variant = bitcast %Value* %ret to %Int32*
  %data-addr = getelementptr inbounds %Int32, %Int32* %variant, i32 0, i32 1
  store i32 %arg, i32* %data-addr

  ret void
}

define void @value_make_char(%Value* sret %ret, i8 %arg) {
  %tag-addr = getelementptr inbounds %Value, %Value* %ret, i32 0, i32 0
  store i8 2, i8* %tag-addr

  %variant = bitcast %Value* %ret to %Char*
  %data-addr = getelementptr inbounds %Char, %Char* %variant, i32 0, i32 1
  store i8 %arg, i8* %data-addr

  ret void
}

define void @value_make_feedme(%Value* sret %ret) {
  %tag-addr = getelementptr inbounds %Value, %Value* %ret, i32 0, i32 0
  store i8 3, i8* %tag-addr

  ret void
}

define void @value_make_closure(%Value* %ret, %Func %func, %Arglist* %arglist) {
  %tag-addr = getelementptr inbounds %Value, %Value* %ret, i32 0, i32 0
  store i8 3, i8* %tag-addr

  %variant = bitcast %Value* %ret to %Closure*
  %func-addr = getelementptr inbounds %Closure, %Closure* %variant, i32 0, i32 1
  %arglist-addr = getelementptr inbounds %Closure, %Closure* %variant, i32 0, i32 2
  store %Func %func, %Func* %func-addr
  store %Arglist* %arglist, %Arglist** %arglist-addr

  ret void
}

define void @value_apply_closure(%Value* %ret, %Value* %clos, %Value* %arg) {
  ; TODO assert clos is a closure
  %variant = bitcast %Value* %clos to %Closure*
  %func-addr = getelementptr inbounds %Closure, %Closure* %variant, i32 0, i32 1
  %func = load %Func, %Func* %func-addr
  %arglist-addr = getelementptr inbounds %Closure, %Closure* %variant, i32 0, i32 2
  %arglist = load %Arglist*, %Arglist** %arglist-addr

  %missing = call i32 @arglist_push_value(%Arglist* %arglist, %Value* %arg)
  %cond = icmp eq i32 %missing, 0

  br i1 %cond, label %just-go, label %feed-me

just-go:
  call void %func(%Value* %ret, %Arglist* %arglist)
  ret void

feed-me:
  call void @value_make_feedme(%Value* %ret)
  ret void
}

define void @value_read_int32(i32* sret %ret, %Value* %val) {
  %tag-addr = getelementptr inbounds %Value, %Value* %val, i32 0, i32 0
  %tag = load i8, i8* %tag-addr
  ; TODO assert

  %variant = bitcast %Value* %val to %Int32*
  %data-addr = getelementptr inbounds %Int32, %Int32* %variant, i32 0, i32 1
  %ret-val = load i32, i32* %data-addr
  store i32 %ret-val, i32* %ret

  ret void
}

define i32 @arglist_push_value(%Arglist* %arglist, %Value* %val) {
  ; TODO assert filled < capacity
  %arglist.capacity.ptr
    = getelementptr inbounds %Arglist, %Arglist* %arglist, i32 0, i32 0
  %arglist.capacity = load i32, i32* %arglist.capacity.ptr

  %arglist.filled.ptr
    = getelementptr inbounds %Arglist, %Arglist* %arglist, i32 0, i32 1
  %arglist.filled.old = load i32, i32* %arglist.filled.ptr
  %arglist.filled.new = add i32 1, %arglist.filled.old
  store i32 %arglist.filled.new, i32* %arglist.filled.ptr

  %arglist.values.ptr
    = getelementptr inbounds %Arglist, %Arglist* %arglist, i32 0, i32 2
  %arglist.values = load %Value*, %Value** %arglist.values.ptr
  %arglist.values.next
    = getelementptr inbounds %Value, 
        %Value* %arglist.values, 
        i32 %arglist.filled.old ; filled.old=i means we write to values[i] now

  %memcpy.src = bitcast %Value* %val to i8*
  %memcpy.dst = bitcast %Value* %arglist.values.next to i8*
  ; FIXME 25=sizeof(Value)
  call i8* @memcpy(i8* %memcpy.dst, i8* %memcpy.src, i64 25)

  %missing = sub i32 %arglist.capacity, %arglist.filled.new
  ret i32 %missing
}

; ops

define void @value_add_int32(%Value* sret %ret, %Value* %a, %Value* %b) {
  ; TODO asserts
  %a-ptr = alloca i32
  call void @value_read_int32(i32* %a-ptr, %Value* %a)
  %a-val = load i32, i32* %a-ptr
  %b-ptr = alloca i32
  call void @value_read_int32(i32* %b-ptr, %Value* %b)
  %b-val = load i32, i32* %b-ptr

  %ret-val = add i32 %a-val, %b-val
  call void @value_make_int32(%Value* %ret, i32 %ret-val)
  
  ret void
}

define void @value_add_int32_args(%Value* sret %ret, %Arglist* %arglist) {
  %values.ptr
    = getelementptr inbounds %Arglist, %Arglist* %arglist, i32 0, i32 2
  %values = load %Value*, %Value** %values.ptr
  %args.0 = getelementptr %Value, %Value* %values, i32 0
  %args.1 = getelementptr %Value, %Value* %values, i32 1
  call void @value_add_int32(%Value* %ret, %Value* %args.0, %Value* %args.1)
  ret void
}

define void @value_sub_int32(%Value* sret %ret, %Value* %a, %Value* %b) {
  ; TODO asserts
  %a-ptr = alloca i32
  call void @value_read_int32(i32* %a-ptr, %Value* %a)
  %a-val = load i32, i32* %a-ptr
  %b-ptr = alloca i32
  call void @value_read_int32(i32* %b-ptr, %Value* %b)
  %b-val = load i32, i32* %b-ptr

  %ret-val = sub i32 %a-val, %b-val
  call void @value_make_int32(%Value* %ret, i32 %ret-val)
  
  ret void
}

define void @value_sub_int32_args(%Value* sret %ret, %Arglist* %arglist) {
  %values.ptr
    = getelementptr inbounds %Arglist, %Arglist* %arglist, i32 0, i32 2
  %values = load %Value*, %Value** %values.ptr
  %args.0 = getelementptr %Value, %Value* %values, i32 0
  %args.1 = getelementptr %Value, %Value* %values, i32 1
  call void @value_sub_int32(%Value* %ret, %Value* %args.0, %Value* %args.1)
  ret void
}

define void @print_value(%Value* %value) {
  %tag-addr = getelementptr inbounds %Value, %Value* %value, i32 0, i32 0
  %tag = load i8, i8* %tag-addr

  %is-int32 = icmp eq i8 %tag, 0
  
  switch i8 %tag, label %err
    [ i8 0, label %print-int32
      ; i8 1, label %print-int64
      i8 2, label %print-char
      ; i8 3, label %print-closure
    ]

print-int32:
  %int32-variant = bitcast %Value* %value to %Int32*
  %int32-data-addr 
    = getelementptr inbounds %Int32, %Int32* %int32-variant, i32 0, i32 1
  %int32-data = load i32, i32* %int32-data-addr
  %int32-fmt-str-addr 
    = getelementptr inbounds [19 x i8], [19 x i8]* @int-fmt-str, i32 0, i32 0
  %int32-retv = call i32 (i8*, ...) @printf(i8* %int32-fmt-str-addr, i32 %int32-data)
  ret void

print-char:
  %char-variant = bitcast %Value* %value to %Char*
  %char-data-addr 
    = getelementptr inbounds %Char, %Char* %char-variant, i32 0, i32 1
  %char-data = load i8, i8* %char-data-addr
  %char-fmt-str-addr 
    = getelementptr inbounds [17 x i8], [17 x i8]* @char-fmt-str, i32 0, i32 0
  %char-retv = call i32 (i8*, ...) @printf(i8* %char-fmt-str-addr, i8 %char-data)
  ret void

err:
  ; TODO fatal
  ret void
}

define i32 @main() {
entry:
  ;; printf test
  ;%fmt-str-addr 
  ;  = getelementptr inbounds [19 x i8], [19 x i8]* @int-fmt-str, i32 0, i32 0
  ;%retv = call i32 (i8*, ...) @printf(i8* %fmt-str-addr, i32 21)

  %my-value = alloca %Value
  call void @value_make_int32(%Value* %my-value, i32 77)
  call void @print_value(%Value* %my-value)
  call void @value_make_char(%Value* %my-value, i8 65)
  call void @print_value(%Value* %my-value)

  ; %val1 = alloca %Value
  ; %val2 = alloca %Value
  ; %val3 = alloca %Value
  ; call void @value_make_int32(%Value* %val1, i32 20)
  ; call void @value_make_int32(%Value* %val2, i32 40)
  ; call void @value_add_int32(%Value* %val3, %Value* %val1, %Value* %val2)
  ; call void @print_value(%Value* %val3)

  %sizeof-Value-ptr = getelementptr %Value, %Value* null, i32 1
  %sizeof-Value = ptrtoint %Value* %sizeof-Value-ptr to i64 ; = 25

  %sizeof-Arglist-ptr = getelementptr %Arglist, %Arglist* null, i32 1
  %sizeof-Arglist = ptrtoint %Arglist* %sizeof-Arglist-ptr to i64 ; = 16

  %arglist-raw = call i8* @malloc(i64 %sizeof-Arglist)
  %arglist = bitcast i8* %arglist-raw to %Arglist*
  %arglist.capacity 
    = getelementptr inbounds %Arglist, %Arglist* %arglist, i32 0, i32 0
  store i32 2, i32* %arglist.capacity
  %arglist.filled
    = getelementptr inbounds %Arglist, %Arglist* %arglist, i32 0, i32 1
  store i32 0, i32* %arglist.filled

  %arglist.values
    = getelementptr inbounds %Arglist, %Arglist* %arglist, i32 0, i32 2

  %values-raw = call i8* @calloc(i64 2, i64 %sizeof-Value)
  %values = bitcast i8* %values-raw to %Value*
  store %Value* %values, %Value** %arglist.values 

  %clos = alloca %Value
  call void @value_make_closure(%Value* %clos, 
    %Func @value_sub_int32_args, 
    %Arglist* %arglist)

  %tmp = alloca %Value
  %sum = alloca %Value
  call void @value_make_int32(%Value* %tmp, i32 20)
  call void @value_apply_closure(%Value* %sum, %Value* %clos, %Value* %tmp)
  call void @value_make_int32(%Value* %tmp, i32 140)
  call void @value_apply_closure(%Value* %sum, %Value* %clos, %Value* %tmp)

  call void @print_value(%Value* %sum)

  call void @free(i8* %values-raw)
  ; TODO free everything else

  ret i32 0
}