Array type consistency

lwb/metalang/llvm/llvm.spoofax2/syntax/llvm.sdf3

@@ -23,6 +23,7 @@ context-free syntax
   Definition.TargetTriple = <target triple = <STRING>>
   Definition.ModuleAsm = <module asm <STRING>>
   Definition.GlobalDef = <<Constant> = <Linkage> <GlobalAttribute*> <Type> <Literal>>
+  Definition.TypeDef = <<Variable> = type <Type>>
   Definition.FunDecl = <declare <Linkage> <CallConv> <Type> <Constant>(<{Parameter ", "}*>) <FunctionAttribute*>>
   Definition.FunDef = <
 define <Linkage> <CallConv> <Type> <Constant>(<{Parameter ", "}*>) <FunctionAttribute*> {

lwb/metalang/llvm/llvm.spoofax2/syntax/llvm/Atoms.sdf3

@@ -28,9 +28,12 @@ context-free syntax
   Type.Pointer = <ptr>
   Type.PointerAddrSpace = <ptr addrspace(<INT>)>
   Type.Array = <[<POSINT> x <Type>]>
+  Type.Struct = <{<{Type ", "}*>}>
+  Type.PackedStruct = [<{[{Type ", "}*]}>]
   Type.Label = <label>
   Type.Void = <void>
   Type.Function = <<Type> (<{Parameter ", "}*>)>
+  Type.VarType = <<Variable>>
 
   Atom.Literal = <<Literal>>
   Atom.ConstAtom = <<Constant>>

lwb/metalang/llvm/llvm.spoofax2/syntax/llvm/Attributes.sdf3

@@ -45,6 +45,7 @@ context-free syntax
   FunctionAttribute.AllocKind = <allockind(<STRING>)>
   FunctionAttribute.AllocSize = <allocsize(<INT>)>
   FunctionAttribute.AllocFamily = <"alloc-family"=<STRING>>
+  FunctionAttribute.GCLeafFunction = <"gc-leaf-function"="true">
 
   OperandBundles.NoOperandBundles = <>
   OperandBundles.OperandBundles = <[<OperandBundle*>]>

lwb/metalang/llvm/llvm.spoofax2/tim_head.aterm

@@ -14,6 +14,10 @@ LLVMProgram(
     , Array("4", Int8())
     , String("\"%s\\0A\\00\"")
     )
+  , TypeDef(
+      Variable(".array_type")
+    , Struct([Int64(), Array("0", Int64())])
+    )
   , ModuleAsm("\".globl __LLVM_StackMaps\"")
   , FunDecl(
       DefaultLinkage()
@@ -64,15 +68,15 @@ LLVMProgram(
       , ParamUnnamed(PointerAddrSpace("1"), [])
       , ParamUnnamed(Int64(), [])
       ]
-    , [NoUnwind()]
+    , [NoUnwind(), GCLeafFunction()]
     )
   , FunDecl(
       DefaultLinkage()
     , DefaultCConv()
     , Int64()
     , Constant("record_read")
     , [ParamUnnamed(PointerAddrSpace("1"), []), ParamUnnamed(PointerAddrSpace("1"), [])]
-    , [NoUnwind()]
+    , [NoUnwind(), GCLeafFunction()]
     )
   , FunDecl(
       DefaultLinkage()
@@ -83,23 +87,15 @@ LLVMProgram(
       , ParamUnnamed(PointerAddrSpace("1"), [])
       , ParamUnnamed(PointerAddrSpace("1"), [])
       ]
-    , [NoUnwind()]
+    , [NoUnwind(), GCLeafFunction()]
     )
   , FunDecl(
       DefaultLinkage()
     , DefaultCConv()
     , PointerAddrSpace("1")
     , Constant("record_read_ptr")
     , [ParamUnnamed(PointerAddrSpace("1"), []), ParamUnnamed(PointerAddrSpace("1"), [])]
-    , [NoUnwind()]
-    )
-  , FunDecl(
-      DefaultLinkage()
-    , DefaultCConv()
-    , Void()
-    , Constant("record_delete")
-    , [ParamUnnamed(PointerAddrSpace("1"), [])]
-    , [NoUnwind()]
+    , [NoUnwind(), GCLeafFunction()]
     )
   , FunDecl(
       DefaultLinkage()

lwb/metalang/llvm/llvm.spoofax2/tim_head.ll

@@ -1,6 +1,7 @@
 target triple = "x86_64-unknown-linux-gnu"
 @.int_fmt = private unnamed_addr constant [5 x i8] c"%ld\0A\00"
 @.str_fmt = private unnamed_addr constant [4 x i8] c"%s\0A\00"
+%.array_type = type {i64, [0 x i64]}
 module asm ".globl __LLVM_StackMaps"
 
 declare void @exit(i32) noreturn nounwind
@@ -10,11 +11,10 @@ declare i64 @strcmp(ptr, ptr) nounwind
 
 ; tim runtime library
 declare ptr addrspace(1) @record_new(i64, ...) nounwind
-declare void @record_write(ptr addrspace(1), ptr addrspace(1), i64) nounwind
-declare i64 @record_read(ptr addrspace(1), ptr addrspace(1)) nounwind
-declare void @record_write_ptr(ptr addrspace(1), ptr addrspace(1), ptr addrspace(1)) nounwind
-declare ptr addrspace(1) @record_read_ptr(ptr addrspace(1), ptr addrspace(1)) nounwind
-declare void @record_delete(ptr addrspace(1)) nounwind
+declare void @record_write(ptr addrspace(1), ptr addrspace(1), i64) nounwind "gc-leaf-function"="true"
+declare i64 @record_read(ptr addrspace(1), ptr addrspace(1)) nounwind "gc-leaf-function"="true"
+declare void @record_write_ptr(ptr addrspace(1), ptr addrspace(1), ptr addrspace(1)) nounwind "gc-leaf-function"="true"
+declare ptr addrspace(1) @record_read_ptr(ptr addrspace(1), ptr addrspace(1)) nounwind "gc-leaf-function"="true"
 
 declare ptr addrspace(1) @array_concat(ptr addrspace(1), ptr addrspace(1)) nounwind
 declare ptr addrspace(1) @array_tail(ptr addrspace(1)) nounwind

lwb/metalang/tim/tim.spoofax2/trans/compile/conclude.str

@@ -24,6 +24,10 @@ rules
     , Array("4", Int8())
     , String("\"%s\\0A\\00\"")
     )
+  , TypeDef(
+      Variable(".array_type")
+    , Struct([Int64(), Array("0", Int64())])
+    )
 // Garbage collection stack map
   , ModuleAsm("\".globl __LLVM_StackMaps\"")
 // Built in functions
@@ -78,15 +82,15 @@ rules
       , ParamUnnamed(PointerAddrSpace("1"), [])
       , ParamUnnamed(Int64(), [])
       ]
