VM constructors matches the order in the declared type.

Fixes #79

daedalus-core/src/Daedalus/Core/Basics.hs

@@ -34,7 +34,7 @@ data TName = TName
   deriving (Generic, NFData)
 
 -- | What "flavor of type" we have
-data TFlav = TFlavStruct
+data TFlav = TFlavStruct [Label]     -- ^ A struct with fields in this order
            | TFlavEnum  [Label]      -- ^ A sum type with no data
            | TFlavUnion [Label]      -- ^ A sum type with data
            deriving (Generic, NFData)

daedalus-core/src/Daedalus/Core/Expr.hs

@@ -20,6 +20,8 @@ data Expr =
     Var Name
   | PureLet Name Expr Expr
   | Struct UserType [ (Label, Expr) ]
+    -- The order of these need NOT match the declaration
+
   | ECase (Case Expr)
 
   | Ap0 Op0

daedalus-vm/src/Daedalus/VM/Compile/Expr.hs

@@ -59,8 +59,14 @@ compileE expr k =
               b
 
     Src.Struct t fs ->
+      let labs = case Src.tnameFlav (Src.utName t) of
+                   Src.TFlavStruct ls -> ls
+                   _ -> panic "compileE" ["Not TStructFlav"]
+      in
       compileEs (map snd fs) \vs ->
-         do s <- stmt ty (\x -> CallPrim x (StructCon t) vs)
+         do let mp = Map.fromList (zip (map fst fs) vs)
+                args = [ mp Map.! l | l <- labs ]
+            s <- stmt ty (\x -> CallPrim x (StructCon t) args)
             continue k s
 
     Src.ECase (Src.Case x as) -> compileCase (Src.typeOf expr) x as k

src/Daedalus/DDL2Core.hs

@@ -1671,7 +1671,7 @@ newTNameRec rec =
   doOne r d =
     let bd = isJust (TC.tctyBD d)
         flavor = case TC.tctyDef d of
-                   TC.TCTyStruct {} -> TFlavStruct
+                   TC.TCTyStruct _ fs -> TFlavStruct (map fst fs)
                    TC.TCTyUnion cs
                      | all (\(_, (t, _)) -> t == TC.tUnit) cs -> TFlavEnum (map fst cs)
                      | otherwise -> TFlavUnion (map fst cs)

talos/src/Talos/Analysis.hs

@@ -241,7 +241,7 @@ caseIsTotal (Case e alts)
     hasDefault = any ((==) PAny . fst) alts
 
     nLabels ut = case tnameFlav (utName ut) of
-      TFlavStruct   -> panic "Unexpected struct" []
+      TFlavStruct {} -> panic "Unexpected struct" []
       TFlavUnion ls -> length ls
       TFlavEnum  ls -> length ls
 

tests/T077.ddl

@@ -0,0 +1,9 @@
+def P =
+  block
+    a = 'x'
+    b = Many UInt8
+
+def Main : P =
+  block
+    b = "bb"
+    a = 'a'

tests/T077.ddl.stdout

@@ -0,0 +1,28 @@
+module T077
+
+--- Imports:
+
+--- Type defs:
+type T077.P = { a: uint 8
+              ; b: [uint 8]
+              }
+
+--- Rules:
+
+T077.P : Grammar T077.P =
+  do (a : uint 8) <- pure 'x'
+     (b : [uint 8]) <- Many[] Match UInt8
+     pure {a = a,
+           b = b}
+
+T077.Main : Grammar T077.P =
+  do (b : [uint 8]) <- pure "bb"
+     (a : uint 8) <- pure 'a'
+     pure {b = b,
+           a = a}
+
+T077.P_ : Grammar {} =
+  @Many[] @Match UInt8
+
+T077.Main_ : Grammar {} =
+  pure {}

tests/T077.test

@@ -0,0 +1,3 @@
+dump
+--vm
+T077.ddl

tests/T077.test.stdout

@@ -0,0 +1,16 @@
+module DaedalusMain where
+
+
+type P =
+  struct
+    a : Word 8
+    b : [Word 8]
+
+.function Main
+  .root
+  .entry L_0_Main9
+  L_0_Main9(ra0o : Input): /* normal block */
+    r0 = "bb"()
+    r1 = newStruct @P(97 @(Word 8), r0)
+    popDebug
+    return(r1, ra0o)