msyds/qbe-hs
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Compare commits

base: msyds:14050204978568e3fa9aebcd9dc6d5050551c68e
Branches Tags
msyds:master msyds:qq
..
compare: msyds:master
Branches Tags
msyds:master msyds:qq

15 Commits
1405020497 ... master

Author SHA1 Message Date
Madeleine Sydney Ślaga
64be009635 fix: escape characters as octal sequences
All checks were successful
build / build (push) Successful in 44s
Details
2026-05-18 10:01:05 -06:00
Madeleine Sydney Ślaga
ab7cc053a4 refactor: records
All checks were successful
build / build (push) Successful in 27s
Details
2026-04-30 22:20:22 -06:00
Madeleine Sydney Ślaga
e61853e7a6 feat: Data instances
All checks were successful
build / build (push) Successful in 6s
Details
2026-04-30 17:37:05 -06:00
Madeleine Sydney Ślaga
25b62cb69d refactor: CInt Integer
All checks were successful
build / build (push) Successful in 16s
Details
2026-04-30 12:24:13 -06:00
Madeleine Sydney Ślaga
e03e918bf4 nix
All checks were successful
build / build (push) Successful in 15s
Details
2026-04-24 12:16:43 -06:00
Madeleine Sydney Ślaga
540a5e03fe update 2026-04-24 08:54:34 -06:00
Francesco Gazzetta
f552132241 Add GHC 9.4.2 to CI 2023-01-05 14:07:51 +01:00
Francesco Gazzetta
8130eefc48 Allow base 4.17 2023-01-05 12:24:23 +01:00
Francesco Gazzetta
ee46313617 Changelog for 1.1.0.0 2022-07-10 22:29:01 +02:00
Francesco Gazzetta
76735e82ac Instr haddocks 2022-07-10 22:27:32 +02:00
Francesco Gazzetta
2c4bbf659f More haddocks 2022-07-04 22:27:08 +02:00
Francesco Gazzetta
b5f10a6dab Export list 2022-07-03 18:54:00 +02:00
Francesco Gazzetta
34642bf965 Update some haddocks 2022-07-03 18:53:49 +02:00
Francesco Gazzetta
970e85a25c Add readme 2022-07-03 18:22:26 +02:00
Francesco Gazzetta
630a29e8c6 Fix function definition 2022-07-03 17:18:37 +02:00
14 changed files with 1031 additions and 89 deletions
Expand all files Collapse all files

20
.builds/all.yml
View File

@@ -29,6 +29,7 @@ tasks:
"$HOME/.ghcup/bin/ghcup" install ghc "ghc-8.10.7" "$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.0.2"
"$HOME/.ghcup/bin/ghcup" install ghc "ghc-9.2.2" "$HOME/.ghcup/bin/ghcup" install ghc "ghc-9.2.2"
"$HOME/.ghcup/bin/ghcup" install ghc "ghc-9.4.2"
cabal update cabal update
- 8_10_7-prepare: | - 8_10_7-prepare: |
cd qbe-hs cd qbe-hs
@@ -87,6 +88,25 @@ tasks:
- 9_2_2-haddock: | - 9_2_2-haddock: |
cd qbe-hs cd qbe-hs
cabal haddock all 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: triggers:
- action: email - action: email
condition: failure condition: failure

1
.envrc Normal file
View File

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

11
.gitea/workflows/build.yaml Normal file
View File

@@ -0,0 +1,11 @@
name: build
on: [push]
jobs:
build:
runs-on: nixos
steps:
- name: Check out repository code
uses: actions/checkout@v4
- name: build qbe-hs
run: nix build -L .

2
.gitignore vendored
View File

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

4
CHANGELOG.md
View File

@@ -1,5 +1,5 @@
# Revision history for qbe-hs # 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.

53
README.md Normal file
View File

@@ -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

616
flake.lock generated Normal file
View File

