move RustGlue.roc closer to what we have on the ts branch

crates/glue/platform/File.roc

@@ -0,0 +1,5 @@
+interface File
+    exposes [File]
+    imports []
+
+File : { name : Str, content : Str }

crates/glue/platform/InternalTypeId.roc

@@ -0,0 +1,11 @@
+interface InternalTypeId
+    exposes [InternalTypeId, fromNat, toNat]
+    imports []
+
+InternalTypeId : Nat
+
+toNat : InternalTypeId -> Nat
+toNat = \x -> x
+
+fromNat : Nat -> InternalTypeId
+fromNat = \x -> x

crates/glue/platform/Shape.roc

@@ -0,0 +1,135 @@
+interface Shape
+    exposes [Shape, RocNum, RocTagUnion, RocStructFields, RocFn, RocSingleTagPayload]
+    imports [TypeId.{ TypeId }]
+
+Shape : [
+    RocStr,
+    Bool,
+    RocResult TypeId TypeId,
+    Num RocNum,
+    RocList TypeId,
+    RocDict TypeId TypeId,
+    RocSet TypeId,
+    RocBox TypeId,
+    TagUnion RocTagUnion,
+    EmptyTagUnion,
+    Struct
+        {
+            name : Str,
+            fields : RocStructFields,
+        },
+    TagUnionPayload
+        {
+            name : Str,
+            fields : RocStructFields,
+        },
+    ## A recursive pointer, e.g. in StrConsList : [Nil, Cons Str StrConsList],
+    ## this would be the field of Cons containing the (recursive) StrConsList type,
+    ## and the TypeId is the TypeId of StrConsList itself.
+    RecursivePointer TypeId,
+    Function RocFn,
+    # A zero-sized type, such as an empty record or a single-tag union with no payload
+    Unit,
+    Unsized,
+]
+
+RocNum : [
+    I8,
+    U8,
+    I16,
+    U16,
+    I32,
+    U32,
+    I64,
+    U64,
+    I128,
+    U128,
+    F32,
+    F64,
+    Dec,
+]
+
+RocTagUnion : [
+    Enumeration
+        {
+            name : Str,
+            tags : List Str,
+            size : U32,
+        },
+    ## A non-recursive tag union
+    ## e.g. `Result a e : [Ok a, Err e]`
+    NonRecursive
+        {
+            name : Str,
+            tags : List { name : Str, payload : [Some TypeId, None] },
+            discriminantSize : U32,
+            discriminantOffset : U32,
+        },
+    ## A recursive tag union (general case)
+    ## e.g. `Expr : [Sym Str, Add Expr Expr]`
+    Recursive
+        {
+            name : Str,
+            tags : List { name : Str, payload : [Some TypeId, None] },
+            discriminantSize : U32,
+            discriminantOffset : U32,
+        },
+    ## A recursive tag union that has an empty variant
+    ## Optimization: Represent the empty variant as null pointer => no memory usage & fast comparison
+    ## It has more than one other variant, so they need tag IDs (payloads are "wrapped")
+    ## e.g. `FingerTree a : [Empty, Single a, More (Some a) (FingerTree (Tuple a)) (Some a)]`
+    ## see also: https://youtu.be/ip92VMpf_-A?t=164
+    NullableWrapped
+        {
+            name : Str,
+            indexOfNullTag : U16,
+            tags : List { name : Str, payload : [Some TypeId, None] },
+            discriminantSize : U32,
+            discriminantOffset : U32,
+        },
+    ## Optimization: No need to store a tag ID (the payload is "unwrapped")
+    ## e.g. `RoseTree a : [Tree a (List (RoseTree a))]`
+    NonNullableUnwrapped
+        {
+            name : Str,
+            tagName : Str,
+            payload : TypeId, # These always have a payload.
+        },
+    ## Optimization: No need to store a tag ID (the payload is "unwrapped")
+    ## e.g. `[Foo Str Bool]`
+    SingleTagStruct
+        {
+            name : Str,
+            tagName : Str,
+            payload: RocSingleTagPayload,
+        },
+    ## A recursive tag union with only two variants, where one is empty.
+    ## Optimizations: Use null for the empty variant AND don't store a tag ID for the other variant.
+    ## e.g. `ConsList a : [Nil, Cons a (ConsList a)]`
+    NullableUnwrapped
+        {
+            name : Str,
+            nullTag : Str,
+            nonNullTag : Str,
+            nonNullPayload : TypeId,
+            whichTagIsNull : [FirstTagIsNull, SecondTagIsNull],
+        },
+]
+
+RocStructFields : [
+    HasNoClosure (List { name: Str, id: TypeId }),
+    HasClosure (List { name: Str, id: TypeId, accessors: { getter: Str } }),
+]
+
+RocSingleTagPayload: [
+    HasClosure (List { name: Str, id: TypeId }),
+    HasNoClosure (List { id: TypeId }),
+]
+
+RocFn : {
+    functionName: Str,
+    externName: Str,
+    args: List TypeId,
+    lambdaSet: TypeId,
+    ret: TypeId,
+}