-    , [NoUnwind()]
+    , [NoUnwind(), GCLeafFunction()]
     )
   , FunDecl(
       DefaultLinkage()
     , DefaultCConv()
     , Int64()
     , Constant("record_read")
     , [ParamUnnamed(PointerAddrSpace("1"), []), ParamUnnamed(PointerAddrSpace("1"), [])]
-    , [NoUnwind()]
+    , [NoUnwind(), GCLeafFunction()]
     )
   , FunDecl(
       DefaultLinkage()
@@ -97,23 +101,15 @@ rules
       , ParamUnnamed(PointerAddrSpace("1"), [])
       , ParamUnnamed(PointerAddrSpace("1"), [])
       ]
-    , [NoUnwind()]
+    , [NoUnwind(), GCLeafFunction()]
     )
   , FunDecl(
       DefaultLinkage()
     , DefaultCConv()
     , PointerAddrSpace("1")
     , Constant("record_read_ptr")
     , [ParamUnnamed(PointerAddrSpace("1"), []), ParamUnnamed(PointerAddrSpace("1"), [])]
-    , [NoUnwind()]
-    )
-  , FunDecl(
-      DefaultLinkage()
-    , DefaultCConv()
-    , Void()
-    , Constant("record_delete")
-    , [ParamUnnamed(PointerAddrSpace("1"), [])]
-    , [NoUnwind()]
+    , [NoUnwind(), GCLeafFunction()]
     )
 // Arrays
   , FunDecl(
@@ -207,4 +203,4 @@ rules
         )
       ]
     )
