Compile: Better names for struct fields

1 files changed, 31 insertions, 28 deletions

diff --git a/src/Compile.hs b/src/Compile.hs
index 53269d6..037b0d8 100644
--- a/src/Compile.hs
+++ b/src/Compile.hs
@@ -209,24 +209,27 @@ genStructName = \t -> "ty_" ++ gen t where
     TBool -> "b"
   gen (TAccum t) = 'C' : gen t
 
+-- | This function generates the actual struct declarations for each of the
+-- types in our language. It thus implicitly "documents" the layout of the
+-- types in the C translation.
 genStruct :: String -> Ty -> [StructDecl]
 genStruct name topty = case topty of
   TNil ->
     [StructDecl name "" com]
   TPair a b ->
     [StructDecl name (repTy a ++ " a; " ++ repTy b ++ " b;") com]
-  TEither a b ->  -- 0 -> a, 1 -> b
-    [StructDecl name ("uint8_t tag; union { " ++ repTy a ++ " a; " ++ repTy b ++ " b; };") com]
+  TEither a b ->  -- 0 -> l, 1 -> r
+    [StructDecl name ("uint8_t tag; union { " ++ repTy a ++ " l; " ++ repTy b ++ " r; };") com]
   TMaybe t ->  -- 0 -> nothing, 1 -> just
-    [StructDecl name ("uint8_t tag; " ++ repTy t ++ " a;") com]
+    [StructDecl name ("uint8_t tag; " ++ repTy t ++ " j;") com]
   TArr n t ->
     -- The buffer is trailed by a VLA for the actual array data.
