comments in CASM output

src/Juvix/Compiler/Casm/Extra/Base.hs

@@ -14,35 +14,43 @@ adjustAp idx mr@MemRef {..} = case _memRefReg of
   Ap -> MemRef Ap (_memRefOff - idx)
   Fp -> mr
 
-mkAssign :: MemRef -> RValue -> Instruction
-mkAssign mr rv =
+mkAssign' :: Maybe Text -> MemRef -> RValue -> Instruction
+mkAssign' comment mr rv =
   Assign
     InstrAssign
       { _instrAssignResult = mr,
         _instrAssignValue = rv,
-        _instrAssignIncAp = False
+        _instrAssignIncAp = False,
+        _instrAssignComment = comment
       }
 
-mkAssignAp :: RValue -> Instruction
-mkAssignAp v =
+mkAssign :: MemRef -> RValue -> Instruction
+mkAssign = mkAssign' Nothing
+
+mkAssignAp' :: Maybe Text -> RValue -> Instruction
+mkAssignAp' comment v =
   Assign
     InstrAssign
       { _instrAssignResult = MemRef Ap 0,
         _instrAssignValue = v,
-        _instrAssignIncAp = True
+        _instrAssignIncAp = True,
+        _instrAssignComment = comment
       }
 
+mkAssignAp :: RValue -> Instruction
+mkAssignAp = mkAssignAp' Nothing
+
 mkCallRel :: Value -> Instruction
-mkCallRel tgt = Call (InstrCall tgt True)
+mkCallRel tgt = Call (InstrCall tgt True Nothing)
 
 mkCallAbs :: Value -> Instruction
-mkCallAbs tgt = Call (InstrCall tgt False)
+mkCallAbs tgt = Call (InstrCall tgt False Nothing)
 
 mkJumpAbs :: RValue -> Instruction
-mkJumpAbs tgt = Jump (InstrJump tgt False False)
+mkJumpAbs tgt = Jump (InstrJump tgt False False Nothing)
 
 mkJumpIf :: Value -> MemRef -> Instruction
-mkJumpIf tgt v = JumpIf (InstrJumpIf tgt v False)
+mkJumpIf tgt v = JumpIf (InstrJumpIf tgt v False Nothing)
 
 mkJumpRel :: RValue -> Instruction
-mkJumpRel tgt = Jump (InstrJump tgt True False)
+mkJumpRel tgt = Jump (InstrJump tgt True False Nothing)

src/Juvix/Compiler/Casm/Language.hs

@@ -99,34 +99,39 @@ data Instruction
 data InstrAssign = InstrAssign
   { _instrAssignValue :: RValue,
     _instrAssignResult :: MemRef,
-    _instrAssignIncAp :: Bool
+    _instrAssignIncAp :: Bool,
+    _instrAssignComment :: Maybe Text
   }
 
 data InstrExtraBinop = InstrExtraBinop
   { _instrExtraBinopArg1 :: MemRef,
     _instrExtraBinopArg2 :: Value,
     _instrExtraBinopResult :: MemRef,
     _instrExtraBinopOpcode :: ExtraOpcode,
-    _instrExtraBinopIncAp :: Bool
+    _instrExtraBinopIncAp :: Bool,
+    _instrExtraBinopComment :: Maybe Text
   }
 
 data InstrJump = InstrJump
   { _instrJumpTarget :: RValue,
     _instrJumpRel :: Bool,
-    _instrJumpIncAp :: Bool
+    _instrJumpIncAp :: Bool,
+    _instrJumpComment :: Maybe Text
   }
 
 -- | Jump if value is nonzero. Boolean true is translated to zero, false to
 -- non-zero.
 data InstrJumpIf = InstrJumpIf
   { _instrJumpIfTarget :: Value,
     _instrJumpIfValue :: MemRef,
-    _instrJumpIfIncAp :: Bool
+    _instrJumpIfIncAp :: Bool,
+    _instrJumpIfComment :: Maybe Text
   }
 
 data InstrCall = InstrCall
   { _instrCallTarget :: Value,
-    _instrCallRel :: Bool
+    _instrCallRel :: Bool,
+    _instrCallComment :: Maybe Text
   }
 
 newtype InstrAlloc = InstrAlloc

src/Juvix/Compiler/Casm/Pretty/Base.hs

@@ -23,6 +23,11 @@ ppIncAp = \case
   True -> return $ Str.semicolon <+> Str.apPlusPlus
   False -> mempty
 
+ppComment :: Maybe Text -> Sem r (Doc Ann)
+ppComment = \case
+  Just c -> return $ Str.commentLineStart <+> pretty c <> hardline
+  Nothing -> return mempty
+
 instance PrettyCode Reg where
   ppCode = \case
     Ap -> return Str.ap
