update

.builds/all.yml

@@ -29,6 +29,7 @@ tasks:
       "$HOME/.ghcup/bin/ghcup" install ghc "ghc-8.10.7"
       "$HOME/.ghcup/bin/ghcup" install ghc "ghc-9.0.2"
       "$HOME/.ghcup/bin/ghcup" install ghc "ghc-9.2.2"
+      "$HOME/.ghcup/bin/ghcup" install ghc "ghc-9.4.2"
       cabal update
   - 8_10_7-prepare: |
       cd qbe-hs
@@ -87,6 +88,25 @@ tasks:
   - 9_2_2-haddock: |
       cd qbe-hs
       cabal haddock all
+  - 9_4_2-prepare: |
+      cd qbe-hs
+      cabal configure -w ghc-9.2.2
+  - 9_4_2-check: |
+      cd qbe-hs
+      cabal check
+  - 9_4_2-dependencies: |
+      cd qbe-hs
+      cabal build all --enable-tests --only-dependencies
+      cabal build all --only-dependencies
+  - 9_4_2-build: |
+      cd qbe-hs
+      cabal build all
+  - 9_4_2-test: |
+      cd qbe-hs
+      cabal test all --enable-tests
+  - 9_4_2-haddock: |
+      cd qbe-hs
+      cabal haddock all
 triggers:
   - action: email
     condition: failure

.envrc

@@ -0,0 +1 @@
+use flake

.gitignore

@@ -6,3 +6,4 @@ dist-newstyle
 *.hi
 .ghc.environment.*
 *.tix
+.direnv

CHANGELOG.md

@@ -1,5 +1,5 @@
 # Revision history for qbe-hs
 
-## 0.1.0.0 -- YYYY-mm-dd
+## 1.1.0.0 -- 2022-07-10
 
-* First version. Released on an unsuspecting world.
+* First version.

README.md