-    [StructDecl (name ++ "_buf") ("size_t sh[" ++ show (fromNat n) ++ "]; size_t refc; " ++ repTy t ++ " a[];") ""
+    [StructDecl (name ++ "_buf") ("size_t sh[" ++ show (fromNat n) ++ "]; size_t refc; " ++ repTy t ++ " xs[];") ""
     ,StructDecl name (name ++ "_buf *buf;") com]
   TScal _ ->
     []
   TAccum t ->
-    [StructDecl name (repTy t ++ " a;") com]
+    [StructDecl name (repTy t ++ " ac;") com]
   where
     com = ppTy 0 topty
 
@@ -523,12 +526,12 @@ compile' env = \case
   EInl _ t e -> do
     name <- emitStruct (STEither (typeOf e) t)
     e1 <- compile' env e
-    return $ CEStruct name [("tag", CELit "0"), ("a", e1)]
+    return $ CEStruct name [("tag", CELit "0"), ("l", e1)]
 
   EInr _ t e -> do
     name <- emitStruct (STEither t (typeOf e))
     e2 <- compile' env e
-    return $ CEStruct name [("tag", CELit "1"), ("b", e2)]
+    return $ CEStruct name [("tag", CELit "1"), ("r", e2)]
 
   ECase _ (EOp _ OIf e) a b -> do
     e1 <- compile' env e
@@ -546,10 +549,10 @@ compile' env = \case
     e1 <- compile' env e
     var <- genName
     -- I know those are not variable names, but it's fine, probably
-    (e2, stmts2) <- scope $ compile' (Const (var ++ ".a") `SCons` env) a
-    (e3, stmts3) <- scope $ compile' (Const (var ++ ".b") `SCons` env) b
-    ((), stmtsRel1) <- scope $ incrementVarAlways Decrement t1 (var ++ ".a")
-    ((), stmtsRel2) <- scope $ incrementVarAlways Decrement t2 (var ++ ".b")
+    (e2, stmts2) <- scope $ compile' (Const (var ++ ".l") `SCons` env) a
+    (e3, stmts3) <- scope $ compile' (Const (var ++ ".r") `SCons` env) b
+    ((), stmtsRel1) <- scope $ incrementVarAlways Decrement t1 (var ++ ".l")
+    ((), stmtsRel2) <- scope $ incrementVarAlways Decrement t2 (var ++ ".r")
     retvar <- genName
     emit $ SVarDeclUninit (repSTy (typeOf a)) retvar
     emit $ SBlock (pure (SVarDecl True (repSTy (typeOf e)) var e1)
@@ -569,15 +572,15 @@ compile' env = \case
   EJust _ e -> do
     name <- emitStruct (STMaybe (typeOf e))
     e1 <- compile' env e
-    return $ CEStruct name [("tag", CELit "1"), ("a", e1)]
+    return $ CEStruct name [("tag", CELit "1"), ("j", e1)]
 
   EMaybe _ a b e -> do
     let STMaybe t = typeOf e
     e1 <- compile' env e
     var <- genName
     (e2, stmts2) <- scope $ compile' env a
-    (e3, stmts3) <- scope $ compile' (Const (var ++ ".a") `SCons` env) b
-    ((), stmtsRel) <- scope $ incrementVarAlways Decrement t (var ++ ".a")
+    (e3, stmts3) <- scope $ compile' (Const (var ++ ".j") `SCons` env) b
+    ((), stmtsRel) <- scope $ incrementVarAlways Decrement t (var ++ ".j")
     retvar <- genName
     emit $ SVarDeclUninit (repSTy (typeOf a)) retvar
     emit $ SBlock (pure (SVarDecl True (repSTy (typeOf e)) var e1)
@@ -597,7 +600,7 @@ compile' env = \case
     -- where something happens
     emitTLD $ "static " ++ strname ++ "_buf " ++ tldname ++ " = " ++
               "(" ++ strname ++ "_buf){.sh = {" ++ intercalate "," (map show (shapeToList sh)) ++ "}, " ++
-              ".refc = (size_t)1<<63, .a = {" ++ intercalate "," (map (compileScal False t) (toList vec)) ++ "}};"
+              ".refc = (size_t)1<<63, .xs = {" ++ intercalate "," (map (compileScal False t) (toList vec)) ++ "}};"
     return (CEStruct strname [("buf", CEAddrOf (CELit tldname))])
 
   EBuild _ n esh efun -> do
@@ -621,7 +624,7 @@ compile' env = \case
            (pure (SVarDecl True (repSTy (typeOf esh)) idxargname
                            (shapeTupFromLitVars n ivars))
             <> BList funstmts
-            <> pure (SAsg (arrname ++ ".buf->a[" ++ linivar ++ "++]") funretval))
+            <> pure (SAsg (arrname ++ ".buf->xs[" ++ linivar ++ "++]") funretval))
 
     return (CELit arrname)
 
@@ -652,8 +655,8 @@ compile' env = \case
              -- we have ScalIsNumeric, so it has 0 and (+) in C
              [SVarDecl False (repSTy t) accvar (CELit "0")
              ,SLoop (repSTy tIx) jvar (CELit "0") (CELit lenname) $
-                pure $ SVerbatim $ accvar ++ " += " ++ argname ++ ".buf->a[" ++ lenname ++ " * " ++ ivar ++ " + " ++ jvar ++ "];"
-             ,SAsg (resname ++ ".buf->a[" ++ ivar ++ "]") (CELit accvar)]
+                pure $ SVerbatim $ accvar ++ " += " ++ argname ++ ".buf->xs[" ++ lenname ++ " * " ++ ivar ++ " + " ++ jvar ++ "];"
+             ,SAsg (resname ++ ".buf->xs[" ++ ivar ++ "]") (CELit accvar)]
 
     return (CELit resname)
 
@@ -665,7 +668,7 @@ compile' env = \case
     emit $ SVarDecl True strname name (CEStruct strname
                   [("buf", CECall "malloc" [CELit (show (8 + sizeofSTy (typeOf e)))])])
     emit $ SAsg (name ++ ".buf->refc") (CELit "1")
-    emit $ SAsg (name ++ ".buf->a[0]") e'
+    emit $ SAsg (name ++ ".buf->xs[0]") e'
     return (CELit name)
 
   EReplicate1Inner _ elen earg -> do
@@ -687,8 +690,8 @@ compile' env = \case
     jvar <- genName' "j"
     emit $ SLoop (repSTy tIx) ivar (CELit "0") (CELit shszname) $
              pure $ SLoop (repSTy tIx) jvar (CELit "0") (CELit lenname) $
-               pure $ SAsg (resname ++ ".buf->a[" ++ ivar ++ " * " ++ lenname ++ " + " ++ jvar ++ "]")
-                           (CELit (argname ++ ".buf->a[" ++ ivar ++ "]"))
+               pure $ SAsg (resname ++ ".buf->xs[" ++ ivar ++ " * " ++ lenname ++ " + " ++ jvar ++ "]")
+                           (CELit (argname ++ ".buf->xs[" ++ ivar ++ "]"))
 
     return (CELit resname)
 
@@ -705,7 +708,7 @@ compile' env = \case
     emit $ SVarDecl True (repSTy (STArr SZ t)) arrname e'
     name <- genName
     emit $ SVarDecl True (repSTy t) name
-              (CEIndex (CEPtrProj (CEProj (CELit arrname) "buf") "a") (CELit "0"))
+              (CEIndex (CEPtrProj (CEProj (CELit arrname) "buf") "xs") (CELit "0"))
     incrementVarAlways Decrement (STArr SZ t) arrname
     return (CELit name)
 
@@ -718,7 +721,7 @@ compile' env = \case
     emit . SVarDecl True (repSTy (typeOf earr)) arrname =<< compile' env earr
     when (fromSNat n > 0) $ emit . SVarDecl True (repSTy (typeOf eidx)) idxname =<< compile' env eidx
     resname <- genName' "ixres"
-    emit $ SVarDecl True (repSTy t) resname (CEIndex (CELit (arrname ++ ".buf->a")) (toLinearIdx n arrname idxname))
+    emit $ SVarDecl True (repSTy t) resname (CEIndex (CELit (arrname ++ ".buf->xs")) (toLinearIdx n arrname idxname))
     incrementVarAlways Decrement (STArr n t) arrname
     return (CELit resname)
 
@@ -803,8 +806,8 @@ makeArrayTree :: STy a -> ArrayTree
 makeArrayTree STNil = ATNoop
 makeArrayTree (STPair a b) = smartATBoth (smartATProj "a" (makeArrayTree a))
                                          (smartATProj "b" (makeArrayTree b))
-makeArrayTree (STEither a b) = smartATCondTag (smartATProj "a" (makeArrayTree a))
-                                              (smartATProj "b" (makeArrayTree b))
+makeArrayTree (STEither a b) = smartATCondTag (smartATProj "l" (makeArrayTree a))
+                                              (smartATProj "r" (makeArrayTree b))
 makeArrayTree (STMaybe t) = smartATCondTag ATNoop (makeArrayTree t)
 makeArrayTree (STArr _ _) = ATArray
 makeArrayTree (STScal _) = ATNoop
@@ -973,12 +976,12 @@ compileExtremum nameBase opName operator env e = do
   redvar <- genName' "red"  -- use "red", not "acc", to avoid confusion with accumulators
   emit $ SLoop (repSTy tIx) ivar (CELit "0") (CELit shszname) $ BList
            -- we have ScalIsNumeric, so it has 1 and (<) etc. in C
-           [SVarDecl False (repSTy t) redvar (CELit (argname ++ ".buf->a[" ++ lenname ++ " * " ++ ivar ++ "]"))
+           [SVarDecl False (repSTy t) redvar (CELit (argname ++ ".buf->xs[" ++ lenname ++ " * " ++ ivar ++ "]"))
            ,SLoop (repSTy tIx) jvar (CELit "1") (CELit lenname) $ BList
-              [SVarDecl True (repSTy t) xvar (CELit (argname ++ ".buf->a[" ++ lenname ++ " * " ++ ivar ++ " + " ++ jvar ++ "]"))
+              [SVarDecl True (repSTy t) xvar (CELit (argname ++ ".buf->xs[" ++ lenname ++ " * " ++ ivar ++ " + " ++ jvar ++ "]"))
               ,SAsg redvar $ CEIf (CEBinop (CELit xvar) operator (CELit redvar)) (CELit xvar) (CELit redvar)
               ]
-           ,SAsg (resname ++ ".buf->a[" ++ ivar ++ "]") (CELit redvar)]
+           ,SAsg (resname ++ ".buf->xs[" ++ ivar ++ "]") (CELit redvar)]
 
   return (CELit resname)