commit 594fcdc173461575214ef85f11198027ba43151f Author: Francesco Gazzetta Date: Fri Jul 1 15:21:26 2022 +0200 🌅 diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..3323531 --- /dev/null +++ b/.gitignore @@ -0,0 +1,7 @@ +cabal.project.local +cabal.project.local~ +dist +dist-newstyle +*.o +*.hi +.ghc.environment.* diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..eb18524 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for qbe-hs + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..dceb148 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2022, Francesco Gazzetta + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Francesco Gazzetta nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/qbe.cabal b/qbe.cabal new file mode 100644 index 0000000..aad248b --- /dev/null +++ b/qbe.cabal @@ -0,0 +1,32 @@ +cabal-version: 3.0 +name: qbe +-- First component matches the QBE major version +version: 1.1.0.0 +-- synopsis: +-- description: +license: BSD-3-Clause +license-file: LICENSE +author: Francesco Gazzetta +maintainer: fgaz@fgaz.me +copyright: 2022 Francesco Gazzetta +category: Language +build-type: Simple +extra-doc-files: CHANGELOG.md +-- extra-source-files: + +library + exposed-modules: Language.QBE + -- other-modules: + other-extensions: DataKinds + KindSignatures + GeneralizedNewtypeDeriving + build-depends: base ^>=4.16.1.0 + , text + , text-short + , bytestring + , hashable + , deepseq + , binary + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 diff --git a/src/Language/QBE.hs b/src/Language/QBE.hs new file mode 100644 index 0000000..18cc7d3 --- /dev/null +++ b/src/Language/QBE.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Language.QBE where + +import Data.Text (Text) +import Data.Text.Short (ShortText) +import Data.ByteString (ByteString) +import Data.Word (Word64) +import Data.List.NonEmpty (NonEmpty) +-- Instances +import Data.Hashable (Hashable) +import Control.DeepSeq (NFData) +import Data.Binary (Binary) +import Data.String (IsString) + +-- * Identifiers +---------------- + +type RawIdent = ShortText + +data Sigil + = AggregateTy -- ^ @:@ + | Global -- ^ @$@ + | Temporary -- ^ @%@ + | Label -- ^ @\@@ + deriving (Show, Eq) + +-- | QBE identifiers. The sigil is represented at the type level, so that +-- mixing incompatible identifiers is impossible. +newtype Ident (t :: Sigil) = Ident RawIdent + deriving (Show, Eq, Ord, IsString, Binary, NFData, Hashable) + +-- * Types +---------- + +data BaseTy = Word | Long | Single | Double + deriving (Show, Eq) + +data ExtTy = BaseTy BaseTy | Byte | HalfWord + deriving (Show, Eq) + +-- * Constants +-------------- + +data Const + = CInt Bool Word64 -- ^ The 'Bool' is whether to negate + | CSingle Float + | CDouble Double + | CGlobal (Ident 'Global) + deriving (Show, Eq) + +-- * Linkage +------------ + +data Linkage + = Export + | Section ShortText (Maybe Text) + deriving (Show, Eq) + +-- * Definitions +---------------- + +type Alignment = Word64 +type Size = Word64 +type Amount = Word64 + +-- ** Aggregate types +--------------------- + +data Typedef + = Typedef (Ident 'AggregateTy) (Maybe Alignment) [(SubTy, Maybe Amount)] + | Opaque (Ident 'AggregateTy) Alignment Size + deriving (Show, Eq) + +data SubTy + = SubExtTy + | SubAggregateTy (Ident 'AggregateTy) + deriving (Show, Eq) + +-- ** Data +---------- + +data DataDef = DataDef [Linkage] (Ident 'Global) (Maybe Alignment) [Field] + deriving (Show, Eq) + +data DataItem + = Symbol (Ident 'Global) Alignment + | String ByteString + | Const Const + deriving (Show, Eq) + +data Field + = FieldExtTy ExtTy (NonEmpty DataItem) + | FieldZero Size + deriving (Show, Eq) + +-- ** Functions +--------------- + +-- | 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) + +data AbiTy = AbiBaseTy BaseTy | AbiAggregateTy (Ident 'AggregateTy) + deriving (Show, Eq) + +data Param = Param AbiTy (Ident 'Temporary) + deriving (Show, Eq) + +data Variadic = Variadic | NoVariadic + deriving (Show, Eq) + +-- * Control +------------ + +data Val + = ValConst Const + | ValTemporary (Ident 'Temporary) + | ValGlobal (Ident 'Global) + deriving (Show, Eq) + +data Block = Block (Ident 'Label) [Phi] [Inst] Jump + deriving (Show, Eq) + +data Jump + = Jmp (Ident 'Label) + | Jnz Val (Ident 'Label) (Ident 'Label) + | Ret (Maybe Val) + deriving (Show, Eq) + +-- * Instructions +----------------- + +data Phi = Phi (Ident 'Temporary) BaseTy [(Ident 'Label, Val)] + deriving (Show, Eq) + +data Inst + -- Arithmetic and Bits + = BinaryOp (Ident 'Temporary) BaseTy BinaryOp Val Val + | Neg (Ident 'Temporary) BaseTy Val + -- Memory + | Store ExtTy Val Val + | Load (Ident 'Temporary) BaseTy BaseTy Val -- ^ @\ =\ load\ \@ + | LoadW (Ident 'Temporary) BaseTy IntRepr Val -- ^ @\ =\ load\w \@ + | LoadH (Ident 'Temporary) BaseTy IntRepr Val + | LoadB (Ident 'Temporary) BaseTy IntRepr Val + -- Comparisons + | Compare (Ident 'Temporary) BaseTy Comparison BaseTy Val Val + -- Conversions + -- | @extsw@/@extuw@. There is only one possible instruction type, so there's + -- no 'BaseTy' argument + | ExtW (Ident 'Temporary) IntRepr Val + -- | @extsh@/@extuh@ + | ExtH (Ident 'Temporary) BaseTy IntRepr Val + -- | @extsb@/@extub@ + | ExtB (Ident 'Temporary) BaseTy IntRepr Val + -- | @exts@. There is only one possible instruction type, so there's + -- no 'BaseTy' argument + | Exts (Ident 'Temporary) Val + -- | @truncd@. There is only one possible instruction type, so there's + -- no 'BaseTy' argument + | Truncd (Ident 'Temporary) Val + -- | @stosi@/@stoui@ + | StoI (Ident 'Temporary) BaseTy IntRepr Val + -- | @dtosi@/@dtoui@ + | DtoI (Ident 'Temporary) BaseTy IntRepr Val + -- | @swtof@/@uwtof@ + | WtoF (Ident 'Temporary) BaseTy IntRepr Val + -- | @sltof@/@ultof@ + | LtoF (Ident 'Temporary) BaseTy IntRepr Val + -- Cast and Copy + | Cast (Ident 'Temporary) BaseTy Val + | Copy (Ident 'Temporary) BaseTy Val + -- Calls + -- | the fields are: assignment, function name, environment, arguments, variadic arguments + | Call (Maybe (Ident 'Temporary, AbiTy)) Val (Maybe Val) [Arg] [Arg] + -- Variadic + | VaStart (Ident 'Temporary) + | VaArg (Ident 'Temporary) BaseTy (Ident 'Temporary) + deriving (Show, Eq) + +data IntRepr = Signed | Unsigned + deriving (Show, Eq) + +data BinaryOp + -- | @add@ + = Add + -- | @sub@ + | Sub + -- | @div@/@udiv@. @Div Signed@ gets translated to @div@, so it will work + -- also on floats + | Div IntRepr + -- | @mul@ + | Mul + -- | @rem@/@urem@ + | Rem IntRepr + -- | @or@ + | Or + -- | @xor@ + | Xor + -- | @and@ + | And + -- | @sar@ + | Sar + -- | @shr@ + | Shr + -- | @shl@ + | Shl + deriving (Show, Eq) + +-- | Comparison operators. +-- Where there's a @'Maybe' 'IntRepr'@, 'Nothing' means floating point +-- (@le@, @lt@, @ge@, @gt@), while @'Just' r@ means integer +-- (@sle@, @ule@, @slt@, @ult@...) +data Comparison + -- Universal comparison + = Eq -- ^ equality + | Ne -- ^ inequality + | Le (Maybe IntRepr) -- ^ lower or equal + | Lt (Maybe IntRepr) -- ^ lower + | Ge (Maybe IntRepr) -- ^ greater or equal + | Gt (Maybe IntRepr) -- ^ greater + -- Floating point only comparison + | O -- ^ ordered (no operand is a NaN) (floating point only) + | Uo -- ^ unordered (at least one operand is a NaN) (floating point only) + deriving (Show, Eq) + +data Arg = Arg AbiTy Val + deriving (Show, Eq)