@@ -0,0 +1,616 @@
{
"nodes": {
"HTTP": {
"flake": false,
"locked": {
"lastModified": 1451647621,
"narHash": "sha256-oHIyw3x0iKBexEo49YeUDV1k74ZtyYKGR2gNJXXRxts=",
"owner": "phadej",
"repo": "HTTP",
"rev": "9bc0996d412fef1787449d841277ef663ad9a915",
"type": "github"
},
"original": {
"owner": "phadej",
"repo": "HTTP",
"type": "github"
}
},
"cabal-34": {
"flake": false,
"locked": {
"lastModified": 1645834128,
"narHash": "sha256-wG3d+dOt14z8+ydz4SL7pwGfe7SiimxcD/LOuPCV6xM=",
"owner": "haskell",
"repo": "cabal",
"rev": "5ff598c67f53f7c4f48e31d722ba37172230c462",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "3.4",
"repo": "cabal",
"type": "github"
}
},
"cabal-36": {
"flake": false,
"locked": {
"lastModified": 1669081697,
"narHash": "sha256-I5or+V7LZvMxfbYgZATU4awzkicBwwok4mVoje+sGmU=",
"owner": "haskell",
"repo": "cabal",
"rev": "8fd619e33d34924a94e691c5fea2c42f0fc7f144",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "3.6",
"repo": "cabal",
"type": "github"
}
},
"cardano-shell": {
"flake": false,
"locked": {
"lastModified": 1608537748,
"narHash": "sha256-PulY1GfiMgKVnBci3ex4ptk2UNYMXqGjJOxcPy2KYT4=",
"owner": "input-output-hk",
"repo": "cardano-shell",
"rev": "9392c75087cb9a3d453998f4230930dea3a95725",
"type": "github"
},
"original": {
"owner": "input-output-hk",
"repo": "cardano-shell",
"type": "github"
}
},
"flake-compat": {
"flake": false,
"locked": {
"lastModified": 1672831974,
"narHash": "sha256-z9k3MfslLjWQfnjBtEtJZdq3H7kyi2kQtUThfTgdRk0=",
"owner": "input-output-hk",
"repo": "flake-compat",
"rev": "45f2638735f8cdc40fe302742b79f248d23eb368",
"type": "github"
},
"original": {
"owner": "input-output-hk",
"ref": "hkm/gitlab-fix",
"repo": "flake-compat",
"type": "github"
}
},
"hackage": {
"flake": false,
"locked": {
"lastModified": 1776991436,
"narHash": "sha256-nR65DbgoJ8Qm8qEtqmVXzeWZS+cc3FeqaZgFon8qdtc=",
"owner": "input-output-hk",
"repo": "hackage.nix",
"rev": "2a5e0e1854e7f651ce13df74a60d7c2990a63528",
"type": "github"
},
"original": {
"owner": "input-output-hk",
"repo": "hackage.nix",
"type": "github"
}
},
"hackage-for-stackage": {
"flake": false,
"locked": {
"lastModified": 1776991429,
"narHash": "sha256-uiuvT6/wp2uNdtVl8kQ70WSyrye6EdRRQ+yor9kIJLU=",
"owner": "input-output-hk",
"repo": "hackage.nix",
"rev": "793f260668f3f8d34f64056e6941d234093fc51e",
"type": "github"
},
"original": {
"owner": "input-output-hk",
"ref": "for-stackage",
"repo": "hackage.nix",
"type": "github"
}
},
"hackage-internal": {
"flake": false,
"locked": {
"lastModified": 1750307553,
"narHash": "sha256-iiafNoeLHwlSLQTyvy8nPe2t6g5AV4PPcpMeH/2/DLs=",
"owner": "input-output-hk",
"repo": "hackage.nix",
"rev": "f7867baa8817fab296528f4a4ec39d1c7c4da4f3",
"type": "github"
},
"original": {
"owner": "input-output-hk",
"repo": "hackage.nix",
"type": "github"
}
},
"haskellNix": {
"inputs": {
"HTTP": "HTTP",
"cabal-34": "cabal-34",
"cabal-36": "cabal-36",
"cardano-shell": "cardano-shell",
"flake-compat": "flake-compat",
"hackage": "hackage",
"hackage-for-stackage": "hackage-for-stackage",
"hackage-internal": "hackage-internal",
"hls": "hls",
"hls-1.10": "hls-1.10",
"hls-2.0": "hls-2.0",
"hls-2.10": "hls-2.10",
"hls-2.11": "hls-2.11",
"hls-2.12": "hls-2.12",
"hls-2.2": "hls-2.2",
"hls-2.3": "hls-2.3",
"hls-2.4": "hls-2.4",
"hls-2.5": "hls-2.5",
"hls-2.6": "hls-2.6",
"hls-2.7": "hls-2.7",
"hls-2.8": "hls-2.8",
"hls-2.9": "hls-2.9",
"hpc-coveralls": "hpc-coveralls",
"iserv-proxy": "iserv-proxy",
"nixpkgs": [
"haskellNix",
"nixpkgs-unstable"
],
"nixpkgs-2305": "nixpkgs-2305",
"nixpkgs-2311": "nixpkgs-2311",
"nixpkgs-2405": "nixpkgs-2405",
"nixpkgs-2411": "nixpkgs-2411",
"nixpkgs-2505": "nixpkgs-2505",
"nixpkgs-2511": "nixpkgs-2511",
"nixpkgs-unstable": "nixpkgs-unstable",
"old-ghc-nix": "old-ghc-nix",
"stackage": "stackage"
},
"locked": {
"lastModified": 1776993036,
"narHash": "sha256-M770+TVYcqAlBAGWEi9HeljqNxujcNBlsNmZCwnxQaI=",
"owner": "input-output-hk",
"repo": "haskell.nix",
"rev": "902f9c7fee56b7550293dd691264f0c889e7af26",
"type": "github"
},
"original": {
"owner": "input-output-hk",
"repo": "haskell.nix",
"type": "github"
}
},
"hls": {
"flake": false,
"locked": {
"lastModified": 1741604408,
"narHash": "sha256-tuq3+Ip70yu89GswZ7DSINBpwRprnWnl6xDYnS4GOsc=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "682d6894c94087da5e566771f25311c47e145359",
"type": "github"
},
"original": {
"owner": "haskell",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-1.10": {
"flake": false,
"locked": {
"lastModified": 1680000865,
"narHash": "sha256-rc7iiUAcrHxwRM/s0ErEsSPxOR3u8t7DvFeWlMycWgo=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "b08691db779f7a35ff322b71e72a12f6e3376fd9",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "1.10.0.0",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.0": {
"flake": false,
"locked": {
"lastModified": 1687698105,
"narHash": "sha256-OHXlgRzs/kuJH8q7Sxh507H+0Rb8b7VOiPAjcY9sM1k=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "783905f211ac63edf982dd1889c671653327e441",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.0.0.1",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.10": {
"flake": false,
"locked": {
"lastModified": 1743069404,
"narHash": "sha256-q4kDFyJDDeoGqfEtrZRx4iqMVEC2MOzCToWsFY+TOzY=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "2318c61db3a01e03700bd4b05665662929b7fe8b",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.10.0.0",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.11": {
"flake": false,
"locked": {
"lastModified": 1747306193,
"narHash": "sha256-/MmtpF8+FyQlwfKHqHK05BdsxC9LHV70d/FiMM7pzBM=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "46ef4523ea4949f47f6d2752476239f1c6d806fe",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.11.0.0",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.12": {
"flake": false,
"locked": {
"lastModified": 1758709460,
"narHash": "sha256-xkI8MIIVEVARskfWbGAgP5sHG/lyeKnkm0LIOJ19X5w=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "7d983de4fa7ff54369f6dd31444bdb9869aec83e",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.12.0.0",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.2": {
"flake": false,
"locked": {
"lastModified": 1693064058,
"narHash": "sha256-8DGIyz5GjuCFmohY6Fa79hHA/p1iIqubfJUTGQElbNk=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "b30f4b6cf5822f3112c35d14a0cba51f3fe23b85",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.2.0.0",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.3": {
"flake": false,
"locked": {
"lastModified": 1695910642,
"narHash": "sha256-tR58doOs3DncFehHwCLczJgntyG/zlsSd7DgDgMPOkI=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "458ccdb55c9ea22cd5d13ec3051aaefb295321be",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.3.0.0",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.4": {
"flake": false,
"locked": {
"lastModified": 1699862708,
"narHash": "sha256-YHXSkdz53zd0fYGIYOgLt6HrA0eaRJi9mXVqDgmvrjk=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "54507ef7e85fa8e9d0eb9a669832a3287ffccd57",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.4.0.1",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.5": {
"flake": false,
"locked": {
"lastModified": 1701080174,
"narHash": "sha256-fyiR9TaHGJIIR0UmcCb73Xv9TJq3ht2ioxQ2mT7kVdc=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "27f8c3d3892e38edaef5bea3870161815c4d014c",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.5.0.0",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.6": {
"flake": false,
"locked": {
"lastModified": 1705325287,
"narHash": "sha256-+P87oLdlPyMw8Mgoul7HMWdEvWP/fNlo8jyNtwME8E8=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "6e0b342fa0327e628610f2711f8c3e4eaaa08b1e",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.6.0.0",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.7": {
"flake": false,
"locked": {
"lastModified": 1708965829,
"narHash": "sha256-LfJ+TBcBFq/XKoiNI7pc4VoHg4WmuzsFxYJ3Fu+Jf+M=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "50322b0a4aefb27adc5ec42f5055aaa8f8e38001",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.7.0.0",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.8": {
"flake": false,
"locked": {
"lastModified": 1715153580,
"narHash": "sha256-Vi/iUt2pWyUJlo9VrYgTcbRviWE0cFO6rmGi9rmALw0=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "dd1be1beb16700de59e0d6801957290bcf956a0a",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.8.0.0",
"repo": "haskell-language-server",
"type": "github"
}
},
"hls-2.9": {
"flake": false,
"locked": {
"lastModified": 1719993701,
"narHash": "sha256-wy348++MiMm/xwtI9M3vVpqj2qfGgnDcZIGXw8sF1sA=",
"owner": "haskell",
"repo": "haskell-language-server",
"rev": "90319a7e62ab93ab65a95f8f2bcf537e34dae76a",
"type": "github"
},
"original": {
"owner": "haskell",
"ref": "2.9.0.1",
"repo": "haskell-language-server",
"type": "github"
}
},
"hpc-coveralls": {
"flake": false,
"locked": {
"lastModified": 1607498076,
"narHash": "sha256-8uqsEtivphgZWYeUo5RDUhp6bO9j2vaaProQxHBltQk=",
"owner": "sevanspowell",
"repo": "hpc-coveralls",
"rev": "14df0f7d229f4cd2e79f8eabb1a740097fdfa430",
"type": "github"
},
"original": {
"owner": "sevanspowell",
"repo": "hpc-coveralls",
"type": "github"
}
},
"iserv-proxy": {
"flake": false,
"locked": {
"lastModified": 1775620557,
"narHash": "sha256-10x8/G0x3eR/++XRHPx4MBuqlnc6+N+ajIxXyLkG+nU=",
"owner": "stable-haskell",
"repo": "iserv-proxy",
"rev": "3f7b2815307c20a0dfd816bdf4a39ab86af3e0d4",
"type": "github"
},
"original": {
"owner": "stable-haskell",
"ref": "iserv-syms",
"repo": "iserv-proxy",
"type": "github"
}
},
"nixpkgs-2305": {
"locked": {
"lastModified": 1705033721,
"narHash": "sha256-K5eJHmL1/kev6WuqyqqbS1cdNnSidIZ3jeqJ7GbrYnQ=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "a1982c92d8980a0114372973cbdfe0a307f1bdea",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixpkgs-23.05-darwin",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs-2311": {
"locked": {
"lastModified": 1719957072,
"narHash": "sha256-gvFhEf5nszouwLAkT9nWsDzocUTqLWHuL++dvNjMp9I=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "7144d6241f02d171d25fba3edeaf15e0f2592105",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixpkgs-23.11-darwin",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs-2405": {
"locked": {
"lastModified": 1735564410,
"narHash": "sha256-HB/FA0+1gpSs8+/boEavrGJH+Eq08/R2wWNph1sM1Dg=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "1e7a8f391f1a490460760065fa0630b5520f9cf8",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixpkgs-24.05-darwin",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs-2411": {
"locked": {
"lastModified": 1751290243,
"narHash": "sha256-kNf+obkpJZWar7HZymXZbW+Rlk3HTEIMlpc6FCNz0Ds=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "5ab036a8d97cb9476fbe81b09076e6e91d15e1b6",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixpkgs-24.11-darwin",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs-2505": {
"locked": {
"lastModified": 1764560356,
"narHash": "sha256-M5aFEFPppI4UhdOxwdmceJ9bDJC4T6C6CzCK1E2FZyo=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "6c8f0cca84510cc79e09ea99a299c9bc17d03cb6",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixpkgs-25.05-darwin",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs-2511": {
"locked": {
"lastModified": 1775749320,
"narHash": "sha256-msT6frWJSQ2WR+0cpk+KPcZdLTLagUIsJwQwIX9JNSo=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "74b87959b2d16f59f54d8559cf3cf26b9d907949",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixpkgs-25.11-darwin",
"repo": "nixpkgs",
"type": "github"
}
},
"nixpkgs-unstable": {
"locked": {
"lastModified": 1775888245,
"narHash": "sha256-nwASzrRDD1JBEu/o8ekKYEXm/oJW6EMCzCRdrwcLe90=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "13043924aaa7375ce482ebe2494338e058282925",
"type": "github"
},
"original": {
"owner": "NixOS",
"ref": "nixpkgs-unstable",
"repo": "nixpkgs",
"type": "github"
}
},
"old-ghc-nix": {
"flake": false,
"locked": {
"lastModified": 1631092763,
"narHash": "sha256-sIKgO+z7tj4lw3u6oBZxqIhDrzSkvpHtv0Kki+lh9Fg=",
"owner": "angerman",
"repo": "old-ghc-nix",
"rev": "af48a7a7353e418119b6dfe3cd1463a657f342b8",
"type": "github"
},
"original": {
"owner": "angerman",
"ref": "master",
"repo": "old-ghc-nix",
"type": "github"
}
},
"root": {
"inputs": {
"haskellNix": "haskellNix",
"nixpkgs": [
"haskellNix",
"nixpkgs-unstable"
]
}
},
"stackage": {
"flake": false,
"locked": {
"lastModified": 1776990505,
"narHash": "sha256-PC/DD76TdzSvs18mL3O7V4wwt6WRHlzxmdrpKFwz68A=",
"owner": "input-output-hk",
"repo": "stackage.nix",
"rev": "c8e2fb3340b2316c84fede31ac01b5446fe2c880",
"type": "github"
},
"original": {
"owner": "input-output-hk",
"repo": "stackage.nix",
"type": "github"
}
}
},
"root": "root",
"version": 7
}

82
flake.nix Normal file
View File

@@ -0,0 +1,82 @@
{
inputs = {
haskellNix.url = "github:input-output-hk/haskell.nix";
# nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable";
nixpkgs.follows = "haskellNix/nixpkgs-unstable";
};
outputs = { self, nixpkgs, haskellNix, ... }@inputs:
let
supportedSystems = [
"aarch64-darwin" "aarch64-linux"
"x86_64-darwin" "x86_64-linux"
];
overlays = [
haskellNix.overlay
(final: _prev: {
# This overlay adds our project to pkgs
qbe-hs = final.haskell-nix.project' {
src = ./.;
compiler-nix-name = "ghc912";
# This is used by `nix develop .` to open a shell for use with
# `cabal`, `hlint` and `haskell-language-server`
shell.tools = {
cabal = {};
# hlint = {};
haskell-language-server = {};
};
# Non-Haskell shell tools go here
shell.buildInputs = with final; [
gcc
qbe
];
# passthru = { inherit (final) qbe; };
# This adds `js-unknown-ghcjs-cabal` to the shell.
# shell.crossPlatforms = p: [p.ghcjs];
};
})
];
each-system = f: nixpkgs.lib.genAttrs supportedSystems (system: f rec {
pkgs = import nixpkgs {
inherit system overlays;
};
inherit (pkgs) lib;
inherit system;
});
# haskell-flake
hf =
let
keys = [
"packages" "apps" "devShells"
"hydraJobs" "ciJobs" "checks"
];
in nixpkgs.lib.genAttrs keys
(k: each-system ({ pkgs, ... }: (pkgs.qbe-hs.flake {}).${k}));
in {
# Exposed as a REPL convenience.
_pkgs = each-system ({ pkgs, ... }: pkgs);
packages = each-system ({ pkgs, system, ... }:
hf.packages.${system} // {
default = hf.packages.${system}."qbe:lib:qbe";
});
devShells = each-system
({ pkgs, system, ... }: hf.devShells.${system});
};
nixConfig = {
extra-substituters = [
"https://cache.iog.io"
"https://cache.zw3rk.com"
];
extra-trusted-public-keys = [
"hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ="
"loony-tools:pr9m4BkM/5/eSTZlkQyRt57Jz7OMBxNSUiMC4FkcNfk="
];
allow-import-from-derivation = "true";
};
}

2
golden/data.qbe
View File

@@ -1,3 +1,3 @@
export export
data $d = align 8 data $d = align 8
{z 16, b $g + 32 "foo\nbar\NULbaz" -1} {z 16, b $g + 32 "foo\012bar\000baz" -1}

8
golden/function.qbe
View File

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

10
golden/hello_world.qbe
View File

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

23
qbe.cabal
View File

@@ -4,8 +4,9 @@ name: qbe
version: 1.1.0.0 version: 1.1.0.0
synopsis: Types and prettyprinter for the IL of the QBE compiler backend synopsis: Types and prettyprinter for the IL of the QBE compiler backend
description: description:
This library provides types representing the intermediate language of the QBE This library provides types representing
compiler backend. 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 It also provides pretty-printing instances based on
the [@prettyprinter@](https://hackage.haskell.org/package/prettyprinter) the [@prettyprinter@](https://hackage.haskell.org/package/prettyprinter)
library, that emit the textual representation of the IL. library, that emit the textual representation of the IL.
@@ -19,11 +20,13 @@ copyright: 2022 Francesco Gazzetta
category: Language category: Language
build-type: Simple build-type: Simple
extra-doc-files: CHANGELOG.md extra-doc-files: CHANGELOG.md
extra-source-files: golden/*.qbe extra-source-files: README.md golden/*.qbe
tested-with: tested-with:
, GHC == 8.10.7 , GHC == 8.10.7
, GHC == 9.0.2 , GHC == 9.0.2
, GHC == 9.2.2 , GHC == 9.2.2
, GHC == 9.4.2
, GHC == 9.10.3
source-repository head source-repository head
type: git type: git
@@ -51,12 +54,18 @@ library
build-depends: base ^>= 4.16.1.0 build-depends: base ^>= 4.16.1.0
|| ^>= 4.14 || ^>= 4.14
|| ^>= 4.15 || ^>= 4.15
|| ^>= 4.17
|| ^>= 4.20
|| ^>= 4.21
|| ^>= 4.22
, text ^>= 1.2.5 , text ^>= 1.2.5
|| ^>= 2.0 || ^>= 2.1.4
, text-short ^>= 0.1 , text-short >= 0.1 || ^>= 0.1.6.1
, bytestring ^>= 0.11.3 , bytestring ^>= 0.11.3
|| ^>= 0.12
, hashable ^>= 1.4.0 , hashable ^>= 1.4.0
, deepseq ^>= 1.4.4 || ^>= 1.5.0
, deepseq ^>= 1.4.4 || ^>= 1.5
, prettyprinter ^>= 1.7.1 , prettyprinter ^>= 1.7.1
hs-source-dirs: src hs-source-dirs: src
@@ -70,7 +79,7 @@ test-suite golden
, prettyprinter , prettyprinter
, filepath ^>= 1.4.2.2 , filepath ^>= 1.4.2.2
, tasty ^>= 1.4.2.3 , tasty ^>= 1.4.2.3
, tasty-silver ^>= 3.3.1.1 , tasty-silver ^>= 3.3.1.1 || ^>= 3.3.2.1
other-extensions: TypeApplications other-extensions: TypeApplications
OverloadedStrings OverloadedStrings
DataKinds DataKinds

262
src/Language/QBE.hs
View File

@@ -4,34 +4,116 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PatternSynonyms #-}
module Language.QBE where {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DuplicateRecordFields, NoFieldSelectors #-}
{-|
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 (Text)
import Data.Text.Short (ShortText) import Data.Text.Short (ShortText)
import qualified Data.Text.Short as TS import qualified Data.Text.Short as TS
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Internal (w2c)
import Data.Word (Word64) import Data.Word (Word64)
import Data.List.NonEmpty (NonEmpty, toList) import Data.List.NonEmpty (NonEmpty, toList)
import Data.Maybe (maybeToList) import Data.Maybe (maybeToList)
import Prettyprinter import Prettyprinter
( Pretty(pretty), Doc, (<+>), vsep, hsep, hang, punctuate, group, flatAlt ( Pretty(pretty), Doc, (<+>), vsep, hsep, hang, punctuate, group, flatAlt
, space, encloseSep, tupled, comma, equals, braces ) , space, encloseSep, tupled, comma, equals, braces, lbrace, rbrace, enclose )
-- Instances -- Instances
import Data.Hashable (Hashable) import Data.Hashable (Hashable)
import Control.DeepSeq (NFData) import Control.DeepSeq (NFData)
import Data.String (IsString) import Data.String (IsString)
import Data.Data (Data)
import Numeric (showOct)
import Data.Char (isPrint, isAscii)
-- * Identifiers -- * Identifiers
---------------- ----------------
-- | A raw identifier string, with no sigil information attached
type RawIdent = ShortText type RawIdent = ShortText
data Sigil -- | Sigils are used to differentiate the verious types of 'Ident'ifier.
= AggregateTy -- ^ @:@ data Sigil where
| Global -- ^ @$@ AggregateTy :: Sigil
| Temporary -- ^ @%@ Global :: Sigil
| Label -- ^ @\@@ Temporary :: Sigil
deriving (Show, Eq) Label :: Sigil
deriving (Show, Eq, Data)
-- | QBE identifiers. The sigil is represented at the type level, so that -- | QBE identifiers. The sigil is represented at the type level, so that
-- mixing incompatible identifiers is impossible. -- mixing incompatible identifiers is impossible.
@@ -50,7 +132,7 @@ data Sigil
-- In the second argument of ‘($)’, namely ‘Jmp $ Ident @'Global "a"’ -- In the second argument of ‘($)’, namely ‘Jmp $ Ident @'Global "a"’
-- In the expression: pretty $ Jmp $ Ident @'Global "a" -- In the expression: pretty $ Jmp $ Ident @'Global "a"
newtype Ident (t :: Sigil) = Ident RawIdent newtype Ident (t :: Sigil) = Ident RawIdent
deriving (Show, Eq, Ord, IsString, NFData, Hashable) deriving (Show, Eq, Ord, IsString, NFData, Hashable, Data)
instance Pretty (Ident 'AggregateTy) where instance Pretty (Ident 'AggregateTy) where
pretty (Ident raw) = pretty ':' <> pretty (TS.toText raw) pretty (Ident raw) = pretty ':' <> pretty (TS.toText raw)
@@ -64,8 +146,13 @@ instance Pretty (Ident 'Label) where
-- * Types -- * Types
---------- ----------
data BaseTy = Word | Long | Single | Double -- | Base types
deriving (Show, Eq) data BaseTy
= Word -- ^ @w@
| Long -- ^ @l@
| Single -- ^ @s@
| Double -- ^ @d@
deriving (Show, Eq, Data)
instance Pretty BaseTy where instance Pretty BaseTy where
pretty Word = pretty 'w' pretty Word = pretty 'w'
@@ -73,8 +160,12 @@ instance Pretty BaseTy where
pretty Single = pretty 's' pretty Single = pretty 's'
pretty Double = pretty 'd' pretty Double = pretty 'd'
data ExtTy = BaseTy BaseTy | Byte | HalfWord -- | Extended types
deriving (Show, Eq) data ExtTy
= BaseTy BaseTy
| Byte -- ^ @b@
| HalfWord -- ^ @h@
deriving (Show, Eq, Data)
instance Pretty ExtTy where instance Pretty ExtTy where
pretty (BaseTy baseTy) = pretty baseTy pretty (BaseTy baseTy) = pretty baseTy
@@ -84,17 +175,17 @@ instance Pretty ExtTy where
-- * Constants -- * Constants
-------------- --------------
-- | Constant/immediate
data Const data Const
-- MAYBE just use a signed type -- MAYBE just use a signed type
= CInt Bool Word64 -- ^ The 'Bool' is whether to negate = CInt Integer -- ^ Integer
| CSingle Float | CSingle Float -- ^ Single-precision float
| CDouble Double | CDouble Double -- ^ Double-precision float
| CGlobal (Ident 'Global) | CGlobal (Ident 'Global) -- ^ Global symbol
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty Const where instance Pretty Const where
pretty (CInt negative int) | negative = pretty '-' <> pretty int pretty (CInt int) = pretty int
| otherwise = pretty int
pretty (CSingle float) = "s_" <> pretty float pretty (CSingle float) = "s_" <> pretty float
pretty (CDouble double) = "d_" <> pretty double pretty (CDouble double) = "d_" <> pretty double
pretty (CGlobal ident) = pretty ident pretty (CGlobal ident) = pretty ident
@@ -103,9 +194,9 @@ instance Pretty Const where
------------ ------------
data Linkage data Linkage
= Export = Export -- ^ Marks the defined item as visible outside the current file's scope
| Section ShortText (Maybe Text) | Section ShortText (Maybe Text) -- ^ Section name, with optional linker flags
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty Linkage where instance Pretty Linkage where
pretty Export = "export" pretty Export = "export"
@@ -123,10 +214,11 @@ type Amount = Word64
-- ** Aggregate types -- ** Aggregate types
--------------------- ---------------------
-- | Aggregate type
data TypeDef data TypeDef
= TypeDef (Ident 'AggregateTy) (Maybe Alignment) [(SubTy, Maybe Amount)] = TypeDef (Ident 'AggregateTy) (Maybe Alignment) [(SubTy, Maybe Amount)]
| Opaque (Ident 'AggregateTy) Alignment Size | Opaque (Ident 'AggregateTy) Alignment Size
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty TypeDef where instance Pretty TypeDef where
pretty (TypeDef ident alignment def) = pretty (TypeDef ident alignment def) =
@@ -140,10 +232,11 @@ instance Pretty TypeDef where
"type" <+> pretty ident <+> equals "type" <+> pretty ident <+> equals
<+> "align" <+> pretty alignment <+> braces (pretty size) <+> "align" <+> pretty alignment <+> braces (pretty size)
-- | A type that can be part of an aggregate type
data SubTy data SubTy
= SubExtTy ExtTy = SubExtTy ExtTy
| SubAggregateTy (Ident 'AggregateTy) | SubAggregateTy (Ident 'AggregateTy)
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty SubTy where instance Pretty SubTy where
pretty (SubExtTy extTy) = pretty extTy pretty (SubExtTy extTy) = pretty extTy
@@ -152,8 +245,9 @@ instance Pretty SubTy where
-- ** Data -- ** Data
---------- ----------
-- | Global object definition
data DataDef = DataDef [Linkage] (Ident 'Global) (Maybe Alignment) [Field] data DataDef = DataDef [Linkage] (Ident 'Global) (Maybe Alignment) [Field]
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty DataDef where instance Pretty DataDef where
pretty (DataDef linkage ident alignment fields) = vsep pretty (DataDef linkage ident alignment fields) = vsep
@@ -167,18 +261,28 @@ data DataItem
= Symbol (Ident 'Global) (Maybe Alignment) = Symbol (Ident 'Global) (Maybe Alignment)
| String ByteString | String ByteString
| Const Const | Const Const
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty DataItem where instance Pretty DataItem where
pretty (Symbol ident alignment) = pretty (Symbol ident alignment) =
hsep $ pretty ident : maybeToList ((pretty '+' <+>) . pretty <$> alignment) hsep $ pretty ident : maybeToList ((pretty '+' <+>) . pretty <$> alignment)
pretty (String bs) = pretty $ show bs -- HACK: hoping that the escape sequences are the same... -- ~~HACK: hoping that the escape sequences are the same...~~
-- ↑ wrong bitch (it's undocumented; i don't blame you babe.)
pretty (String bs) =
enclose "\"" "\"" . pretty . showHexSequences . BS.unpack $ bs
where
showHexSequences =
foldr (\a acc -> char a <> acc) ""
char c
| isAscii (w2c c) && isPrint (w2c c) = [w2c c]
| otherwise = "\\" <> pad 3 (showOct c "")
pad n s = replicate (max 0 (n - length s)) '0' <> s
pretty (Const c) = pretty c pretty (Const c) = pretty c
data Field data Field
= FieldExtTy ExtTy (NonEmpty DataItem) = FieldExtTy ExtTy (NonEmpty DataItem)
| FieldZero Size | FieldZero Size
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty Field where instance Pretty Field where
pretty (FieldExtTy extTy items) = pretty extTy <+> hsep (toList $ pretty <$> items) pretty (FieldExtTy extTy items) = pretty extTy <+> hsep (toList $ pretty <$> items)
@@ -187,37 +291,51 @@ instance Pretty Field where
-- ** Functions -- ** Functions
--------------- ---------------
-- TODO use record syntax on long types like this one
-- | Function definition. The 'Maybe (Ident \'Temporary)' is the environment -- | Function definition. The 'Maybe (Ident \'Temporary)' is the environment
data FuncDef = FuncDef [Linkage] (Maybe AbiTy) (Ident 'Global) (Maybe (Ident 'Temporary)) [Param] Variadic (NonEmpty Block) data FuncDef = FuncDef
deriving (Show, Eq) { linkage :: [Linkage]
, returnType :: Maybe AbiTy
, name :: Ident 'Global
, env :: Maybe (Ident 'Temporary)
, params :: [Param]
, variadic :: Variadic
, code :: NonEmpty Block
}
deriving (Show, Eq, Data)
instance Pretty FuncDef where instance Pretty FuncDef where
pretty (FuncDef linkage abiTy ident env params variadic blocks) = vsep pretty (FuncDef linkage abiTy ident env params variadic blocks) = vsep
[ vsep $ pretty <$> linkage [ vsep $ pretty <$> linkage
, "function" <+> pretty abiTy <+> pretty ident , "function" <+> pretty abiTy <+> pretty ident <+> tupled (
, tupled $
maybeToList (("env" <+>) . pretty <$> env) maybeToList (("env" <+>) . pretty <$> env)
++ fmap pretty params ++ fmap pretty params
++ maybeToList (prettyVariadic variadic) ++ maybeToList (prettyVariadic variadic)
, braces $ vsep $ toList $ pretty <$> blocks ) <+> lbrace
, vsep $ toList $ pretty <$> blocks
, rbrace
] ]
data AbiTy = AbiBaseTy BaseTy | AbiAggregateTy (Ident 'AggregateTy) data AbiTy = AbiBaseTy BaseTy | AbiAggregateTy (Ident 'AggregateTy)
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty AbiTy where instance Pretty AbiTy where
pretty (AbiBaseTy baseTy) = pretty baseTy pretty (AbiBaseTy baseTy) = pretty baseTy
pretty (AbiAggregateTy ident) = pretty ident pretty (AbiAggregateTy ident) = pretty ident
-- | Function parameter
data Param = Param AbiTy (Ident 'Temporary) data Param = Param AbiTy (Ident 'Temporary)
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty Param where instance Pretty Param where
pretty (Param abiTy ident) = pretty abiTy <+> pretty ident pretty (Param abiTy ident) = pretty abiTy <+> pretty ident
-- | Indicates the presence or absence of a variadic marker
data Variadic = Variadic | NoVariadic data Variadic = Variadic | NoVariadic
deriving (Show, Eq) deriving (Show, Eq, Data)
-- | 'Variadic' → @Just "..."@
-- 'NoVariadic' → @Nothing@
prettyVariadic :: Variadic -> Maybe (Doc a) prettyVariadic :: Variadic -> Maybe (Doc a)
prettyVariadic Variadic = Just "..." prettyVariadic Variadic = Just "..."
prettyVariadic NoVariadic = Nothing prettyVariadic NoVariadic = Nothing
@@ -225,19 +343,26 @@ prettyVariadic NoVariadic = Nothing
-- * Control -- * Control
------------ ------------
-- | Value, either an immediate or a global or temporary identifier.
data Val data Val
= ValConst Const = ValConst Const
| ValTemporary (Ident 'Temporary) | ValTemporary (Ident 'Temporary)
| ValGlobal (Ident 'Global) | ValGlobal (Ident 'Global)
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty Val where instance Pretty Val where
pretty (ValConst c) = pretty c pretty (ValConst c) = pretty c
pretty (ValTemporary ident) = pretty ident pretty (ValTemporary ident) = pretty ident
pretty (ValGlobal ident) = pretty ident pretty (ValGlobal ident) = pretty ident
data Block = Block (Ident 'Label) [Phi] [Inst] Jump -- | Block of instructions beginning with a label and ending with a jump
deriving (Show, Eq) data Block = Block
{ label :: Ident 'Label
, phis :: [Phi]
, insts :: [Inst]
, jump :: Jump
}
deriving (Show, Eq, Data)
instance Pretty Block where instance Pretty Block where
pretty (Block ident phis insts jump) = hang 4 $ vsep $ concat pretty (Block ident phis insts jump) = hang 4 $ vsep $ concat
@@ -247,11 +372,12 @@ instance Pretty Block where
, [pretty jump] , [pretty jump]
] ]
-- | Jump instructions
data Jump data Jump
= Jmp (Ident 'Label) = Jmp (Ident 'Label) -- ^ Unconditional jump
| Jnz Val (Ident 'Label) (Ident 'Label) | Jnz Val (Ident 'Label) (Ident 'Label) -- ^ Conditional jump
| Ret (Maybe Val) | Ret (Maybe Val) -- ^ Function return
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty Jump where instance Pretty Jump where
pretty (Jmp ident) = "jmp" <+> pretty ident pretty (Jmp ident) = "jmp" <+> pretty ident
@@ -264,30 +390,39 @@ instance Pretty Jump where
-- * Instructions -- * Instructions
----------------- -----------------
-- MAYBE change [PhiArg] to Map (Ident 'Label) Val
-- | Phi instruction
data Phi = Phi Assignment [PhiArg] data Phi = Phi Assignment [PhiArg]
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty Phi where instance Pretty Phi where
pretty (Phi assignment args) = pretty (Phi assignment args) =
pretty assignment <+> "phi" <+> hsep (punctuate comma $ pretty <$> args) pretty assignment <+> "phi" <+> hsep (punctuate comma $ pretty <$> args)
-- | Phi instruction argument, associating a 'Val' to a 'Label'
data PhiArg = PhiArg (Ident 'Label) Val data PhiArg = PhiArg (Ident 'Label) Val
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty PhiArg where instance Pretty PhiArg where
pretty (PhiArg label val) = pretty label <+> pretty val pretty (PhiArg label val) = pretty label <+> pretty val
-- | Instruction
data Inst data Inst
-- Arithmetic and Bits -- Arithmetic and Bits
= BinaryOp Assignment BinaryOp Val Val = BinaryOp Assignment BinaryOp Val Val -- ^ Binary arithmetic and bit operations
| Neg Assignment Val | Neg Assignment Val -- ^ @neg@
-- Memory -- Memory
-- | @stored@/@stores@/@storel@/@storew@/@storeh@/@storeb@
| Store ExtTy Val Val | Store ExtTy Val Val
-- MAYBE collapse all the Loads in a single Load constructor and just discard -- MAYBE collapse all the Loads in a single Load constructor and just discard
-- the intrepr when unused. -- the intrepr when unused.
| Load Assignment BaseTy Val -- ^ @\<ident\> =\<baseTy\> load\<baseTy\> \<val\>@ -- | @loadw@/@loadl@/@loads@/@loadd@
| LoadW Assignment IntRepr Val -- ^ @\<ident\> =\<baseTy\> load\<intRepr\>w \<val\>@ | Load Assignment BaseTy Val
-- | @loadsw@/@loaduw@
| LoadW Assignment IntRepr Val
-- | @loadsh@/@loaduh@
| LoadH Assignment IntRepr Val | LoadH Assignment IntRepr Val
-- | @loadsb@/@loadub@
| LoadB Assignment IntRepr Val | LoadB Assignment IntRepr Val
-- Comparisons -- Comparisons
| Compare Assignment Comparison BaseTy Val Val | Compare Assignment Comparison BaseTy Val Val
@@ -313,15 +448,19 @@ data Inst
-- | @sltof@/@ultof@ -- | @sltof@/@ultof@
| LtoF Assignment IntRepr Val | LtoF Assignment IntRepr Val
-- Cast and Copy -- Cast and Copy
-- | @cast@
| Cast Assignment Val | Cast Assignment Val
-- | @copy@
| Copy Assignment Val | Copy Assignment Val
-- Calls -- 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] | Call (Maybe (Ident 'Temporary, AbiTy)) Val (Maybe Val) [Arg] [Arg]
-- Variadic -- Variadic
-- | @vastart@, initializes a variable argument list
| VaStart (Ident 'Temporary) | VaStart (Ident 'Temporary)
-- | @vaarg@, fetches the next argument from a variable argument list
| VaArg Assignment (Ident 'Temporary) | VaArg Assignment (Ident 'Temporary)
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty Inst where instance Pretty Inst where
pretty (BinaryOp assignment op v1 v2) = pretty (BinaryOp assignment op v1 v2) =
@@ -368,8 +507,9 @@ instance Pretty Inst where
pretty (VaStart argList) = "vastart" <+> pretty argList pretty (VaStart argList) = "vastart" <+> pretty argList
pretty (VaArg assignment argList) = pretty assignment <+> "vaarg" <+> 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 data Assignment = Assignment (Ident 'Temporary) BaseTy
deriving (Show, Eq) deriving (Show, Eq, Data)
-- | Infix synonym of 'Assignment' -- | Infix synonym of 'Assignment'
pattern (:=) :: Ident 'Temporary -> BaseTy -> Assignment pattern (:=) :: Ident 'Temporary -> BaseTy -> Assignment
@@ -378,9 +518,11 @@ pattern (:=) ident ty = Assignment ident ty
instance Pretty Assignment where instance Pretty Assignment where
pretty (Assignment ident ty) = pretty ident <+> equals <> pretty ty pretty (Assignment ident ty) = pretty ident <+> equals <> pretty ty
-- | Integer representation
data IntRepr = Signed | Unsigned data IntRepr = Signed | Unsigned
deriving (Show, Eq) deriving (Show, Eq, Data)
-- | Binary arithmetic and bit operations
data BinaryOp data BinaryOp
-- | @add@ -- | @add@
= Add = Add
@@ -405,7 +547,7 @@ data BinaryOp
| Shr | Shr
-- | @shl@ -- | @shl@
| Shl | Shl
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty BinaryOp where instance Pretty BinaryOp where
pretty Add = "add" pretty Add = "add"
@@ -437,7 +579,7 @@ data Comparison
-- Floating point only comparison -- Floating point only comparison
| O -- ^ ordered (no operand is a NaN) (floating point only) | O -- ^ ordered (no operand is a NaN) (floating point only)
| Uo -- ^ unordered (at least one operand is a NaN) (floating point only) | Uo -- ^ unordered (at least one operand is a NaN) (floating point only)
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty Comparison where instance Pretty Comparison where
pretty Eq = "eq" pretty Eq = "eq"
@@ -453,8 +595,9 @@ instance Pretty IntRepr where
pretty Signed = pretty 's' pretty Signed = pretty 's'
pretty Unsigned = pretty 'u' pretty Unsigned = pretty 'u'
-- | Function argument
data Arg = Arg AbiTy Val data Arg = Arg AbiTy Val
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty Arg where instance Pretty Arg where
pretty (Arg abiTy val) = pretty abiTy <+> pretty val pretty (Arg abiTy val) = pretty abiTy <+> pretty val
@@ -462,8 +605,9 @@ instance Pretty Arg where
-- * Program -- * Program
------------ ------------
-- | Datatypre representing a QBE IL source file
data Program = Program [TypeDef] [DataDef] [FuncDef] data Program = Program [TypeDef] [DataDef] [FuncDef]
deriving (Show, Eq) deriving (Show, Eq, Data)
instance Pretty Program where instance Pretty Program where
pretty (Program typeDefs dataDefs funcDefs) = vsep $ concat pretty (Program typeDefs dataDefs funcDefs) = vsep $ concat
@@ -475,7 +619,7 @@ instance Pretty Program where
-- * Utilities -- * Utilities
-------------- --------------
-- like 'list' and 'tupled' -- | Like 'list' and 'tupled', but with braces
braced :: [Doc ann] -> Doc ann braced :: [Doc ann] -> Doc ann
braced = group . encloseSep (flatAlt "{ " "{") braced = group . encloseSep (flatAlt "{ " "{")
(flatAlt " }" "}") (flatAlt " }" "}")

26
test/Main.hs
View File

@@ -6,8 +6,9 @@ module Main (main) where
import Language.QBE import Language.QBE
import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty (TestTree, testGroup)
import Test.Tasty.Silver (goldenVsAction) import Test.Tasty.Silver (goldenVsAction)
import Test.Tasty.Silver.Interactive (defaultMain)
import System.FilePath ((</>), (<.>)) import System.FilePath ((</>), (<.>))
import Prettyprinter (Pretty(pretty), layoutPretty, defaultLayoutOptions) import Prettyprinter (Pretty(pretty), layoutPretty, defaultLayoutOptions)
import Prettyprinter.Render.Text (renderStrict) import Prettyprinter.Render.Text (renderStrict)
@@ -31,8 +32,8 @@ goldenTests = testGroup "golden tests"
] ]
, t "type" ([Word, Long, Single, Double], [BaseTy Word, Byte, HalfWord]) , t "type" ([Word, Long, Single, Double], [BaseTy Word, Byte, HalfWord])
, t "const" , t "const"
[ CInt True 1 [ CInt (-1)
, CInt False 2 , CInt 2
, CSingle 0.1 , CSingle 0.1
, CDouble (-0.2) , CDouble (-0.2)
, CGlobal "global" , CGlobal "global"
@@ -45,17 +46,17 @@ goldenTests = testGroup "golden tests"
, t "opaque" $ Opaque "t" 8 16 , t "opaque" $ Opaque "t" 8 16
, t "data" $ DataDef [Export] "d" (Just 8) , t "data" $ DataDef [Export] "d" (Just 8)
[ FieldZero 16 [ FieldZero 16
, FieldExtTy Byte $ Symbol "g" (Just 32) :| [String "foo\nbar\0baz", Const $ CInt True 1] , FieldExtTy Byte $ Symbol "g" (Just 32) :| [String "foo\nbar\0baz", Const $ CInt (-1)]
] ]
, t "function" $ FuncDef [Export] (Just $ AbiAggregateTy "t") "f" , t "function" $ FuncDef [Export] (Just $ AbiAggregateTy "t") "f"
(Just "env") [Param (AbiBaseTy Word) "a", Param (AbiBaseTy Double) "b"] Variadic $ (Just "env") [Param (AbiBaseTy Word) "a", Param (AbiBaseTy Double) "b"] Variadic $
Block "l" [] [] (Ret Nothing) :| [] Block "l" [] [] (Ret Nothing) :| []
, t "val" [valInt 0, ValTemporary "temporary", ValGlobal "global"] , t "val" [valInt 0, ValTemporary "temporary", ValConst (CGlobal "global")]
, t "jmp" $ Jmp "target" , t "jmp" $ Jmp "target"
, t "jnz" $ Jnz (valInt 0) "target1" "target2" , t "jnz" $ Jnz (valInt 0) "target1" "target2"
, t "ret" $ Ret $ Just $ ValTemporary "x" , t "ret" $ Ret $ Just $ ValTemporary "x"
, t "phi" $ Phi (Assignment "a" Word) [PhiArg "b" $ valInt 1, PhiArg "c" $ valInt 2] , t "phi" $ Phi (Assignment "a" Word) [PhiArg "b" $ valInt 1, PhiArg "c" $ valInt 2]
, t "call" $ Call (Just ("r", AbiBaseTy Word)) (ValGlobal "f") (Just $ valInt 1) , t "call" $ Call (Just ("r", AbiBaseTy Word)) (ValConst (CGlobal "f")) (Just $ valInt 1)
[Arg (AbiBaseTy Word) $ valInt 2, Arg (AbiAggregateTy "t") $ ValTemporary "a"] [Arg (AbiBaseTy Word) $ valInt 2, Arg (AbiAggregateTy "t") $ ValTemporary "a"]
[Arg (AbiBaseTy Word) $ valInt 3, Arg (AbiAggregateTy "t1") $ ValTemporary "b"] [Arg (AbiBaseTy Word) $ valInt 3, Arg (AbiAggregateTy "t1") $ ValTemporary "b"]
, t "inst" $ Block "l" [] , t "inst" $ Block "l" []
@@ -92,8 +93,7 @@ goldenTests = testGroup "golden tests"
(renderStrict . layoutPretty defaultLayoutOptions) (renderStrict . layoutPretty defaultLayoutOptions)
valInt :: Int -> Val valInt :: Int -> Val
valInt i | i >= 0 = ValConst $ CInt False $ fromIntegral i valInt i = ValConst $ CInt $ fromIntegral i
| otherwise = ValConst $ CInt True $ fromIntegral $ negate i
one, two :: Val one, two :: Val
one = valInt 1 one = valInt 1
@@ -107,12 +107,16 @@ helloWorld = Program [] [helloString] [helloMain]
where where
helloString = DataDef [] "str" Nothing helloString = DataDef [] "str" Nothing
[ FieldExtTy Byte $ String "hello world" :| [] [ FieldExtTy Byte $ String "hello world" :| []
, FieldExtTy Byte $ Const (CInt False 0) :| [] , FieldExtTy Byte $ Const (CInt 0) :| []
] ]
helloMain = FuncDef [Export] (Just $ AbiBaseTy Word) "main" helloMain = FuncDef [Export] (Just $ AbiBaseTy Word) "main"
Nothing [] NoVariadic $ Nothing [] NoVariadic $
Block "start" Block "start"
[] []
[Call (Just ("r", AbiBaseTy Word)) (ValGlobal "puts") Nothing [Arg (AbiBaseTy Long) $ ValGlobal "str"] []] [ Call (Just ("r", AbiBaseTy Word)) (ValConst (CGlobal "puts"))
(Ret $ Just $ ValConst $ CInt False 0) Nothing
[Arg (AbiBaseTy Long) $ ValConst (CGlobal "str")]
[]
]
(Ret $ Just $ ValConst $ CInt 0)
:| [] :| []