@@ -121,19 +126,21 @@ instance PrettyCode Hint where
 
 instance PrettyCode InstrAssign where
   ppCode InstrAssign {..} = do
+    comment <- ppComment _instrAssignComment
     v <- ppCode _instrAssignValue
     r <- ppCode _instrAssignResult
     incAp <- ppIncAp _instrAssignIncAp
-    return $ r <+> Str.equal <+> v <> incAp
+    return $ comment <> r <+> Str.equal <+> v <> incAp
 
 instance PrettyCode InstrExtraBinop where
   ppCode InstrExtraBinop {..} = do
+    comment <- ppComment _instrExtraBinopComment
     v1 <- ppCode _instrExtraBinopArg1
     v2 <- ppCode _instrExtraBinopArg2
     op <- ppCode _instrExtraBinopOpcode
     r <- ppCode _instrExtraBinopResult
     incAp <- ppIncAp _instrExtraBinopIncAp
-    return $ r <+> Str.equal <+> v1 <+> op <+> v2 <> incAp
+    return $ comment <> r <+> Str.equal <+> v1 <+> op <+> v2 <> incAp
 
 ppRel :: Bool -> RValue -> Sem r (Doc Ann)
 ppRel isRel tgt
@@ -148,23 +155,26 @@ ppRel isRel tgt
 
 instance PrettyCode InstrJump where
   ppCode InstrJump {..} = do
+    comment <- ppComment _instrJumpComment
     tgt <- ppCode _instrJumpTarget
     incAp <- ppIncAp _instrJumpIncAp
     rel <- ppRel _instrJumpRel _instrJumpTarget
-    return $ Str.jmp <+> rel <> tgt <> incAp
+    return $ comment <> Str.jmp <+> rel <> tgt <> incAp
 
 instance PrettyCode InstrJumpIf where
   ppCode InstrJumpIf {..} = do
+    comment <- ppComment _instrJumpIfComment
     tgt <- ppCode _instrJumpIfTarget
     v <- ppCode _instrJumpIfValue
     incAp <- ppIncAp _instrJumpIfIncAp
-    return $ Str.jmp <+> tgt <+> Str.if_ <+> v <+> Str.notequal <+> annotate AnnLiteralInteger "0" <> incAp
+    return $ comment <> Str.jmp <+> tgt <+> Str.if_ <+> v <+> Str.notequal <+> annotate AnnLiteralInteger "0" <> incAp
 
 instance PrettyCode InstrCall where
   ppCode InstrCall {..} = do
+    comment <- ppComment _instrCallComment
     tgt <- ppCode _instrCallTarget
     rel <- ppRel _instrCallRel (Val _instrCallTarget)
-    return $ Str.call <+> rel <> tgt
+    return $ comment <> Str.call <+> rel <> tgt
 
 instance PrettyCode InstrAlloc where
   ppCode InstrAlloc {..} = do

src/Juvix/Compiler/Casm/Transformation/Optimize/Peephole.hs

@@ -41,7 +41,8 @@ peephole = mapT go
             let call =
                   InstrCall
                     { _instrCallTarget = tgt,
-                      _instrCallRel = _instrJumpRel
+                      _instrCallRel = _instrJumpRel,
+                      _instrCallComment
                     }
              in Call call : Return : is
       is -> is

src/Juvix/Compiler/Casm/Translation/FromCairo.hs

@@ -75,7 +75,8 @@ fromCairo elems0 =
               Call
                 InstrCall
                   { _instrCallRel = _instrPcUpdate == Cairo.PcUpdateJumpRel,
-                    _instrCallTarget = val
+                    _instrCallTarget = val,
+                    _instrCallComment = Nothing
                   }
             (rval, delta) = decodeRes i elems
             val = case rval of
@@ -110,7 +111,8 @@ fromCairo elems0 =
                 InstrAssign
                   { _instrAssignResult = dst,
                     _instrAssignValue = rval,
-                    _instrAssignIncAp = _instrApUpdate == Cairo.ApUpdateInc
+                    _instrAssignIncAp = _instrApUpdate == Cairo.ApUpdateInc,
+                    _instrAssignComment = Nothing
                   }
 
         goNop :: Cairo.Instruction -> [Cairo.Element] -> (Instruction, Int)
@@ -136,7 +138,8 @@ fromCairo elems0 =
                 InstrJump
                   { _instrJumpTarget = res,
                     _instrJumpRel = isRel,
-                    _instrJumpIncAp = _instrApUpdate == Cairo.ApUpdateInc
+                    _instrJumpIncAp = _instrApUpdate == Cairo.ApUpdateInc,
+                    _instrJumpComment = Nothing
                   }
 
         goJumpIf :: Cairo.Instruction -> [Cairo.Element] -> (Instruction, Int)