-  ]
+  ]

lwb/metalang/tim/tim.spoofax2/trans/compile/select-instructions.str

@@ -69,10 +69,9 @@ rules
   where with(fail|"String comparison not yet implemented")  // TODO
 
   select-exp : TExpApp(x, args) ->
-    ( [ Expression(Call(DefaultTail(), TailCConv(), Void(), <select-value> x, <select-call-args> args, [], NoOperandBundles()))]
+    ( [ Expression(Call(MustTail(), TailCConv(), Void(), <select-value> x, <select-call-args> args, [], NoOperandBundles()))]
     , RetVoid()
     )
-    // TODO: restore tail calling
 
   select-exp = with(fail|$[unsupported exp])
 
@@ -187,22 +186,25 @@ rules
   ; i' := TypedAtom(Int64(), Literal(Int(<int-to-string> i)))
 
   select-primop(|result) : ("array-read", t, [arr, index]) ->
-    [ Assign(offset, GetElementPtr(Struct([Int64(), Array("0", <get-type> t)]), [<select-typed-value> arr, TypedAtom(Int32(), Literal(Int("0"))), TypedAtom(Int32(), Literal(Int("1"))), <select-typed-value> index]))
+    [ Assign(offset, GetElementPtr(VarType(Variable(".array_type")), [<select-typed-value> arr, TypedAtom(Int32(), Literal(Int("0"))), TypedAtom(Int32(), Literal(Int("1"))), <select-typed-value> index]))
     , Assign(result, Load(<get-type> t, TypedAtom(PointerAddrSpace("1"), VarAtom(offset))))
     ]
   with
     offset := Variable(<newname> "offset")
 
   select-primop(|result) : ("array-write", _, [arr, index, value]) ->
-    [ Assign(offset, GetElementPtr(Struct([Int64(), Array("0", <get-type> value)]), [<select-typed-value> arr, TypedAtom(Int32(), Literal(Int("0"))), TypedAtom(Int32(), Literal(Int("1"))), <select-typed-value> index]))
+    [ Assign(offset, GetElementPtr(VarType(Variable(".array_type")), [<select-typed-value> arr, TypedAtom(Int32(), Literal(Int("0"))), TypedAtom(Int32(), Literal(Int("1"))), <select-typed-value> index]))
     , Expression(Store(<select-typed-value> value, TypedAtom(PointerAddrSpace("1"), VarAtom(offset))))
     ]
   with
     offset := Variable(<newname> "offset")
 
   select-primop(|result) : ("array-length", _, [arr]) ->
-    [ Assign(result, Load(Int64(), <select-typed-value> arr))
+    [ Assign(offset, GetElementPtr(VarType(Variable(".array_type")), [<select-typed-value> arr, TypedAtom(Int32(), Literal(Int("0"))), TypedAtom(Int32(), Literal(Int("0")))]))
+    , Assign(result, Load(Int64(), TypedAtom(PointerAddrSpace("1"), VarAtom(offset))))
     ]
+  with
+    offset := Variable(<newname> "offset")
 
   select-funcall-primop : ("array-concat", t) -> ("array_concat", <get-type> t)
   select-funcall-primop : ("array-tail", t) -> ("array_tail", <get-type> t)