@@ -0,0 +1,53 @@
+# qbe-hs
+
+[![Hackage](https://img.shields.io/hackage/v/qbe.svg)](https://hackage.haskell.org/package/qbe)
+[![builds.sr.ht status](https://builds.sr.ht/~fgaz/qbe-hs/commits/master.svg)](https://builds.sr.ht/~fgaz/qbe-hs/commits/master?)
+
+Haskell types and prettyprinter for the [IL](https://c9x.me/compile/doc/il.html)
+of the [QBE](https://c9x.me/compile/) compiler backend
+
+## Example
+
+```haskell
+helloWorld :: Program
+helloWorld = Program [] [helloString] [helloMain]
+  where
+    helloString = DataDef [] "str" Nothing
+      [ FieldExtTy Byte $ String "hello world" :| []
+      , FieldExtTy Byte $ Const (CInt False 0) :| []
+      ]
+    helloMain = FuncDef [Export] (Just $ AbiBaseTy Word) "main"
+      Nothing [] NoVariadic $
+      Block "start"
+        []
+        [ Call (Just ("r", AbiBaseTy Word)) (ValGlobal "puts")
+            Nothing
+            [Arg (AbiBaseTy Long) $ ValGlobal "str"]
+            []
+        ]
+        (Ret $ Just $ ValConst $ CInt False 0)
+      :| []
+```
+
+Gets rendered to
+
+```
+data $str =
+{b "hello world", b 0}
+export
+function w $main () {
+@start
+    %r =w call $puts (l $str)
+    ret 0
+}
+```
+
+## Contributing
+
+You can send patches to my
+[public-inbox mailing list](https://lists.sr.ht/~fgaz/public-inbox)
+or to any of the contacts listed at [fgaz.me/about](https://fgaz.me/about).
+Or you can send a pull request to the
+[GitHub mirror](https://github.com/fgaz/qbe-hs).
+
+Issues are tracked at https://todo.sr.ht/~fgaz/qbe-hs

flake.lock

@@ -0,0 +1,27 @@
+{
+  "nodes": {
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1776949667,
+        "narHash": "sha256-GMSVw35Q+294GlrTUKlx087E31z7KurReQ1YHSKp5iw=",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "01fbdeef22b76df85ea168fbfe1bfd9e63681b30",
+        "type": "github"
+      },
+      "original": {
+        "owner": "NixOS",
+        "ref": "nixpkgs-unstable",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "root": {
+      "inputs": {
+        "nixpkgs": "nixpkgs"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}

flake.nix

@@ -0,0 +1,42 @@
+{
+  inputs = {
+    nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable";
+  };
+
+  outputs = { self, nixpkgs, ... }@inputs:
+    let
+      supportedSystems = [
+        "aarch64-darwin" "aarch64-linux"
+        "x86_64-darwin" "x86_64-linux"
+      ];
+
+      each-system = f: nixpkgs.lib.genAttrs supportedSystems (system: f rec {
+	pkgs = import nixpkgs {
+          inherit system;
+        };
+	inherit (pkgs) lib;
+        inherit system;
+      });
+    in {
+      # Exposed as a REPL convenience.
+      _pkgs = each-system ({ pkgs, ... }: pkgs);
+
+      packages = each-system ({ pkgs, ... }: {
+        # default = pkgs.callPackage ./default.nix {};
+      });
+
+      devShells = each-system ({ pkgs, system, ... }: {
+	default = pkgs.haskellPackages.developPackage {
+          root = ./.;
+          modifier = drv:
+            pkgs.haskell.lib.addBuildTools
+              drv
+              (with pkgs; [
+                cabal-install
+                qbe
+                gcc
+              ]);
+	};
+      });
+    };
+}

golden/function.qbe

@@ -1,5 +1,5 @@
 export
-function :t $f
-(env %env, w %a, d %b, ...)
-{@l
-     ret }
+function :t $f (env %env, w %a, d %b, ...) {
+@l
+    ret 
+}

golden/hello_world.qbe

@@ -2,8 +2,8 @@
 data $str =
 {b "hello world", b 0}
 export
-function w $main
-()
-{@start
+function w $main () {
+@start
     %r =w call $puts (l $str)
-     ret 0}
+    ret 0
+}

qbe.cabal

@@ -4,8 +4,9 @@ name:               qbe
 version:            1.1.0.0
 synopsis:           Types and prettyprinter for the IL of the QBE compiler backend
 description:
-  This library provides types representing the intermediate language of the QBE
-  compiler backend.
+  This library provides types representing
+  the [intermediate language](https://c9x.me/compile/doc/il.html)
+  of the [QBE](https://c9x.me/compile/) compiler backend.
   It also provides pretty-printing instances based on
   the [@prettyprinter@](https://hackage.haskell.org/package/prettyprinter)
   library, that emit the textual representation of the IL.
@@ -19,11 +20,13 @@ copyright:          2022 Francesco Gazzetta
 category:           Language
 build-type:         Simple
 extra-doc-files:    CHANGELOG.md
-extra-source-files: golden/*.qbe
+extra-source-files: README.md golden/*.qbe
 tested-with:
     , GHC == 8.10.7
     , GHC == 9.0.2
     , GHC == 9.2.2
+    , GHC == 9.4.2
+    , GHC == 9.10.3
 
 source-repository head
     type:     git
@@ -51,12 +54,14 @@ library
     build-depends:    base              ^>= 4.16.1.0
                                      || ^>= 4.14
                                      || ^>= 4.15
+                                     || ^>= 4.17
+                                     || ^>= 4.20
                     , text              ^>= 1.2.5
                                      || ^>= 2.0
-                    , text-short        ^>= 0.1
+                    , text-short        >= 0.1 || <=0.1.6.1
                     , bytestring        ^>= 0.11.3
                     , hashable          ^>= 1.4.0
-                    , deepseq           ^>= 1.4.4
+                    , deepseq           ^>= 1.4.4 || ^>= 1.5
                     , prettyprinter     ^>= 1.7.1
     hs-source-dirs:   src
 

src/Language/QBE.hs

@@ -4,7 +4,79 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
-module Language.QBE where
+{-|
+Module      : Language.QBE
+Description : Types and Pretty instances for the QBE IL
+Copyright   : (c) Francesco Gazzetta, 2022
+License     : BSD-3-Clause
+Maintainer  : Francesco Gazzetta <fgaz@fgaz.me>
+
+This module contains datatypes representing the various structures of
+the [intermediate language](https://c9x.me/compile/doc/il.html)
+of the [QBE](https://c9x.me/compile/) compiler backend.
+
+All datatypes also have 'Pretty' instances from
+the [@prettyprinter@](https://hackage.haskell.org/package/prettyprinter)
+library.
+You can render QBE IL source files, or any part of them, with something like:
+
+> render :: Pretty a => a -> Text
+> render = renderStrict . layoutPretty defaultLayoutOptions . pretty
+
+>>> render $ Ret $ Just $ ValTemporary "a"
+"ret %a"
+>>> Text.putStrLn $ render $ Program [] [] [FuncDef [] Nothing "main" …
+function w $main () {
+@start
+⋮
+-}
+module Language.QBE
+(
+-- * Identifiers
+RawIdent
+, Sigil(..)
+, Ident(..)
+-- * Types
+, BaseTy(..)
+, ExtTy(..)
+-- * Constants
+, Const(..)
+-- * Linkage
+, Linkage(..)
+-- * Definitions
+, Alignment
+, Size
+, Amount
+-- ** Aggregate types
+, TypeDef(..)
+, SubTy(..)
+-- ** Data
+, DataDef(..)
+, DataItem(..)
+, Field(..)
+-- ** Functions
+, FuncDef(..)
+, AbiTy(..)
+, Param(..)
+, Variadic(..)
+, prettyVariadic
+-- * Control
+, Val(..)
+, Block(..)
+, Jump(..)
+-- * Instructions
+, Phi(..)
+, PhiArg(..)
+, Inst(..)
+, Assignment(..)
+, pattern (:=)
+, IntRepr(..)
+, BinaryOp(..)
+, Comparison(..)
+, Arg(..)
+-- * Program
+, Program(..)
+) where
 
 import Data.Text (Text)
 import Data.Text.Short (ShortText)
@@ -15,7 +87,7 @@ import Data.List.NonEmpty (NonEmpty, toList)
 import Data.Maybe (maybeToList)
 import Prettyprinter
   ( Pretty(pretty), Doc, (<+>), vsep, hsep, hang, punctuate, group, flatAlt
-  , space, encloseSep, tupled, comma, equals, braces )
+  , space, encloseSep, tupled, comma, equals, braces, lbrace, rbrace )
 -- Instances
 import Data.Hashable (Hashable)
 import Control.DeepSeq (NFData)
@@ -24,8 +96,10 @@ import Data.String (IsString)
 -- * Identifiers
 ----------------
 
+-- | A raw identifier string, with no sigil information attached
 type RawIdent = ShortText
 
+-- | Sigils are used to differentiate the verious types of 'Ident'ifier.
 data Sigil
   = AggregateTy -- ^ @:@
   | Global -- ^ @$@
@@ -64,7 +138,12 @@ instance Pretty (Ident 'Label) where
 -- * Types
 ----------
 
-data BaseTy = Word | Long | Single | Double
+-- | Base types
+data BaseTy
+  = Word -- ^ @w@
+  | Long -- ^ @l@
+  | Single -- ^ @s@
+  | Double -- ^ @d@
   deriving (Show, Eq)
 
 instance Pretty BaseTy where
@@ -73,7 +152,11 @@ instance Pretty BaseTy where
   pretty Single = pretty 's'
   pretty Double = pretty 'd'
 
-data ExtTy = BaseTy BaseTy | Byte | HalfWord
+-- | Extended types
+data ExtTy
+  = BaseTy BaseTy
+  | Byte -- ^ @b@
+  | HalfWord -- ^ @h@
   deriving (Show, Eq)
 
 instance Pretty ExtTy where
@@ -84,12 +167,13 @@ instance Pretty ExtTy where
 -- * Constants
 --------------
 
+-- | Constant/immediate
 data Const
   -- MAYBE just use a signed type
-  = CInt Bool Word64 -- ^ The 'Bool' is whether to negate
-  | CSingle Float
-  | CDouble Double
-  | CGlobal (Ident 'Global)
+  = CInt Bool Word64 -- ^ 64 bit integer. The 'Bool' is whether to negate.
+  | CSingle Float -- ^ Single-precision float
+  | CDouble Double -- ^ Double-precision float
+  | CGlobal (Ident 'Global) -- ^ Global symbol
   deriving (Show, Eq)
 
 instance Pretty Const where
@@ -103,8 +187,8 @@ instance Pretty Const where
 ------------
 
 data Linkage
-  = Export
-  | Section ShortText (Maybe Text)
+  = Export -- ^ Marks the defined item as visible outside the current file's scope
+  | Section ShortText (Maybe Text) -- ^ Section name, with optional linker flags
   deriving (Show, Eq)
 
 instance Pretty Linkage where
@@ -123,6 +207,7 @@ type Amount = Word64
 -- ** Aggregate types
 ---------------------
 
+-- | Aggregate type
 data TypeDef
   = TypeDef (Ident 'AggregateTy) (Maybe Alignment) [(SubTy, Maybe Amount)]
   | Opaque (Ident 'AggregateTy) Alignment Size
@@ -140,6 +225,7 @@ instance Pretty TypeDef where
     "type" <+> pretty ident <+> equals
     <+> "align" <+> pretty alignment <+> braces (pretty size)
 
+-- | A type that can be part of an aggregate type
 data SubTy
   = SubExtTy ExtTy
   | SubAggregateTy (Ident 'AggregateTy)
@@ -152,6 +238,7 @@ instance Pretty SubTy where
 -- ** Data
 ----------
 
+-- | Global object definition
 data DataDef = DataDef [Linkage] (Ident 'Global) (Maybe Alignment) [Field]
   deriving (Show, Eq)
 
@@ -187,6 +274,7 @@ instance Pretty Field where
 -- ** Functions
 ---------------
 
+-- TODO use record syntax on long types like this one
 -- | Function definition. The 'Maybe (Ident \'Temporary)' is the environment
 data FuncDef = FuncDef [Linkage] (Maybe AbiTy) (Ident 'Global) (Maybe (Ident 'Temporary)) [Param] Variadic (NonEmpty Block)
   deriving (Show, Eq)
@@ -194,12 +282,13 @@ data FuncDef = FuncDef [Linkage] (Maybe AbiTy) (Ident 'Global) (Maybe (Ident 'Te
 instance Pretty FuncDef where
   pretty (FuncDef linkage abiTy ident env params variadic blocks) = vsep
     [ vsep $ pretty <$> linkage
-    , "function" <+> pretty abiTy <+> pretty ident
-    , tupled $
+    , "function" <+> pretty abiTy <+> pretty ident <+> tupled (
         maybeToList (("env" <+>) . pretty <$> env)
         ++ fmap pretty params
         ++ maybeToList (prettyVariadic variadic)
-    , braces $ vsep $ toList $ pretty <$> blocks
+      ) <+> lbrace
+    , vsep $ toList $ pretty <$> blocks
+    , rbrace
     ]
 
 data AbiTy = AbiBaseTy BaseTy | AbiAggregateTy (Ident 'AggregateTy)
@@ -209,15 +298,19 @@ instance Pretty AbiTy where
   pretty (AbiBaseTy baseTy) = pretty baseTy
   pretty (AbiAggregateTy ident) = pretty ident
 
+-- | Function parameter
 data Param = Param AbiTy (Ident 'Temporary)
   deriving (Show, Eq)
 
 instance Pretty Param where
   pretty (Param abiTy ident) = pretty abiTy <+> pretty ident
 
+-- | Indicates the presence or absence of a variadic marker
 data Variadic = Variadic | NoVariadic
   deriving (Show, Eq)
 
+-- | 'Variadic' → @Just "..."@
+-- 'NoVariadic' → @Nothing@
 prettyVariadic :: Variadic -> Maybe (Doc a)
 prettyVariadic Variadic = Just "..."
 prettyVariadic NoVariadic = Nothing
@@ -225,6 +318,7 @@ prettyVariadic NoVariadic = Nothing
 -- * Control
 ------------
 
+-- | Value, either an immediate or a global or temporary identifier.
 data Val
   = ValConst Const
   | ValTemporary (Ident 'Temporary)
@@ -236,6 +330,7 @@ instance Pretty Val where
   pretty (ValTemporary ident) = pretty ident
   pretty (ValGlobal ident) = pretty ident
 
+-- | Block of instructions beginning with a label and ending with a jump
 data Block = Block (Ident 'Label) [Phi] [Inst] Jump
   deriving (Show, Eq)
 
@@ -247,10 +342,11 @@ instance Pretty Block where
     , [pretty jump]
     ]
 
+-- | Jump instructions
 data Jump
-  = Jmp (Ident 'Label)
-  | Jnz Val (Ident 'Label) (Ident 'Label)
-  | Ret (Maybe Val)
+  = Jmp (Ident 'Label) -- ^ Unconditional jump
+  | Jnz Val (Ident 'Label) (Ident 'Label) -- ^ Conditional jump
+  | Ret (Maybe Val) -- ^ Function return
   deriving (Show, Eq)
 
 instance Pretty Jump where
@@ -264,6 +360,8 @@ instance Pretty Jump where
 -- * Instructions
 -----------------
 
+-- MAYBE change [PhiArg] to Map (Ident 'Label) Val
+-- | Phi instruction
 data Phi = Phi Assignment [PhiArg]
   deriving (Show, Eq)
 
@@ -271,23 +369,30 @@ instance Pretty Phi where
   pretty (Phi assignment args) =
     pretty assignment <+> "phi" <+> hsep (punctuate comma $ pretty <$> args)
 
+-- | Phi instruction argument, associating a 'Val' to a 'Label'
 data PhiArg = PhiArg (Ident 'Label) Val
   deriving (Show, Eq)
 
 instance Pretty PhiArg where
   pretty (PhiArg label val) = pretty label <+> pretty val
 
+-- | Instruction
 data Inst
   -- Arithmetic and Bits
-  = BinaryOp Assignment BinaryOp Val Val
-  | Neg Assignment Val
+  = BinaryOp Assignment BinaryOp Val Val -- ^ Binary arithmetic and bit operations
+  | Neg Assignment Val -- ^ @neg@
   -- Memory
+  -- | @stored@/@stores@/@storel@/@storew@/@storeh@/@storeb@
   | Store ExtTy Val Val
   -- MAYBE collapse all the Loads in a single Load constructor and just discard
   -- the intrepr when unused.
-  | Load Assignment BaseTy Val -- ^ @\<ident\> =\<baseTy\> load\<baseTy\> \<val\>@
-  | LoadW Assignment IntRepr Val -- ^ @\<ident\> =\<baseTy\> load\<intRepr\>w \<val\>@
+  -- | @loadw@/@loadl@/@loads@/@loadd@
+  | Load Assignment BaseTy Val
+  -- | @loadsw@/@loaduw@
+  | LoadW Assignment IntRepr Val
+  -- | @loadsh@/@loaduh@
   | LoadH Assignment IntRepr Val
+  -- | @loadsb@/@loadub@
   | LoadB Assignment IntRepr Val
   -- Comparisons
   | Compare Assignment Comparison BaseTy Val Val
@@ -313,13 +418,17 @@ data Inst
   -- | @sltof@/@ultof@
   | LtoF Assignment IntRepr Val
   -- Cast and Copy
+  -- | @cast@
   | Cast Assignment Val
+  -- | @copy@
   | Copy Assignment Val
   -- Calls
-  -- | the fields are: assignment, function name, environment, arguments, variadic arguments
+  -- | @call@. The fields are: assignment, function name, environment, arguments, variadic arguments
   | Call (Maybe (Ident 'Temporary, AbiTy)) Val (Maybe Val) [Arg] [Arg]
   -- Variadic
+  -- | @vastart@, initializes a variable argument list
   | VaStart (Ident 'Temporary)
+  -- | @vaarg@, fetches the next argument from a variable argument list
   | VaArg Assignment (Ident 'Temporary)
   deriving (Show, Eq)
 
@@ -368,6 +477,7 @@ instance Pretty Inst where
   pretty (VaStart argList) = "vastart" <+> pretty argList
   pretty (VaArg assignment argList) = pretty assignment <+> "vaarg" <+> pretty argList
 
+-- | Represents the @%x =t@ part of an instruction.
 data Assignment = Assignment (Ident 'Temporary) BaseTy
   deriving (Show, Eq)
 
@@ -378,9 +488,11 @@ pattern (:=) ident ty = Assignment ident ty
 instance Pretty Assignment where
   pretty (Assignment ident ty) = pretty ident <+> equals <> pretty ty
 
+-- | Integer representation
 data IntRepr = Signed | Unsigned
   deriving (Show, Eq)
 
+-- | Binary arithmetic and bit operations
 data BinaryOp
   -- | @add@
   = Add
@@ -453,6 +565,7 @@ instance Pretty IntRepr where
   pretty Signed = pretty 's'
   pretty Unsigned = pretty 'u'
 
+-- | Function argument
 data Arg = Arg AbiTy Val
   deriving (Show, Eq)
 
@@ -462,6 +575,7 @@ instance Pretty Arg where
 -- * Program
 ------------
 
+-- | Datatypre representing a QBE IL source file
 data Program = Program [TypeDef] [DataDef] [FuncDef]
   deriving (Show, Eq)
 
@@ -475,7 +589,7 @@ instance Pretty Program where
 -- * Utilities
 --------------
 
--- like 'list' and 'tupled'
+-- | Like 'list' and 'tupled', but with braces
 braced :: [Doc ann] -> Doc ann
 braced = group . encloseSep (flatAlt "{ " "{")
                             (flatAlt " }" "}")

test/Main.hs

@@ -113,6 +113,10 @@ helloWorld = Program [] [helloString] [helloMain]
       Nothing [] NoVariadic $
       Block "start"
         []
-        [Call (Just ("r", AbiBaseTy Word)) (ValGlobal "puts") Nothing [Arg (AbiBaseTy Long) $ ValGlobal "str"] []]
+        [ Call (Just ("r", AbiBaseTy Word)) (ValGlobal "puts")
+            Nothing
+            [Arg (AbiBaseTy Long) $ ValGlobal "str"]
+            []
+        ]
         (Ret $ Just $ ValConst $ CInt False 0)
       :| []