@@ -159,7 +162,8 @@ fromCairo elems0 =
                 InstrJumpIf
                   { _instrJumpIfTarget = tgt,
                     _instrJumpIfValue = dst,
-                    _instrJumpIfIncAp = _instrApUpdate == Cairo.ApUpdateInc
+                    _instrJumpIfIncAp = _instrApUpdate == Cairo.ApUpdateInc,
+                    _instrJumpIfComment = Nothing
                   }
 
         goAlloc :: Cairo.Instruction -> [Cairo.Element] -> (Instruction, Int)

src/Juvix/Compiler/Casm/Translation/FromReg.hs

@@ -14,6 +14,7 @@ import Juvix.Compiler.Casm.Translation.FromReg.CasmBuilder
 import Juvix.Compiler.Reg.Data.Blocks.InfoTable qualified as Reg
 import Juvix.Compiler.Reg.Extra.Blocks.Info qualified as Reg
 import Juvix.Compiler.Reg.Language.Blocks qualified as Reg
+import Juvix.Compiler.Reg.Pretty qualified as Reg
 import Juvix.Compiler.Tree.Evaluator.Builtins qualified as Reg
 import Juvix.Compiler.Tree.Extra.Rep qualified as Reg
 import Juvix.Data.Field
@@ -141,6 +142,9 @@ fromReg tab = mkResult $ run $ runLabelInfoBuilderWithNextId (Reg.getNextSymbolI
     argsOffset :: Int
     argsOffset = 3
 
+    ppVarComment :: Reg.VarRef -> Int -> Text
+    ppVarComment var off = Reg.ppPrint tab var <> " is [fp + " <> show off <> "]"
+
     goFun :: forall r. (Member LabelInfoBuilder r) => StdlibBuiltins -> LabelRef -> (Address, [[Instruction]]) -> Reg.FunctionInfo -> Sem r (Address, [[Instruction]])
     goFun blts failLab (addr0, acc) funInfo = do
       let sym = funInfo ^. Reg.functionSymbol
@@ -218,7 +222,7 @@ fromReg tab = mkResult $ run $ runLabelInfoBuilderWithNextId (Reg.getNextSymbolI
                     ++ zipWithExact (\var k -> (var, -argsOffset - k)) liveVars' [0 .. n - 1]
           unless updatedBuiltins $
             goAssignApBuiltins
-          mapM_ (mkMemRef >=> goAssignAp . Val . Ref) (reverse liveVars')
+          mapM_ saveLiveVar (reverse liveVars')
           output'' (mkCallRel $ Imm 3)
           output'' Return
           -- we need the Nop instruction to ensure that the relative call offset
@@ -228,6 +232,12 @@ fromReg tab = mkResult $ run $ runLabelInfoBuilderWithNextId (Reg.getNextSymbolI
           setAP 0
           setVars vars
           setBuiltinOffset bltOff
+          where
+            saveLiveVar :: Reg.VarRef -> Sem r ()
+            saveLiveVar var = do
+              ref <- mkMemRef var
+              let comment = Reg.ppPrint tab var
+              goAssignAp' (Just comment) (Val (Ref ref))
 
         goLocalBlock :: Int -> HashMap Reg.VarRef Int -> Int -> HashSet Reg.VarRef -> Maybe Reg.VarRef -> Reg.Block -> Sem r ()
         goLocalBlock ap0 vars bltOff liveVars mout' block = do
@@ -295,11 +305,15 @@ fromReg tab = mkResult $ run $ runLabelInfoBuilderWithNextId (Reg.getNextSymbolI
         goAssignVar vr val = do
           off <- getAP
           insertVar vr off
-          goAssignAp val
+          let comment = ppVarComment vr off
+          goAssignAp' (Just comment) val
+
+        goAssignAp' :: Maybe Text -> RValue -> Sem r ()
+        goAssignAp' comment val = do
+          output' 1 (mkAssignAp' comment val)
 
         goAssignAp :: RValue -> Sem r ()
-        goAssignAp val = do
-          output' 1 (mkAssignAp val)
+        goAssignAp = goAssignAp' Nothing
 
         goAssignValue :: Reg.VarRef -> Reg.Value -> Sem r ()
         goAssignValue vr v = mkRValue v >>= goAssignVar vr
@@ -308,7 +322,7 @@ fromReg tab = mkResult $ run $ runLabelInfoBuilderWithNextId (Reg.getNextSymbolI
         goAssignApValue v = mkRValue v >>= goAssignAp
 
         goAssignApBuiltins :: Sem r ()
-        goAssignApBuiltins = mkBuiltinRef >>= goAssignAp . Val . Ref
+        goAssignApBuiltins = mkBuiltinRef >>= goAssignAp' (Just "builtins pointer") . Val . Ref
 
         -- Warning: the result may depend on Ap. Use adjustAp when changing Ap
         -- afterwards.
@@ -334,7 +348,8 @@ fromReg tab = mkResult $ run $ runLabelInfoBuilderWithNextId (Reg.getNextSymbolI
                   _instrExtraBinopResult = MemRef Ap 0,
                   _instrExtraBinopArg1 = arg1,
                   _instrExtraBinopArg2 = arg2,
-                  _instrExtraBinopIncAp = True
+                  _instrExtraBinopIncAp = True,
+                  _instrExtraBinopComment = Just (ppVarComment res off)
                 }
 
         goNativeBinop :: Opcode -> Reg.VarRef -> MemRef -> Value -> Sem r ()
@@ -370,7 +385,8 @@ fromReg tab = mkResult $ run $ runLabelInfoBuilderWithNextId (Reg.getNextSymbolI
                               _binopValueArg2 = Imm 1,
                               _binopValueOpcode = FieldAdd
                             },
-                      _instrAssignIncAp = True
+                      _instrAssignIncAp = True,
+                      _instrAssignComment = Nothing
                     }
           Lab {} -> impossible
 

src/Juvix/Compiler/Casm/Translation/FromSource.hs

@@ -222,7 +222,8 @@ parseJump = do
           InstrJumpIf
             { _instrJumpIfTarget = tgt,
               _instrJumpIfValue = v,
-              _instrJumpIfIncAp = incAp
+              _instrJumpIfIncAp = incAp,
+              _instrJumpIfComment = Nothing
             }
 
     jmp :: ParsecS r Instruction
@@ -235,15 +236,22 @@ parseJump = do
           InstrJump
             { _instrJumpTarget = tgt,
               _instrJumpRel = isRel,
-              _instrJumpIncAp = incAp
+              _instrJumpIncAp = incAp,
+              _instrJumpComment = Nothing
             }
 
 parseCall :: (Member LabelInfoBuilder r) => ParsecS r Instruction
 parseCall = do
   kw kwCall
   isRel <- parseRel
   v <- parseValue
-  return $ Call $ InstrCall {_instrCallTarget = v, _instrCallRel = isRel}
+  return $
+    Call $
+      InstrCall
+        { _instrCallTarget = v,
+          _instrCallRel = isRel,
+          _instrCallComment = Nothing
+        }
 
 parseReturn :: ParsecS r Instruction
 parseReturn = do
@@ -277,7 +285,8 @@ parseAssign = do
           InstrAssign
             { _instrAssignValue = v,
               _instrAssignResult = res,
-              _instrAssignIncAp = incAp
+              _instrAssignIncAp = incAp,
+              _instrAssignComment = Nothing
             }
 
     extraBinop :: MemRef -> ParsecS r Instruction
@@ -293,7 +302,8 @@ parseAssign = do
               _instrExtraBinopArg2 = arg2,
               _instrExtraBinopOpcode = op,
               _instrExtraBinopResult = res,
-              _instrExtraBinopIncAp = incAp
+              _instrExtraBinopIncAp = incAp,
+              _instrExtraBinopComment = Nothing
             }
 
     parseExtraValue :: ExtraOpcode -> ParsecS r Value

src/Juvix/Compiler/Reg/Pretty.hs

@@ -12,7 +12,7 @@ import Juvix.Data.PPOutput
 import Juvix.Prelude
 import Prettyprinter.Render.Terminal qualified as Ansi
 
-ppOutDefault :: (PrettyCode c) => InfoTable -> c -> AnsiText
+ppOutDefault :: (PrettyCode c) => InfoTable' t e -> c -> AnsiText
 ppOutDefault tab = mkAnsiText . PPOutput . doc (defaultOptions tab)
 
 ppOut :: (PrettyCode c) => Options -> c -> AnsiText
@@ -21,8 +21,8 @@ ppOut o = mkAnsiText . PPOutput . doc o
 ppTrace' :: (PrettyCode c) => Options -> c -> Text
 ppTrace' opts = Ansi.renderStrict . reAnnotateS stylize . layoutPretty defaultLayoutOptions . doc opts
 
-ppTrace :: (PrettyCode c) => InfoTable -> c -> Text
+ppTrace :: (PrettyCode c) => InfoTable' t e -> c -> Text
 ppTrace tab = ppTrace' (defaultOptions tab)
 
-ppPrint :: (PrettyCode c) => InfoTable -> c -> Text
+ppPrint :: (PrettyCode c) => InfoTable' t e -> c -> Text
 ppPrint tab = toPlainText . ppOutDefault tab