diff --git a/golden/hello_world.qbe b/golden/hello_world.qbe new file mode 100644 index 0000000..b6f1ddb --- /dev/null +++ b/golden/hello_world.qbe @@ -0,0 +1,9 @@ + +data $str = +{b "hello world", b 0} +export +function w $main +() +{@start + %r =w call $puts (l $str) + ret 0} \ No newline at end of file diff --git a/src/Language/QBE.hs b/src/Language/QBE.hs index cd252ac..87146fd 100644 --- a/src/Language/QBE.hs +++ b/src/Language/QBE.hs @@ -85,6 +85,7 @@ instance Pretty ExtTy where -------------- data Const + -- MAYBE just use a signed type = CInt Bool Word64 -- ^ The 'Bool' is whether to negate | CSingle Float | CDouble Double @@ -122,13 +123,13 @@ type Amount = Word64 -- ** Aggregate types --------------------- -data Typedef - = Typedef (Ident 'AggregateTy) (Maybe Alignment) [(SubTy, Maybe Amount)] +data TypeDef + = TypeDef (Ident 'AggregateTy) (Maybe Alignment) [(SubTy, Maybe Amount)] | Opaque (Ident 'AggregateTy) Alignment Size deriving (Show, Eq) -instance Pretty Typedef where - pretty (Typedef ident alignment def) = +instance Pretty TypeDef where + pretty (TypeDef ident alignment def) = "type" <+> pretty ident <+> equals <> maybe mempty (\x -> space <> pretty x) alignment <+> braced (prettyItem <$> def) @@ -458,6 +459,19 @@ data Arg = Arg AbiTy Val instance Pretty Arg where pretty (Arg abiTy val) = pretty abiTy <+> pretty val +-- * Program +------------ + +data Program = Program [TypeDef] [DataDef] [FuncDef] + deriving (Show, Eq) + +instance Pretty Program where + pretty (Program typeDefs dataDefs funcDefs) = vsep $ concat + [ pretty <$> typeDefs + , pretty <$> dataDefs + , pretty <$> funcDefs + ] + -- * Utilities -------------- diff --git a/test/Main.hs b/test/Main.hs index 3a7610c..e5d7085 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -38,7 +38,7 @@ goldenTests = testGroup "golden tests" , CGlobal "global" ] , t "linkage" (Export, Section "secName" Nothing, Section "secName" $ Just "flag1 flag2") - , t "typedef" $ Typedef "t" (Just 8) + , t "typedef" $ TypeDef "t" (Just 8) [ (SubExtTy HalfWord, Just 16) , (SubAggregateTy "t1", Nothing) ] @@ -82,6 +82,7 @@ goldenTests = testGroup "golden tests" , VaArg assignA "va" ] (Ret Nothing) + , t "hello_world" helloWorld ] where t name value = goldenVsAction @@ -100,3 +101,18 @@ two = valInt 2 assignA :: Assignment assignA = Assignment "a" Word + +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) + :| []