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

@@ -1,68 +1,8 @@
-platform "roc-lang/glue"
+interface Shape
-    requires {} { makeGlue : List Types -> Result (List File) Str }
+    exposes [Shape, RocNum, RocTagUnion, RocStructFields, RocFn, RocSingleTagPayload]
-    exposes []
+    imports [TypeId.{ TypeId }]
-    packages {}
-    imports []
-    provides [makeGlueForHost]
 
-makeGlueForHost : List Types -> Result (List File) Str
+Shape : [
-makeGlueForHost = \x -> makeGlue x
-
-File : { name : Str, content : Str }
-
-# TODO move into separate Target.roc interface once glue works across interfaces.
-Target : {
-    architecture : Architecture,
-    operatingSystem : OperatingSystem,
-}
-
-Architecture : [
-    Aarch32,
-    Aarch64,
-    Wasm32,
-    X86x32,
-    X86x64,
-]
-
-OperatingSystem : [
-    Windows,
-    Unix,
-    Wasi,
-]
-
-# TODO change this to an opaque type once glue supports abilities.
-TypeId : Nat
-#      has [
-#          Eq {
-#              isEq: isEqTypeId,
-#          },
-#          Hash {
-#              hash: hashTypeId,
-#          }
-#      ]
-# isEqTypeId = \@TypeId lhs, @TypeId rhs -> lhs == rhs
-# hashTypeId = \hasher, @TypeId id -> Hash.hash hasher id
-# 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 RocType,
-    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,
-}
-
-RocType : [
     RocStr,
     Bool,
     RocResult TypeId 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

crates/glue/src/RustGlue.roc

@@ -1,12 +1,14 @@
 app "rust-glue"
-    packages { pf: "RocType.roc" }
+    packages { pf: "../platform/main.roc" }
-    imports []
+    imports [pf.Types.{ Types }, pf.File.{ File }, pf.TypeId.{ TypeId }]
     provides [makeGlue] to pf
 
-makeGlue = \types ->
+makeGlue : List Types -> Result (List File) Str
+makeGlue = \typesByArch ->
     modFileContent =
-        List.walk types "" \content, { target } ->
+        List.walk typesByArch "" \content, types ->
-            archStr = archName target.architecture
+            arch = (Types.target types).architecture
+            archStr = archName arch 
 
             Str.concat
                 content
@@ -18,15 +20,15 @@ makeGlue = \types ->
                 
                 """
 
-    types
+    typesByArch
-    |> List.map typesWithDict
     |> List.map convertTypesToFile
     |> List.append { name: "mod.rs", content: modFileContent }
     |> Ok
 
+convertTypesToFile : Types -> File
 convertTypesToFile = \types ->
     content =
-        walkWithIndex types.types fileHeader \buf, id, type ->
+        Types.walkShapes types fileHeader \buf, type, id ->
             when type is
                 Struct { name, fields } ->
                     generateStruct buf types id name fields Public
@@ -84,13 +86,16 @@ convertTypesToFile = \types ->
                     # These types don't need to be declared in Rust.
                     # TODO: Eventually we want to generate roc_std. So these types will need to be emitted.
                     buf
-    archStr = archName types.target.architecture
+
+    arch = (Types.target types).architecture
+    archStr = archName arch 
 
     {
         name: "\(archStr).rs",
         content,
     }
 
+generateStruct : Str, Types, TypeId, _, _, _ -> Str
 generateStruct = \buf, types, id, name, structFields, visibility ->
     escapedName = escapeKW name
     repr =
@@ -108,7 +113,7 @@ generateStruct = \buf, types, id, name, structFields, visibility ->
             Public -> "pub"
             Private -> ""
 
-    structType = getType types id
+    structType = Types.shape types id
 
     buf
     |> generateDeriveStr types structType IncludeDebug
@@ -221,7 +226,7 @@ generateNonRecursiveTagUnion = \buf, types, id, name, tags, discriminantSize, di
         """
     |> Str.concat "// TODO: NonRecursive TagUnion constructor impls\n\n"
     |> \b ->
-        type = getType types id
+        type = Types.shape types id
         if cannotDeriveCopy types type then
             # A custom drop impl is only needed when we can't derive copy.
             b
@@ -285,7 +290,7 @@ generateTagUnionDropPayload = \buf, types, selfMut, tags, discriminantName, disc
         buf
         |> writeTagImpls tags discriminantName indents \name, payload ->
             when payload is
-                Some id if cannotDeriveCopy types (getType types id) ->
+                Some id if cannotDeriveCopy types (Types.shape types id) ->
                     "unsafe {{ core::mem::ManuallyDrop::drop(&mut \(selfMut).\(name)) }},"
 
                 _ ->
@@ -313,6 +318,7 @@ writeTagImpls = \buf, tags, discriminantName, indents, f ->
     |> writeIndents indents
     |> Str.concat "}\n"
 
+generateTagUnionSizer : Str, Types, TypeId, _ -> Str
 generateTagUnionSizer = \buf, types, id, tags ->
     if List.len tags > 1 then
         # When there's a discriminant (so, multiple tags) and there is
@@ -355,7 +361,7 @@ generateUnionField = \types ->
                 typeStr = typeName types id
                 escapedFieldName = escapeKW fieldName
 
-                type = getType types id
+                type = Types.shape types id
                 fullTypeStr =
                     if cannotDeriveCopy types type then
                         # types with pointers need ManuallyDrop
@@ -614,40 +620,40 @@ cannotDeriveCopy = \types, type ->
         Unit | Unsized | EmptyTagUnion | Bool | Num _ | TagUnion (Enumeration _) | Function _ -> Bool.false
         RocStr | RocList _ | RocDict _ _ | RocSet _ | RocBox _ | TagUnion (NullableUnwrapped _) | TagUnion (NullableWrapped _) | TagUnion (Recursive _) | TagUnion (NonNullableUnwrapped _) | RecursivePointer _ -> Bool.true
         TagUnion (SingleTagStruct { payload: HasNoClosure fields }) ->
-            List.any fields \{ id } -> cannotDeriveCopy types (getType types id)
+            List.any fields \{ id } -> cannotDeriveCopy types (Types.shape types id)
 
         TagUnion (SingleTagStruct { payload: HasClosure fields }) ->
-            List.any fields \{ id } -> cannotDeriveCopy types (getType types id)
+            List.any fields \{ id } -> cannotDeriveCopy types (Types.shape types id)
 
         TagUnion (NonRecursive { tags }) ->
             List.any tags \{ payload } ->
                 when payload is
-                    Some id -> cannotDeriveCopy types (getType types id)
+                    Some id -> cannotDeriveCopy types (Types.shape types id)
                     None -> Bool.false
 
         RocResult okId errId ->
-            cannotDeriveCopy types (getType types okId)
+            cannotDeriveCopy types (Types.shape types okId)
-            || cannotDeriveCopy types (getType types errId)
+            || cannotDeriveCopy types (Types.shape types errId)
 
         Struct { fields: HasNoClosure fields } | TagUnionPayload { fields: HasNoClosure fields } ->
-            List.any fields \{ id } -> cannotDeriveCopy types (getType types id)
+            List.any fields \{ id } -> cannotDeriveCopy types (Types.shape types id)
 
         Struct { fields: HasClosure fields } | TagUnionPayload { fields: HasClosure fields } ->
-            List.any fields \{ id } -> cannotDeriveCopy types (getType types id)
+            List.any fields \{ id } -> cannotDeriveCopy types (Types.shape types id)
 
 cannotDeriveDefault = \types, type ->
     when type is
         Unit | Unsized | EmptyTagUnion | TagUnion _ | RocResult _ _ | RecursivePointer _ | Function _ -> Bool.true
         RocStr | Bool | Num _ | Struct { fields: HasClosure _ } | TagUnionPayload { fields: HasClosure _ } -> Bool.false
         RocList id | RocSet id | RocBox id ->
-            cannotDeriveDefault types (getType types id)
+            cannotDeriveDefault types (Types.shape types id)
 
         RocDict keyId valId ->
-            cannotDeriveCopy types (getType types keyId)
+            cannotDeriveCopy types (Types.shape types keyId)
-            || cannotDeriveCopy types (getType types valId)
+            || cannotDeriveCopy types (Types.shape types valId)
 
         Struct { fields: HasNoClosure fields } | TagUnionPayload { fields: HasNoClosure fields } ->
-            List.any fields \{ id } -> cannotDeriveDefault types (getType types id)
+            List.any fields \{ id } -> cannotDeriveDefault types (Types.shape types id)
 
 hasFloat = \types, type ->
     hasFloatHelp types type (Set.empty {})
@@ -664,40 +670,40 @@ hasFloatHelp = \types, type, doNotRecurse ->
 
         Unit | Unsized | EmptyTagUnion | RocStr | Bool | TagUnion (Enumeration _) | Function _ -> Bool.false
         RocList id | RocSet id | RocBox id ->
-            hasFloatHelp types (getType types id) doNotRecurse
+            hasFloatHelp types (Types.shape types id) doNotRecurse
 
         RocDict id0 id1 | RocResult id0 id1 ->
-            hasFloatHelp types (getType types id0) doNotRecurse
+            hasFloatHelp types (Types.shape types id0) doNotRecurse
-            || hasFloatHelp types (getType types id1) doNotRecurse
+            || hasFloatHelp types (Types.shape types id1) doNotRecurse
 
         Struct { fields: HasNoClosure fields } | TagUnionPayload { fields: HasNoClosure fields } ->
-            List.any fields \{ id } -> hasFloatHelp types (getType types id) doNotRecurse
+            List.any fields \{ id } -> hasFloatHelp types (Types.shape types id) doNotRecurse
 
         Struct { fields: HasClosure fields } | TagUnionPayload { fields: HasClosure fields } ->
-            List.any fields \{ id } -> hasFloatHelp types (getType types id) doNotRecurse
+            List.any fields \{ id } -> hasFloatHelp types (Types.shape types id) doNotRecurse
 
         TagUnion (SingleTagStruct { payload: HasNoClosure fields }) ->
-            List.any fields \{ id } -> hasFloatHelp types (getType types id) doNotRecurse
+            List.any fields \{ id } -> hasFloatHelp types (Types.shape types id) doNotRecurse
 
         TagUnion (SingleTagStruct { payload: HasClosure fields }) ->
-            List.any fields \{ id } -> hasFloatHelp types (getType types id) doNotRecurse
+            List.any fields \{ id } -> hasFloatHelp types (Types.shape types id) doNotRecurse
 
         TagUnion (Recursive { tags }) ->
             List.any tags \{ payload } ->
                 when payload is
-                    Some id -> hasFloatHelp types (getType types id) doNotRecurse
+                    Some id -> hasFloatHelp types (Types.shape types id) doNotRecurse
                     None -> Bool.false
 
         TagUnion (NonRecursive { tags }) ->
             List.any tags \{ payload } ->
                 when payload is
-                    Some id -> hasFloatHelp types (getType types id) doNotRecurse
+                    Some id -> hasFloatHelp types (Types.shape types id) doNotRecurse
                     None -> Bool.false
 
         TagUnion (NullableWrapped { tags }) ->
             List.any tags \{ payload } ->
                 when payload is
-                    Some id -> hasFloatHelp types (getType types id) doNotRecurse
+                    Some id -> hasFloatHelp types (Types.shape types id) doNotRecurse
                     None -> Bool.false
 
         TagUnion (NonNullableUnwrapped { payload }) ->
@@ -706,7 +712,7 @@ hasFloatHelp = \types, type, doNotRecurse ->
             else
                 nextDoNotRecurse = Set.insert doNotRecurse payload
 
-                hasFloatHelp types (getType types payload) nextDoNotRecurse
+                hasFloatHelp types (Types.shape types payload) nextDoNotRecurse
 
         TagUnion (NullableUnwrapped { nonNullPayload }) ->
             if Set.contains doNotRecurse nonNullPayload then
@@ -714,7 +720,7 @@ hasFloatHelp = \types, type, doNotRecurse ->
             else
                 nextDoNotRecurse = Set.insert doNotRecurse nonNullPayload
 
-                hasFloatHelp types (getType types nonNullPayload) nextDoNotRecurse
+                hasFloatHelp types (Types.shape types nonNullPayload) nextDoNotRecurse
 
         RecursivePointer payload ->
             if Set.contains doNotRecurse payload then
@@ -722,10 +728,10 @@ hasFloatHelp = \types, type, doNotRecurse ->
             else
                 nextDoNotRecurse = Set.insert doNotRecurse payload
 
-                hasFloatHelp types (getType types payload) nextDoNotRecurse
+                hasFloatHelp types (Types.shape types payload) nextDoNotRecurse
 
 typeName = \types, id ->
-    when getType types id is
+    when Types.shape types id is
         Unit -> "()"
         Unsized -> "roc_std::RocList<u8>"
         EmptyTagUnion -> "std::convert::Infallible"
@@ -785,27 +791,12 @@ typeName = \types, id ->
         TagUnion (SingleTagStruct { name }) -> escapeKW name
         Function { functionName } -> escapeKW functionName
 
-getType = \types, id ->
-    when List.get types.types id is
-        Ok type -> type
-        Err _ -> crash "unreachable"
-
 getSizeRoundedToAlignment = \types, id ->
-    alignment = getAlignment types id
+    alignment = Types.alignment types id
 
-    getSizeIgnoringAlignment types id
+    Types.size types id
     |> roundUpToAlignment alignment
 
-getSizeIgnoringAlignment = \types, id ->
-    when List.get types.sizes id is
-        Ok size -> size
-        Err _ -> crash "unreachable"
-
-getAlignment = \types, id ->
-    when List.get types.aligns id is
-        Ok align -> align
-        Err _ -> crash "unreachable"
-
 roundUpToAlignment = \width, alignment ->
     when alignment is
         0 -> width
@@ -931,14 +922,3 @@ escapeKW = \input ->
         "r#\(input)"
     else
         input
-
-# This is a temporary helper until roc_std::roc_dict is update.
-# after that point, Dict will be passed in directly.
-typesWithDict = \{ types, sizes, aligns, typesByName, deps, target } -> {
-    types,
-    sizes,
-    aligns,
-    typesByName: Dict.fromList typesByName,
-    deps: Dict.fromList deps,
-    target,
-}