crates/glue/platform/Target.roc

@@ -0,0 +1,22 @@
+interface Target
+    exposes [Target, Architecture, OperatingSystem]
+    imports []
+
+Target : {
+    architecture : Architecture,
+    operatingSystem : OperatingSystem,
+}
+
+Architecture : [
+    Aarch32,
+    Aarch64,
+    Wasm32,
+    X86x32,
+    X86x64,
+]
+
+OperatingSystem : [
+    Windows,
+    Unix,
+    Wasi,
+]

crates/glue/platform/TypeId.roc

@@ -0,0 +1,5 @@
+interface TypeId
+    exposes [TypeId]
+    imports [InternalTypeId.{ InternalTypeId }]
+
+TypeId : InternalTypeId

crates/glue/platform/Types.roc

@@ -0,0 +1,61 @@
+interface Types
+    exposes [Types, shape, size, alignment, target, walkShapes]
+    imports [Shape.{ Shape }, TypeId.{ TypeId }, Target.{ Target }, InternalTypeId]
+
+# TODO: switch AssocList uses to Dict once roc_std is updated.
+Tuple1 : [T Str TypeId]
+Tuple2 : [T TypeId (List TypeId)]
+
+Types := {
+    # These are all indexed by TypeId
+    types : List Shape,
+    sizes : List U32,
+    aligns : List U32,
+
+    # Needed to check for duplicates
+    typesByName : List Tuple1,
+
+    ## Dependencies - that is, which type depends on which other type.
+    ## This is important for declaration order in C; we need to output a
+    ## type declaration earlier in the file than where it gets referenced by another type.
+    deps : List Tuple2,
+    target : Target,
+}
+
+target : Types -> Target
+target = \@Types types -> types.target
+
+walkShapes : Types, state, (state, Shape, TypeId -> state) -> state
+walkShapes = \@Types { types: shapes }, originalState, update ->
+    List.walk shapes { index: 0, state: originalState } \{ index, state }, elem ->
+        id = InternalTypeId.fromNat index
+
+        { index: index + 1, state: update state elem id }
+    |> .state
+
+shape : Types, TypeId -> Shape
+shape = \@Types types, id ->
+    when List.get types.types (InternalTypeId.toNat id) is
+        Ok answer -> answer
+        Err OutOfBounds ->
+            idStr = Num.toStr (InternalTypeId.toNat id)
+
+            crash "TypeId #\(idStr) was not found in Types. This should never happen, and means there was a bug in `roc glue`. If you have time, please open an issue at <https://github.com/roc-lang/roc/issues>"
+
+alignment : Types, TypeId -> U32
+alignment = \@Types types, id ->
+    when List.get types.aligns (InternalTypeId.toNat id) is
+        Ok answer -> answer
+        Err OutOfBounds ->
+            idStr = Num.toStr (InternalTypeId.toNat id)
+
+            crash "TypeId #\(idStr) was not found in Types. This should never happen, and means there was a bug in `roc glue`. If you have time, please open an issue at <https://github.com/roc-lang/roc/issues>"
+
+size : Types, TypeId -> U32
+size = \@Types types, id ->
+    when List.get types.sizes (InternalTypeId.toNat id) is
+        Ok answer -> answer
+        Err OutOfBounds ->
+            idStr = Num.toStr (InternalTypeId.toNat id)
+
+            crash "TypeId #\(idStr) was not found in Types. This should never happen, and means there was a bug in `roc glue`. If you have time, please open an issue at <https://github.com/roc-lang/roc/issues>"

crates/glue/platform/main.roc

@@ -0,0 +1,9 @@
+platform "roc-lang/glue"
+    requires {} { makeGlue : List Types -> Result (List File) Str }
+    exposes [Shape, File, Types, TypeId, Target]
+    packages {}
+    imports [Types.{ Types }, File.{ File }]
+    provides [makeGlueForHost]
+
+makeGlueForHost : List Types -> Result (List File) Str
+makeGlueForHost = \types -> makeGlue types