<div dir="ltr">I took a stab at this but ran into something I don't understand. For recence, the whole implementation of unboxed sums is at <a href="https://github.com/ghc/ghc/compare/master...tibbe:unboxed-sums">https://github.com/ghc/ghc/compare/master...tibbe:unboxed-sums</a> and the implementation of unarisation is at <a href="https://github.com/ghc/ghc/compare/master...tibbe:unboxed-sums#diff-f5bc1f9e9c230db4cf882bf18368a818">https://github.com/ghc/ghc/compare/master...tibbe:unboxed-sums#diff-f5bc1f9e9c230db4cf882bf18368a818</a>.<div><br></div><div>Running the compiler on the following file:</div><div><br></div><div><div><font face="monospace, monospace">{-# LANGUAGE UnboxedSums #-}</font></div><div><font face="monospace, monospace">module Test where</font></div><div><font face="monospace, monospace"><br></font></div><div><font face="monospace, monospace">f :: (# Int | Char #) -> Int</font></div><div><font face="monospace, monospace">f (# x | #) = x</font></div><div><font face="monospace, monospace">{-# NOINLINE f #-}</font></div><div><font face="monospace, monospace"><br></font></div><div><font face="monospace, monospace">g = f (# 1 | #)</font></div></div><div><br></div><div>Yields an error, like so:</div><div><br></div><div><div><font face="monospace, monospace">ghc-stage2: panic! (the 'impossible' happened)</font></div><div><font face="monospace, monospace">  (GHC version 7.11.20150912 for x86_64-apple-darwin):</font></div><div><font face="monospace, monospace"><span class="" style="white-space:pre">   </span>StgCmmEnv: variable not found</font></div><div><font face="monospace, monospace">  ds_svq</font></div><div><font face="monospace, monospace">  local binds for:</font></div><div><font face="monospace, monospace">  ds_gvz</font></div><div><font face="monospace, monospace">  ds_gvA</font></div></div><div><br></div><div>I probably got something wrong in UnariseStg, but I can't see what. I printed this debug information to see the stg I'm rewriting:</div><div><br></div><div><div><font face="monospace, monospace">unarise</font></div><div><font face="monospace, monospace">  [f [InlPrag=NOINLINE] :: (#|#) Int Char -> Int</font></div><div><font face="monospace, monospace">   [GblId, Arity=1, Str=DmdType, Unf=OtherCon []] =</font></div><div><font face="monospace, monospace">       \r srt:SRT:[0e :-> patError] [ds_svq]</font></div><div><font face="monospace, monospace">           case ds_svq of _ [Occ=Dead] {</font></div><div><font face="monospace, monospace">             (#_|#) x_svs [Occ=Once] -> x_svs;</font></div><div><font face="monospace, monospace">             (#|_#) _ [Occ=Dead] -> patError "UnboxedSum.hs:5:1-15|function f"#;</font></div><div><font face="monospace, monospace">           };,</font></div><div><font face="monospace, monospace">   g :: Int</font></div><div><font face="monospace, monospace">   [GblId, Str=DmdType] =</font></div><div><font face="monospace, monospace">       \u srt:SRT:[r1 :-> f] []</font></div><div><font face="monospace, monospace">           let {</font></div><div><font face="monospace, monospace">             sat_svu [Occ=Once] :: Int</font></div><div><font face="monospace, monospace">             [LclId, Str=DmdType] =</font></div><div><font face="monospace, monospace">                 NO_CCS I#! [1#];</font></div><div><font face="monospace, monospace">           } in </font></div><div><font face="monospace, monospace">             case (#_|#) [sat_svu] of sat_svv { __DEFAULT -> f sat_svv; };]</font></div><div><font face="monospace, monospace">unariseAlts</font></div><div><font face="monospace, monospace">  [81 :-> [realWorld#], svq :-> [ds_gvz, ds_gvA]]</font></div><div><font face="monospace, monospace">  UbxTup 2</font></div><div><font face="monospace, monospace">  wild_svr</font></div><div><font face="monospace, monospace">  [((#_|#), [x_svs], [True], x_svs),</font></div><div><font face="monospace, monospace">   ((#|_#),</font></div><div><font face="monospace, monospace">    [ipv_svt],</font></div><div><font face="monospace, monospace">    [False],</font></div><div><font face="monospace, monospace">    patError "UnboxedSum.hs:5:1-15|function f"#)]</font></div></div><div><br></div><div>It's ds_svg that's being complained about above. I find that a bit confusing as that variable is never used on any RHS.</div><div><br></div><div>Some questions that might help me get there:</div><div><ul><li>I added a new RepType for unboxed sums, like so:<br><br>data RepType = UbxTupleRep [UnaryType]<br>    | UbxSumRep [UnaryType]<br>    | UnaryRep UnaryType<br><br>Does this constructor make sense? I store the already flattened representation of the sum in here, rather than having something like [[UnaryType]] and storing each alternative.</li><li>In unariseAlts there's a bndr argument. Is that the binder of the scrutinee as a whole (e.g. the 'x' in case e of x { ... -> ... })?</li></ul></div><div>Any other idea what I might have gotten wrong?</div><div><br></div></div><div class="gmail_extra"><br><div class="gmail_quote">On Mon, Sep 14, 2015 at 1:03 AM, Simon Marlow <span dir="ltr"><<a href="mailto:marlowsd@gmail.com" target="_blank">marlowsd@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><span class="">On 10/09/2015 10:37, Simon Peyton Jones wrote:<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
The problem is that stg is too strongly typed<br>
<br>
It’s not really typed, or at least only in a very half-hearted way.  To<br>
be concrete I think you can just use Any for any Pointer arg.   All STG<br>
needs to know, really, is which things are pointers.  Detailed type info<br>
like “are you a Char or a Bool” is strictly jam; indeed never used I<br>
think.  (I could be wrong but I’m pretty sure I’m not wrong in a<br>
fundamental way.<br>
</blockquote>
<br></span>
Yes, the only thing the code generator needs to do with types is convert them to PrimReps (see idPrimRep), and all GC pointer types have the same PrimRep (PtrRep).<br>
<br>
Cheers<br>
Simon<br>
<br>
<br>
<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
<br>
SImon<br>
<br>
*From:*Johan Tibell [mailto:<a href="mailto:johan.tibell@gmail.com" target="_blank">johan.tibell@gmail.com</a>]<br>
*Sent:* 09 September 2015 23:22<br>
*To:* Simon Peyton Jones; Simon Marlow; <a href="mailto:ghc-devs@haskell.org" target="_blank">ghc-devs@haskell.org</a><br>
*Subject:* Converting unboxed sum types in StgCmm<span class=""><br>
<br>
Hi!<br>
<br>
The original idea for implementing the backend part of the unboxed sums<br>
proposal was to convert from the core representation to the actual data<br>
representation (i.e. a tag followed by some pointer and non-pointer<br>
fields) in the unarise stg-to-stg<br></span>
<<a href="https://na01.safelinks.protection.outlook.com/?url=https%3a%2f%2fgithub.com%2fghc%2fghc%2fblob%2fmaster%2fcompiler%2fsimplStg%2fUnariseStg.hs&data=01%7c01%7csimonpj%40064d.mgd.microsoft.com%7cca7beffb01494517d75108d2b9652973%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdata=U%2bFUNsL87iEemajTnAW9SxD9N5b4%2bG8QB1q19%2fX%2bBI4%3d" rel="noreferrer" target="_blank">https://na01.safelinks.protection.outlook.com/?url=https%3a%2f%2fgithub.com%2fghc%2fghc%2fblob%2fmaster%2fcompiler%2fsimplStg%2fUnariseStg.hs&data=01%7c01%7csimonpj%40064d.mgd.microsoft.com%7cca7beffb01494517d75108d2b9652973%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdata=U%2bFUNsL87iEemajTnAW9SxD9N5b4%2bG8QB1q19%2fX%2bBI4%3d</a>><span class=""><br>
pass.<br>
<br>
I have now realized that this won't work. The problem is that stg is too<br>
strongly typed. When we "desugar" sum types we need to convert functions<br>
receiving a value e.g. from<br>
<br>
     f :: (# Bool | Char #) -> ...<br>
<br>
to<br>
<br>
     f :: NonPointer {-# tag#-} -> Pointer {-# Bool or Char #-} -> ...<br>
<br>
Since stg is still typed with normal Haskell types (e.g. Bool, Char,<br>
etc), this is not possible, as we cannot represent an argument which has<br>
two different types.<br>
<br>
It seems to me that we will have to do the conversion in the stg-to-cmm<br></span>
<<a href="https://na01.safelinks.protection.outlook.com/?url=https%3a%2f%2fgithub.com%2fghc%2fghc%2fblob%2fmaster%2fcompiler%2fcodeGen%2fStgCmm.hs&data=01%7c01%7csimonpj%40064d.mgd.microsoft.com%7cca7beffb01494517d75108d2b9652973%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdata=aXKZ78eGNKbJ6eZkxZgyJHgsAXpgOBjg3Zvqj%2bq7pk0%3d" rel="noreferrer" target="_blank">https://na01.safelinks.protection.outlook.com/?url=https%3a%2f%2fgithub.com%2fghc%2fghc%2fblob%2fmaster%2fcompiler%2fcodeGen%2fStgCmm.hs&data=01%7c01%7csimonpj%40064d.mgd.microsoft.com%7cca7beffb01494517d75108d2b9652973%7c72f988bf86f141af91ab2d7cd011db47%7c1&sdata=aXKZ78eGNKbJ6eZkxZgyJHgsAXpgOBjg3Zvqj%2bq7pk0%3d</a>><span class=""><br>
pass, which is quite a bit more involved. For example, StgCmmEnv.idToReg<br>
function will have to change from<br>
<br>
     idToReg :: DynFlags -> NonVoid Id -> LocalReg<br>
<br>
to<br>
<br>
     idToReg :: DynFlags -> NonVoid Id -> [LocalReg]<br>
<br>
to accommodate the fact that we might need more than one register to<br>
store a binder.<br>
<br>
Any ideas for a better solution?<br>
<br>
-- Johan<br>
<br>
</span></blockquote>
</blockquote></div><br></div>