Compare commits
36 Commits
45c1d41bde
...
main
| Author | SHA1 | Date | |
|---|---|---|---|
|
03161b228b
|
|||
|
b9fc9c2845
|
|||
|
1c5cadd263
|
|||
|
d5c7e2826f
|
|||
|
cf7d0320af
|
|||
|
1be6175120
|
|||
|
78bfec0953
|
|||
|
bd4a6f5092
|
|||
|
b95b095dc8
|
|||
|
f82d5fbff7
|
|||
|
1d91d7a39d
|
|||
|
bd7f614d23
|
|||
|
f4906899ee
|
|||
|
d66f1e1401
|
|||
|
c47f713a0d
|
|||
|
c1fd18d525
|
|||
|
fd16a12e7c
|
|||
|
b013ba0e55
|
|||
|
3d17813eb4
|
|||
|
5a63229e74
|
|||
|
d53362f882
|
|||
|
fe335fa16e
|
|||
|
24cc7d08d9
|
|||
|
f990373f22
|
|||
|
891cd41e46
|
|||
|
afe6b6dd59
|
|||
|
5d9b956883
|
|||
|
892658de78
|
|||
|
898160d611
|
|||
|
2819b7fc57
|
|||
|
37cf2fe339
|
|||
|
d558831984
|
|||
| 6a9f272cac | |||
| aa48976e31 | |||
|
923da9e747
|
|||
|
fd1cf69787
|
27
.gitignore
vendored
Normal file
27
.gitignore
vendored
Normal file
@@ -0,0 +1,27 @@
|
|||||||
|
dist
|
||||||
|
dist-*
|
||||||
|
cabal-dev
|
||||||
|
*.o
|
||||||
|
*.hi
|
||||||
|
*.hie
|
||||||
|
*.chi
|
||||||
|
*.chs.h
|
||||||
|
*.dyn_o
|
||||||
|
*.dyn_hi
|
||||||
|
.hpc
|
||||||
|
.hsenv
|
||||||
|
.cabal-sandbox/
|
||||||
|
cabal.sandbox.config
|
||||||
|
*.prof
|
||||||
|
*.aux
|
||||||
|
*.hp
|
||||||
|
*.eventlog
|
||||||
|
.stack-work/
|
||||||
|
cabal.project.local
|
||||||
|
cabal.project.local~
|
||||||
|
.HTF/
|
||||||
|
.ghc.environment.*
|
||||||
|
|
||||||
|
# Windows12 output files
|
||||||
|
*.ll
|
||||||
|
*.s
|
||||||
26
README.md
Normal file
26
README.md
Normal file
@@ -0,0 +1,26 @@
|
|||||||
|
# Windows12
|
||||||
|
A C-like compiled programming language implemented in Haskell.
|
||||||
|
|
||||||
|
## Examples
|
||||||
|
Example programs can be found in the `test` directory.
|
||||||
|
|
||||||
|
## Usage
|
||||||
|
Note: You must have version 9.0 of the Haskell compiler GHC installed. Otherwise
|
||||||
|
Cabal will not be able to obtain the necessary dependencies.
|
||||||
|
|
||||||
|
It is recommended to use the provided `shell.nix` file to create the proper
|
||||||
|
environment. Alternatively, you can run the project from the supplied
|
||||||
|
binaries in the [releases](https://gitea.mregirouard.com/eta357/Windows-12-Compiler/releases)
|
||||||
|
section.
|
||||||
|
|
||||||
|
```shell
|
||||||
|
cabal run windows12 <input file> out.ll
|
||||||
|
llc out.ll -o out.s
|
||||||
|
gcc out.s -o out
|
||||||
|
./out
|
||||||
|
```
|
||||||
|
|
||||||
|
## Running Tests
|
||||||
|
```shell
|
||||||
|
cabal run windows12-qc
|
||||||
|
```
|
||||||
7
cabal.project
Normal file
7
cabal.project
Normal file
@@ -0,0 +1,7 @@
|
|||||||
|
-- Needed to get a working version of llvm-hs-pretty
|
||||||
|
-- The one on hackage is broken with this version of GHC
|
||||||
|
source-repository-package
|
||||||
|
type: git
|
||||||
|
location: https://github.com/rumkeller/llvm-hs-pretty.git
|
||||||
|
|
||||||
|
packages: ./windows12.cabal
|
||||||
61
flake.lock
generated
Normal file
61
flake.lock
generated
Normal file
@@ -0,0 +1,61 @@
|
|||||||
|
{
|
||||||
|
"nodes": {
|
||||||
|
"flake-utils": {
|
||||||
|
"inputs": {
|
||||||
|
"systems": "systems"
|
||||||
|
},
|
||||||
|
"locked": {
|
||||||
|
"lastModified": 1731533236,
|
||||||
|
"narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
|
||||||
|
"owner": "numtide",
|
||||||
|
"repo": "flake-utils",
|
||||||
|
"rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
|
||||||
|
"type": "github"
|
||||||
|
},
|
||||||
|
"original": {
|
||||||
|
"owner": "numtide",
|
||||||
|
"repo": "flake-utils",
|
||||||
|
"type": "github"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"nixpkgs": {
|
||||||
|
"locked": {
|
||||||
|
"lastModified": 1756469547,
|
||||||
|
"narHash": "sha256-YvtD2E7MYsQ3r7K9K2G7nCslCKMPShoSEAtbjHLtH0k=",
|
||||||
|
"owner": "nixos",
|
||||||
|
"repo": "nixpkgs",
|
||||||
|
"rev": "41d292bfc37309790f70f4c120b79280ce40af16",
|
||||||
|
"type": "github"
|
||||||
|
},
|
||||||
|
"original": {
|
||||||
|
"owner": "nixos",
|
||||||
|
"ref": "nixos-25.05",
|
||||||
|
"repo": "nixpkgs",
|
||||||
|
"type": "github"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"root": {
|
||||||
|
"inputs": {
|
||||||
|
"flake-utils": "flake-utils",
|
||||||
|
"nixpkgs": "nixpkgs"
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"systems": {
|
||||||
|
"locked": {
|
||||||
|
"lastModified": 1681028828,
|
||||||
|
"narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
|
||||||
|
"owner": "nix-systems",
|
||||||
|
"repo": "default",
|
||||||
|
"rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
|
||||||
|
"type": "github"
|
||||||
|
},
|
||||||
|
"original": {
|
||||||
|
"owner": "nix-systems",
|
||||||
|
"repo": "default",
|
||||||
|
"type": "github"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
},
|
||||||
|
"root": "root",
|
||||||
|
"version": 7
|
||||||
|
}
|
||||||
24
flake.nix
Normal file
24
flake.nix
Normal file
@@ -0,0 +1,24 @@
|
|||||||
|
{
|
||||||
|
inputs = {
|
||||||
|
nixpkgs.url = "github:nixos/nixpkgs/nixos-25.05";
|
||||||
|
flake-utils.url = "github:numtide/flake-utils";
|
||||||
|
};
|
||||||
|
|
||||||
|
outputs = { self, nixpkgs, flake-utils, ... }@inputs:
|
||||||
|
flake-utils.lib.eachDefaultSystem (system:
|
||||||
|
let
|
||||||
|
pkgs = import nixpkgs {
|
||||||
|
inherit system;
|
||||||
|
};
|
||||||
|
in
|
||||||
|
{
|
||||||
|
devShells.default = pkgs.mkShell {
|
||||||
|
buildInputs = with pkgs; [
|
||||||
|
haskell.compiler.ghc90
|
||||||
|
cabal-install
|
||||||
|
llvm_18
|
||||||
|
];
|
||||||
|
};
|
||||||
|
}
|
||||||
|
);
|
||||||
|
}
|
||||||
27
src/Main.hs
27
src/Main.hs
@@ -1,4 +1,29 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
|
import qualified Data.Text.IO as T
|
||||||
|
import qualified Data.Text.Lazy.IO as TL
|
||||||
|
import Data.Text.Lazy (toStrict, unpack)
|
||||||
|
import Data.String.Conversions (cs)
|
||||||
|
import Data.Text.Prettyprint.Doc (pretty)
|
||||||
|
import Text.Megaparsec (parse)
|
||||||
|
import Windows12.Parser (programP)
|
||||||
|
import System.Environment (getArgs)
|
||||||
|
import LLVM.Pretty
|
||||||
|
import Windows12.Ast
|
||||||
|
import Windows12.CodeGen (codegen)
|
||||||
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = putStrLn "Hello, Haskell!"
|
main = do
|
||||||
|
args <- getArgs
|
||||||
|
|
||||||
|
if length args /= 2
|
||||||
|
then putStrLn "Usage: windows12 <input file> <output file>"
|
||||||
|
else do
|
||||||
|
let [inputFile, outputFile] = args
|
||||||
|
test <- T.readFile inputFile
|
||||||
|
case parse programP inputFile test of
|
||||||
|
Left err -> print err
|
||||||
|
Right ast -> TL.writeFile outputFile (ppllvm (codegen (cs inputFile) ast))
|
||||||
|
|||||||
102
src/QuickCheckTests.hs
Normal file
102
src/QuickCheckTests.hs
Normal file
@@ -0,0 +1,102 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module Main where
|
||||||
|
|
||||||
|
import Test.QuickCheck
|
||||||
|
|
||||||
|
import Windows12.Ast
|
||||||
|
import Windows12.Parser (programP)
|
||||||
|
import Text.Megaparsec (parse)
|
||||||
|
|
||||||
|
import Data.String.Conversions (cs)
|
||||||
|
|
||||||
|
import Data.Text
|
||||||
|
import Data.Text.Internal
|
||||||
|
import Data.Text.Prettyprint.Doc (pretty)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = quickCheck prop_print_parse
|
||||||
|
|
||||||
|
-- Ensure that pretty-printing and parsing are inverses
|
||||||
|
prop_print_parse :: Program -> Bool
|
||||||
|
prop_print_parse p = Right p == (parse programP "" (cs (show (pretty p))))
|
||||||
|
|
||||||
|
instance Arbitrary Data.Text.Internal.Text where
|
||||||
|
arbitrary = listOf1 (elements ['a'..'z']) >>= return . Data.Text.pack
|
||||||
|
|
||||||
|
instance Arbitrary BinOp where
|
||||||
|
arbitrary = elements [Add, Sub, Mul, Div, Mod, Eq, Ne, Lt, Gt, Le, Ge, And, Or,
|
||||||
|
BitAnd, BitOr, BitXor, ShiftL, ShiftR]
|
||||||
|
|
||||||
|
instance Arbitrary UnOp where
|
||||||
|
arbitrary = elements [Neg, Not, BitNot]
|
||||||
|
|
||||||
|
instance Arbitrary AssignOp where
|
||||||
|
arbitrary = elements [BaseAssign, AddAssign, SubAssign, MulAssign, DivAssign,
|
||||||
|
ModAssign, BitAndAssign, BitOrAssign, BitXorAssign, ShiftLAssign, ShiftRAssign]
|
||||||
|
|
||||||
|
instance Arbitrary LVal where
|
||||||
|
arbitrary = oneof
|
||||||
|
[ LId <$> arbitrary
|
||||||
|
, LIndex <$> arbitrary <*> arbitrary
|
||||||
|
, LDeref <$> arbitrary
|
||||||
|
, LMember <$> arbitrary <*> arbitrary
|
||||||
|
]
|
||||||
|
|
||||||
|
instance Arbitrary Expr where
|
||||||
|
arbitrary = oneof
|
||||||
|
[ Id <$> arbitrary
|
||||||
|
, IntLit <$> arbitrary
|
||||||
|
, UIntLit <$> arbitrary
|
||||||
|
, FloatLit <$> arbitrary
|
||||||
|
, StrLit <$> arbitrary
|
||||||
|
, BoolLit <$> arbitrary
|
||||||
|
, CharLit <$> arbitrary
|
||||||
|
, BinOp <$> arbitrary <*> arbitrary <*> arbitrary
|
||||||
|
, UnOp <$> arbitrary <*> arbitrary
|
||||||
|
, Call <$> arbitrary <*> arbitrary
|
||||||
|
, Index <$> arbitrary <*> arbitrary
|
||||||
|
, Member <$> arbitrary <*> arbitrary
|
||||||
|
, Cast <$> arbitrary <*> arbitrary
|
||||||
|
, Sizeof <$> arbitrary
|
||||||
|
, StructInit <$> arbitrary <*> arbitrary
|
||||||
|
]
|
||||||
|
|
||||||
|
instance Arbitrary Stmt where
|
||||||
|
arbitrary = oneof
|
||||||
|
[ Expr <$> arbitrary
|
||||||
|
, Return <$> arbitrary
|
||||||
|
, If <$> arbitrary <*> arbitrary <*> arbitrary
|
||||||
|
, While <$> arbitrary <*> arbitrary
|
||||||
|
, Assign <$> arbitrary <*> arbitrary <*> arbitrary
|
||||||
|
, Block <$> arbitrary
|
||||||
|
, Var <$> arbitrary <*> arbitrary <*> arbitrary
|
||||||
|
]
|
||||||
|
|
||||||
|
-- Massively simplified types: No pointers, void, structs, enums
|
||||||
|
instance Arbitrary Type where
|
||||||
|
arbitrary = elements [IntType, UIntType, FloatType, StrType, BoolType,
|
||||||
|
CharType, PtrType IntType, ArrayType IntType]
|
||||||
|
|
||||||
|
instance Arbitrary Bind where
|
||||||
|
arbitrary = Bind <$> arbitrary <*> arbitrary
|
||||||
|
|
||||||
|
instance Arbitrary TLStruct where
|
||||||
|
arbitrary = Struct <$> arbitrary <*> arbitrary
|
||||||
|
|
||||||
|
-- ensure the enum has at least one field
|
||||||
|
instance Arbitrary TLEnum where
|
||||||
|
arbitrary = Enum <$> arbitrary <*> listOf1 arbitrary
|
||||||
|
|
||||||
|
instance Arbitrary TLFunc where
|
||||||
|
arbitrary = Func <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
|
||||||
|
|
||||||
|
instance Arbitrary TL where
|
||||||
|
arbitrary = oneof
|
||||||
|
[ TLStruct <$> arbitrary
|
||||||
|
, TLEnum <$> arbitrary
|
||||||
|
, TLFunc <$> arbitrary
|
||||||
|
]
|
||||||
|
|
||||||
|
instance Arbitrary Program where
|
||||||
|
arbitrary = Program <$> arbitrary <*> arbitrary <*> arbitrary
|
||||||
6
src/Windows12.hs
Normal file
6
src/Windows12.hs
Normal file
@@ -0,0 +1,6 @@
|
|||||||
|
module Windows12 where
|
||||||
|
|
||||||
|
import Windows12.Ast
|
||||||
|
import Windows12.Lexer
|
||||||
|
import Windows12.Parser
|
||||||
|
import Windows12.CodeGen
|
||||||
229
src/Windows12/Ast.hs
Normal file
229
src/Windows12/Ast.hs
Normal file
@@ -0,0 +1,229 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module Windows12.Ast where
|
||||||
|
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Data.Text.Prettyprint.Doc
|
||||||
|
|
||||||
|
data BinOp
|
||||||
|
= Add
|
||||||
|
| Sub
|
||||||
|
| Mul
|
||||||
|
| Div
|
||||||
|
| Mod
|
||||||
|
| Eq
|
||||||
|
| Ne
|
||||||
|
| Lt
|
||||||
|
| Gt
|
||||||
|
| Le
|
||||||
|
| Ge
|
||||||
|
| And
|
||||||
|
| Or
|
||||||
|
| BitAnd
|
||||||
|
| BitOr
|
||||||
|
| BitXor
|
||||||
|
| ShiftL
|
||||||
|
| ShiftR
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data UnOp
|
||||||
|
= Neg
|
||||||
|
| Not
|
||||||
|
| BitNot
|
||||||
|
| Deref
|
||||||
|
| AddrOf
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data AssignOp
|
||||||
|
= BaseAssign
|
||||||
|
| AddAssign
|
||||||
|
| SubAssign
|
||||||
|
| MulAssign
|
||||||
|
| DivAssign
|
||||||
|
| ModAssign
|
||||||
|
| BitAndAssign
|
||||||
|
| BitOrAssign
|
||||||
|
| BitXorAssign
|
||||||
|
| ShiftLAssign
|
||||||
|
| ShiftRAssign
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data LVal
|
||||||
|
= LId Text
|
||||||
|
| LIndex Expr Expr
|
||||||
|
| LDeref Expr
|
||||||
|
| LMember Expr Text
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data Expr
|
||||||
|
= Id Text
|
||||||
|
| IntLit Int
|
||||||
|
| UIntLit Word
|
||||||
|
| FloatLit Double
|
||||||
|
| StrLit Text
|
||||||
|
| BoolLit Bool
|
||||||
|
| CharLit Char
|
||||||
|
| BinOp BinOp Expr Expr
|
||||||
|
| UnOp UnOp Expr
|
||||||
|
| Call Expr [Expr]
|
||||||
|
| Index Expr Expr
|
||||||
|
| Member Expr Text
|
||||||
|
| Cast Type Expr
|
||||||
|
| Sizeof Type
|
||||||
|
| StructInit Text [(Text, Expr)]
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data Stmt
|
||||||
|
= Expr Expr
|
||||||
|
| Return Expr
|
||||||
|
| If Expr [Stmt] (Maybe [Stmt])
|
||||||
|
| While Expr [Stmt]
|
||||||
|
| Assign AssignOp LVal Expr
|
||||||
|
| Block [Stmt]
|
||||||
|
| Var Text (Maybe Type) (Maybe Expr)
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data Type
|
||||||
|
= IntType
|
||||||
|
| UIntType
|
||||||
|
| FloatType
|
||||||
|
| StrType
|
||||||
|
| BoolType
|
||||||
|
| CharType
|
||||||
|
| PtrType Type
|
||||||
|
| ArrayType Type
|
||||||
|
| StructType Text
|
||||||
|
| EnumType Text
|
||||||
|
| VoidType
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data Bind = Bind {bindName :: Text, bindType :: Type}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data TLStruct = Struct {structName :: Text, structFields :: [Bind]}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data TLEnum = Enum {enumName :: Text, enumFields :: [Text]}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data TLFunc = Func {funcName :: Text, funcArgs :: [Bind], funcRetType :: Type, funcBody :: [Stmt]}
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data TL = TLStruct TLStruct | TLEnum TLEnum | TLFunc TLFunc
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data Program = Program [TLStruct] [TLEnum] [TLFunc]
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
-- Pretty printing
|
||||||
|
instance Pretty BinOp where
|
||||||
|
pretty Add = "+"
|
||||||
|
pretty Sub = "-"
|
||||||
|
pretty Mul = "*"
|
||||||
|
pretty Div = "/"
|
||||||
|
pretty Mod = "%"
|
||||||
|
pretty Eq = "=="
|
||||||
|
pretty Ne = "!="
|
||||||
|
pretty Lt = "<"
|
||||||
|
pretty Gt = ">"
|
||||||
|
pretty Le = "<="
|
||||||
|
pretty Ge = ">="
|
||||||
|
pretty And = "&&"
|
||||||
|
pretty Or = "||"
|
||||||
|
pretty BitAnd = "&"
|
||||||
|
pretty BitOr = "|"
|
||||||
|
pretty BitXor = "^"
|
||||||
|
pretty ShiftL = "<<"
|
||||||
|
pretty ShiftR = ">>"
|
||||||
|
|
||||||
|
instance Pretty UnOp where
|
||||||
|
pretty Neg = "-"
|
||||||
|
pretty Not = "!"
|
||||||
|
pretty BitNot = "~"
|
||||||
|
pretty Deref = "*"
|
||||||
|
pretty AddrOf = "&"
|
||||||
|
|
||||||
|
instance Pretty AssignOp where
|
||||||
|
pretty BaseAssign = "="
|
||||||
|
pretty AddAssign = "+="
|
||||||
|
pretty SubAssign = "-="
|
||||||
|
pretty MulAssign = "*="
|
||||||
|
pretty DivAssign = "/="
|
||||||
|
pretty ModAssign = "%="
|
||||||
|
pretty BitAndAssign = "&="
|
||||||
|
pretty BitOrAssign = "|="
|
||||||
|
pretty BitXorAssign = "^="
|
||||||
|
pretty ShiftLAssign = "<<="
|
||||||
|
pretty ShiftRAssign = ">>="
|
||||||
|
|
||||||
|
instance Pretty LVal where
|
||||||
|
pretty (LId x) = pretty (Id x)
|
||||||
|
pretty (LIndex arr idx) = pretty (Index arr idx)
|
||||||
|
pretty (LDeref e) = pretty (UnOp Deref e)
|
||||||
|
pretty (LMember e m) = pretty (Member e m)
|
||||||
|
|
||||||
|
instance Pretty Expr where
|
||||||
|
pretty (Id x) = pretty x
|
||||||
|
pretty (IntLit x) = pretty x
|
||||||
|
pretty (UIntLit x) = pretty x
|
||||||
|
pretty (FloatLit x) = pretty x
|
||||||
|
pretty (StrLit x) = dquotes (pretty x)
|
||||||
|
pretty (BoolLit x) = pretty x
|
||||||
|
pretty (CharLit x) = squotes (pretty x)
|
||||||
|
pretty (BinOp op l r) = parens (pretty l <+> pretty op <+> pretty r)
|
||||||
|
pretty (UnOp op e) = pretty op <> parens (pretty e)
|
||||||
|
pretty (Call f args) = parens (pretty f) <> parens (hsep (punctuate comma (map pretty args)))
|
||||||
|
pretty (Index arr idx) = parens (pretty arr) <> brackets (pretty idx)
|
||||||
|
pretty (Member e m) = pretty e <> "." <> pretty m
|
||||||
|
pretty (Cast t e) = parens (pretty t) <> parens (pretty e)
|
||||||
|
pretty (Sizeof t) = "sizeof " <> pretty t
|
||||||
|
pretty (StructInit s fields) = pretty s <+> lbrace <> line <> indent 4 (vsep (punctuate comma (map (\(n, e) -> pretty n <+> "=" <+> pretty e) fields))) <> line <> rbrace
|
||||||
|
|
||||||
|
instance Pretty Stmt where
|
||||||
|
pretty (Expr e) = pretty e <> semi
|
||||||
|
pretty (Return e) = "return" <+> pretty e <> semi
|
||||||
|
pretty (If cond t f) = "if" <+> pretty cond <+> prettyBlock t <+> maybe "" (\f' -> "else" <+> prettyBlock f') f
|
||||||
|
pretty (While cond body) = "while" <+> pretty cond <+> prettyBlock body
|
||||||
|
pretty (Assign op l r) = pretty l <+> pretty op <+> pretty r <> semi
|
||||||
|
pretty (Block stmts) = braces (vsep (map pretty stmts))
|
||||||
|
pretty (Var n t e) = pretty n <+> maybe "" (\t' -> ":" <+> pretty t') t <+> maybe "" (\e' -> "=" <+> pretty e') e <> semi
|
||||||
|
|
||||||
|
instance Pretty Type where
|
||||||
|
pretty IntType = "int"
|
||||||
|
pretty UIntType = "uint"
|
||||||
|
pretty FloatType = "float"
|
||||||
|
pretty StrType = "str"
|
||||||
|
pretty BoolType = "bool"
|
||||||
|
pretty CharType = "char"
|
||||||
|
pretty (PtrType t) = pretty t <> "*"
|
||||||
|
pretty (ArrayType t) = "[" <> pretty t <> "]"
|
||||||
|
pretty (StructType s) = pretty s
|
||||||
|
pretty (EnumType e) = pretty e
|
||||||
|
pretty VoidType = "void"
|
||||||
|
|
||||||
|
instance Pretty Bind where
|
||||||
|
pretty (Bind n t) = pretty n <+> ":" <+> pretty t
|
||||||
|
|
||||||
|
instance Pretty TLStruct where
|
||||||
|
pretty (Struct n fields) = "struct" <+> pretty n <+> prettyFields fields
|
||||||
|
|
||||||
|
instance Pretty TLEnum where
|
||||||
|
pretty (Enum n fields) = "enum" <+> pretty n <+> prettyFields fields
|
||||||
|
|
||||||
|
instance Pretty TLFunc where
|
||||||
|
pretty (Func n args ret body) =
|
||||||
|
"fn " <> pretty n <> parens (hsep (punctuate comma (map pretty args))) <+> "->" <+> pretty ret <+> prettyBlock body
|
||||||
|
|
||||||
|
instance Pretty TL where
|
||||||
|
pretty (TLStruct s) = pretty s
|
||||||
|
pretty (TLEnum e) = pretty e
|
||||||
|
pretty (TLFunc f) = pretty f
|
||||||
|
|
||||||
|
instance Pretty Program where
|
||||||
|
pretty (Program structs enums funcs) = vsep (map pretty structs) <> line <> vsep (map pretty enums) <> line <> vsep (map pretty funcs)
|
||||||
|
|
||||||
|
prettyFields :: (Pretty a) => [a] -> Doc ann
|
||||||
|
prettyFields fields = lbrace <> line <> indent 4 (vsep (punctuate comma (map pretty fields))) <> line <> rbrace
|
||||||
|
|
||||||
|
prettyBlock :: (Pretty a) => [a] -> Doc ann
|
||||||
|
prettyBlock stmts = lbrace <> line <> indent 4 (vsep (map pretty stmts)) <> line <> rbrace
|
||||||
348
src/Windows12/CodeGen.hs
Normal file
348
src/Windows12/CodeGen.hs
Normal file
@@ -0,0 +1,348 @@
|
|||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE TupleSections #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE RecursiveDo #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
|
||||||
|
module Windows12.CodeGen where
|
||||||
|
|
||||||
|
import Windows12.Ast;
|
||||||
|
|
||||||
|
import LLVM.AST hiding (ArrayType, VoidType, Call, function)
|
||||||
|
import LLVM.AST.Type (i32, i1, i8, double, ptr, void)
|
||||||
|
import qualified LLVM.AST.Constant as C
|
||||||
|
import LLVM.IRBuilder hiding (double, IRBuilder, ModuleBuilder)
|
||||||
|
import LLVM.AST.Typed (typeOf)
|
||||||
|
import LLVM.Prelude (ShortByteString)
|
||||||
|
|
||||||
|
import qualified LLVM.AST.IntegerPredicate as IP
|
||||||
|
import qualified LLVM.AST.FloatingPointPredicate as FP
|
||||||
|
|
||||||
|
import Control.Monad.State hiding (void)
|
||||||
|
|
||||||
|
import Data.Text.Prettyprint.Doc (pretty)
|
||||||
|
import Data.Text (Text, unpack)
|
||||||
|
import Data.String.Conversions
|
||||||
|
import Data.String
|
||||||
|
|
||||||
|
-- Global program context, used to keep track of operands
|
||||||
|
data Ctx = Ctx { operands :: [(Text, (Maybe Windows12.Ast.Type, Operand))],
|
||||||
|
structs :: [TLStruct],
|
||||||
|
enums :: [TLEnum],
|
||||||
|
strings :: [(Text, Operand)] }
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
type ModuleBuilder = ModuleBuilderT (State Ctx)
|
||||||
|
type IRBuilder = IRBuilderT ModuleBuilder
|
||||||
|
|
||||||
|
-- Allow easy string conversion
|
||||||
|
instance ConvertibleStrings Text ShortByteString where
|
||||||
|
convertString = Data.String.fromString . Data.Text.unpack
|
||||||
|
|
||||||
|
-- Put an operand into the context with a name
|
||||||
|
createOperand :: MonadState Ctx m => Text -> Maybe Windows12.Ast.Type -> Operand -> m ()
|
||||||
|
createOperand name op_type op = do
|
||||||
|
ctx <- get
|
||||||
|
put $ ctx { operands = (name, (op_type, op)) : operands ctx }
|
||||||
|
|
||||||
|
-- Take in a source file name, the AST, and return the LLVM IR module
|
||||||
|
codegen :: Text -> Program -> Module
|
||||||
|
codegen filename (Program structs enums funcs) =
|
||||||
|
flip evalState (Ctx [] [] [] [])
|
||||||
|
$ buildModuleT (cs filename)
|
||||||
|
$ do
|
||||||
|
printf <- externVarArgs (mkName "printf") [ptr i8] i32
|
||||||
|
createOperand "printf" Nothing printf
|
||||||
|
mapM_ emitTypeDef structs
|
||||||
|
mapM_ codegenFunc funcs
|
||||||
|
|
||||||
|
-- Given a struct name, search the context for the struct and return its fields
|
||||||
|
getStructFields :: MonadState Ctx m => Text -> m [Bind]
|
||||||
|
getStructFields name = do
|
||||||
|
ctx <- get
|
||||||
|
case filter (\(Struct n _) -> n == name) (structs ctx) of
|
||||||
|
[] -> error $ "Struct " ++ show name ++ " not found. Valid structs: " ++ show (map (\(Struct n _) -> n) (structs ctx))
|
||||||
|
[Struct _ fields] -> return fields
|
||||||
|
_ -> error $ "Multiple structs with name " ++ show name
|
||||||
|
|
||||||
|
-- Convert a Windows12 type to an LLVM type
|
||||||
|
convertType :: MonadState Ctx m => Windows12.Ast.Type -> m LLVM.AST.Type
|
||||||
|
convertType IntType = return i32
|
||||||
|
convertType UIntType = return i32
|
||||||
|
convertType FloatType = return double
|
||||||
|
convertType StrType = convertType (PtrType CharType)
|
||||||
|
convertType BoolType = return i1
|
||||||
|
convertType CharType = return i8
|
||||||
|
convertType (PtrType t) = ptr <$> convertType t
|
||||||
|
convertType (ArrayType t) = convertType (PtrType t)
|
||||||
|
convertType (StructType name) = do
|
||||||
|
fields <- getStructFields name
|
||||||
|
types <- mapM (convertType . bindType) fields
|
||||||
|
return $ StructureType True types -- True indicates packed
|
||||||
|
convertType (EnumType name) = return i32
|
||||||
|
convertType VoidType = return void
|
||||||
|
|
||||||
|
-- Get the size of a type in bytes
|
||||||
|
size :: MonadState Ctx m => Windows12.Ast.Type -> m Int
|
||||||
|
size IntType = return 4
|
||||||
|
size UIntType = return 4
|
||||||
|
size FloatType = return 8
|
||||||
|
size StrType = size (PtrType CharType)
|
||||||
|
size BoolType = return 1
|
||||||
|
size CharType = return 1
|
||||||
|
size (PtrType _) = return 8
|
||||||
|
size (ArrayType t) = size (PtrType t)
|
||||||
|
size (StructType name) = do
|
||||||
|
fields <- getStructFields name
|
||||||
|
sizes <- mapM (size . bindType) fields
|
||||||
|
return $ sum sizes
|
||||||
|
size (EnumType _) = return 8
|
||||||
|
size VoidType = return 0
|
||||||
|
|
||||||
|
|
||||||
|
-- CodeGen for LValues
|
||||||
|
codegenLVal :: LVal -> IRBuilder Operand
|
||||||
|
codegenLVal (LId name) = do
|
||||||
|
ctx <- get
|
||||||
|
case lookup name (operands ctx) of
|
||||||
|
Just (_type, op) -> return op
|
||||||
|
Nothing -> error $ "Variable " ++ show name ++ " not found"
|
||||||
|
|
||||||
|
-- TODO support members of members
|
||||||
|
codegenLVal (LMember (Id sName) field) = do
|
||||||
|
ctx <- get
|
||||||
|
case lookup sName (operands ctx) of
|
||||||
|
Just ((Just (StructType op_type)), struct) -> do
|
||||||
|
fields <- getStructFields op_type
|
||||||
|
offset <- structFieldOffset (Struct sName fields) field
|
||||||
|
gep struct [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 (fromIntegral offset))]
|
||||||
|
Nothing -> error $ "Struct " ++ show sName ++ " not found"
|
||||||
|
|
||||||
|
codegenLVal e = error $ "Unimplemented or invalid LValue " ++ show (pretty e) ++ " (" ++ show e ++ ")"
|
||||||
|
|
||||||
|
-- Given a struct and a field name, return the offset of the field in the struct.
|
||||||
|
-- In LLVM each field is actually size 1
|
||||||
|
structFieldOffset :: MonadState Ctx m => TLStruct -> Text -> m Int
|
||||||
|
structFieldOffset (Struct name fields) field = do
|
||||||
|
return $ length $ takeWhile (\(Bind n _) -> n /= field) fields
|
||||||
|
|
||||||
|
-- CodeGen for expressions
|
||||||
|
codegenExpr :: Expr -> IRBuilder Operand
|
||||||
|
codegenExpr (Id name) = flip load 0 =<< codegenLVal (LId name) -- TODO (?)
|
||||||
|
codegenExpr (IntLit i) = return $ ConstantOperand (C.Int 32 (fromIntegral i))
|
||||||
|
codegenExpr (UIntLit i) = return $ ConstantOperand (C.Int 32 (fromIntegral i))
|
||||||
|
codegenExpr (FloatLit f) = undefined -- TODO floats
|
||||||
|
codegenExpr (StrLit s) = do
|
||||||
|
strs <- gets strings
|
||||||
|
case lookup s strs of
|
||||||
|
-- If the string is already in the context, return it
|
||||||
|
Just str -> return str
|
||||||
|
-- Otherwise, create a new global string and add it to the context
|
||||||
|
Nothing -> do
|
||||||
|
let str_name = mkName ("str." <> show (length strs))
|
||||||
|
op <- globalStringPtr (cs s) str_name
|
||||||
|
modify $ \ctx -> ctx { strings = (s, (ConstantOperand op)) : strs }
|
||||||
|
return (ConstantOperand op)
|
||||||
|
|
||||||
|
codegenExpr (BoolLit b) = return $ ConstantOperand (C.Int 1 (if b then 1 else 0))
|
||||||
|
codegenExpr (CharLit c) = return $ ConstantOperand (C.Int 8 (fromIntegral (fromEnum c)))
|
||||||
|
|
||||||
|
codegenExpr (BinOp op lhs rhs) = do
|
||||||
|
lhs' <- codegenExpr lhs
|
||||||
|
rhs' <- codegenExpr rhs
|
||||||
|
|
||||||
|
-- TODO pointers, floating points
|
||||||
|
case op of
|
||||||
|
Windows12.Ast.Add -> case (typeOf lhs', typeOf rhs') of
|
||||||
|
(IntegerType 32, IntegerType 32) -> add lhs' rhs'
|
||||||
|
_ -> error "Invalid types for add"
|
||||||
|
Windows12.Ast.Sub -> case (typeOf lhs', typeOf rhs') of
|
||||||
|
(IntegerType 32, IntegerType 32) -> sub lhs' rhs'
|
||||||
|
_ -> error "Invalid types for sub"
|
||||||
|
Windows12.Ast.Mul -> case (typeOf lhs', typeOf rhs') of
|
||||||
|
(IntegerType 32, IntegerType 32) -> mul lhs' rhs'
|
||||||
|
_ -> error "Invalid types for mul"
|
||||||
|
Windows12.Ast.Div -> case (typeOf lhs', typeOf rhs') of
|
||||||
|
(IntegerType 32, IntegerType 32) -> sdiv lhs' rhs'
|
||||||
|
_ -> error "Invalid types for div"
|
||||||
|
Windows12.Ast.Mod -> case (typeOf lhs', typeOf rhs') of
|
||||||
|
(IntegerType 32, IntegerType 32) -> srem lhs' rhs'
|
||||||
|
_ -> error "Invalid types for mod"
|
||||||
|
Windows12.Ast.Eq -> case (typeOf lhs', typeOf rhs') of
|
||||||
|
(IntegerType 32, IntegerType 32) -> icmp IP.EQ lhs' rhs'
|
||||||
|
_ -> error "Invalid types for eq"
|
||||||
|
Windows12.Ast.Ne -> case (typeOf lhs', typeOf rhs') of
|
||||||
|
(IntegerType 32, IntegerType 32) -> icmp IP.NE lhs' rhs'
|
||||||
|
_ -> error "Invalid types for ne"
|
||||||
|
Windows12.Ast.Lt -> case (typeOf lhs', typeOf rhs') of
|
||||||
|
(IntegerType 32, IntegerType 32) -> icmp IP.SLT lhs' rhs'
|
||||||
|
_ -> error "Invalid types for lt"
|
||||||
|
Windows12.Ast.Gt -> case (typeOf lhs', typeOf rhs') of
|
||||||
|
(IntegerType 32, IntegerType 32) -> icmp IP.SGT lhs' rhs'
|
||||||
|
_ -> error "Invalid types for gt"
|
||||||
|
Windows12.Ast.Le -> case (typeOf lhs', typeOf rhs') of
|
||||||
|
(IntegerType 32, IntegerType 32) -> icmp IP.SLE lhs' rhs'
|
||||||
|
_ -> error "Invalid types for le"
|
||||||
|
Windows12.Ast.Ge -> case (typeOf lhs', typeOf rhs') of
|
||||||
|
(IntegerType 32, IntegerType 32) -> icmp IP.SGE lhs' rhs'
|
||||||
|
_ -> error "Invalid types for ge"
|
||||||
|
|
||||||
|
other -> error $ "Operator " ++ show other ++ " not implemented"
|
||||||
|
|
||||||
|
codegenExpr (UnOp op e) = undefined -- TODO handle unary operators
|
||||||
|
|
||||||
|
-- Function calls: look up the function in operands, then call it with the args
|
||||||
|
codegenExpr (Call (Id f) args) = do
|
||||||
|
ctx <- get
|
||||||
|
f <- case lookup f (operands ctx) of
|
||||||
|
Just (_type, f) -> return f
|
||||||
|
Nothing -> error $ "Function " ++ show f ++ " not found"
|
||||||
|
args <- mapM (fmap (, []) . codegenExpr) args
|
||||||
|
call f args
|
||||||
|
|
||||||
|
codegenExpr (Index arr idx) = undefined -- TODO arrays
|
||||||
|
|
||||||
|
-- Get the address of the struct field and load it
|
||||||
|
codegenExpr (Member (Id sVarName) field) = do
|
||||||
|
ctx <- get
|
||||||
|
case lookup sVarName (operands ctx) of
|
||||||
|
Just ((Just (StructType op_type)), struct) -> do
|
||||||
|
fields <- getStructFields op_type
|
||||||
|
offset <- structFieldOffset (Struct op_type fields) field
|
||||||
|
addr <- gep struct [ConstantOperand (C.Int 32 0), ConstantOperand (C.Int 32 (fromIntegral offset))]
|
||||||
|
load addr 0
|
||||||
|
Nothing -> error $ "Struct operand " ++ show sVarName ++ " not found"
|
||||||
|
|
||||||
|
codegenExpr (Cast t e) = undefined -- TODO casts
|
||||||
|
|
||||||
|
codegenExpr (Sizeof t) = ConstantOperand . C.Int 32 . fromIntegral <$> size t
|
||||||
|
|
||||||
|
codegenExpr e = error $ "Unimplemented or invalid Expression " ++ show (pretty e) ++ " (" ++ show e ++ ")"
|
||||||
|
|
||||||
|
mkTerminator :: IRBuilder () -> IRBuilder ()
|
||||||
|
mkTerminator instr = do
|
||||||
|
check <- hasTerminator
|
||||||
|
unless check instr
|
||||||
|
|
||||||
|
-- Codegen for statements
|
||||||
|
codegenStmt :: Stmt -> IRBuilder ()
|
||||||
|
|
||||||
|
-- For expression statements, just evaluate the expression and discard the result
|
||||||
|
codegenStmt (Expr e) = do
|
||||||
|
_expr <- codegenExpr e
|
||||||
|
return ()
|
||||||
|
|
||||||
|
codegenStmt (Return e) = ret =<< codegenExpr e
|
||||||
|
|
||||||
|
-- Generate if statements, with a merge block at the end
|
||||||
|
codegenStmt (If cond t f) = mdo
|
||||||
|
cond' <- codegenExpr cond
|
||||||
|
condBr cond' then' else'
|
||||||
|
|
||||||
|
then' <- block `named` "then"
|
||||||
|
codegenStmt (Block t)
|
||||||
|
mkTerminator $ br merge
|
||||||
|
|
||||||
|
else' <- block `named` "else"
|
||||||
|
codegenStmt (case f of
|
||||||
|
Just f' -> Block f'
|
||||||
|
Nothing -> Block [])
|
||||||
|
mkTerminator $ br merge
|
||||||
|
|
||||||
|
merge <- block `named` "merge"
|
||||||
|
return ()
|
||||||
|
|
||||||
|
-- Generate while loops, with a merge block at the end
|
||||||
|
codegenStmt (While cond body) = mdo
|
||||||
|
br condBlock
|
||||||
|
condBlock <- block `named` "cond"
|
||||||
|
cond' <- codegenExpr cond
|
||||||
|
condBr cond' loop end
|
||||||
|
|
||||||
|
loop <- block `named` "loop"
|
||||||
|
codegenStmt (Block body)
|
||||||
|
mkTerminator $ br condBlock
|
||||||
|
|
||||||
|
end <- block `named` "end"
|
||||||
|
return ()
|
||||||
|
|
||||||
|
codegenStmt (Assign BaseAssign l e) = do
|
||||||
|
op <- codegenExpr e
|
||||||
|
var <- codegenLVal l
|
||||||
|
store var 0 op
|
||||||
|
|
||||||
|
codegenStmt (Assign AddAssign l e) = do
|
||||||
|
op <- codegenExpr e
|
||||||
|
var <- codegenLVal l
|
||||||
|
val <- load var 0
|
||||||
|
store var 0 =<< add val op
|
||||||
|
|
||||||
|
codegenStmt (Assign SubAssign l e) = do
|
||||||
|
op <- codegenExpr e
|
||||||
|
var <- codegenLVal l
|
||||||
|
val <- load var 0
|
||||||
|
store var 0 =<< sub val op
|
||||||
|
|
||||||
|
-- A block is just a list of statements
|
||||||
|
codegenStmt (Block stmts) = mapM_ codegenStmt stmts
|
||||||
|
|
||||||
|
-- Since the vars are already allocated by genBody, we just need to assign the value
|
||||||
|
codegenStmt (Var name t (Just e)) = codegenStmt (Assign BaseAssign (LId name) e) -- TODO (?)
|
||||||
|
|
||||||
|
-- Do nothing with variable declaration if no expression is given
|
||||||
|
-- This is because allocation is done already
|
||||||
|
codegenStmt (Var name _ Nothing) = return ()
|
||||||
|
|
||||||
|
codegenStmt s = error $ "Unimplemented or invalid statement " ++ show (pretty s) ++ " (" ++ show s ++ ")"
|
||||||
|
|
||||||
|
-- Generate code for a function
|
||||||
|
-- First create the function, then allocate space for the arguments and locals
|
||||||
|
codegenFunc :: TLFunc -> ModuleBuilder ()
|
||||||
|
codegenFunc func@(Func name args retType body) = mdo
|
||||||
|
createOperand name Nothing f
|
||||||
|
(f, strs) <- do
|
||||||
|
params' <- mapM mkParam args
|
||||||
|
retType' <- convertType retType
|
||||||
|
f <- function (mkName (cs name)) params' retType' genBody
|
||||||
|
strs <- gets strings
|
||||||
|
return (f, strs)
|
||||||
|
modify $ \ctx -> ctx { strings = strs }
|
||||||
|
where
|
||||||
|
mkParam (Bind name t) = (,) <$> convertType t <*> pure (ParameterName (cs name))
|
||||||
|
|
||||||
|
genBody :: [Operand] -> IRBuilder ()
|
||||||
|
genBody ops = do
|
||||||
|
forM_ (zip ops args) $ \(op, Bind name t) -> do
|
||||||
|
addr <- alloca (typeOf op) Nothing 0
|
||||||
|
store addr 0 op
|
||||||
|
createOperand name (Just t) addr
|
||||||
|
|
||||||
|
forM_ (getLocals func) $ \(Bind name t) -> do
|
||||||
|
ltype <- convertType t
|
||||||
|
addr <- alloca ltype Nothing 0
|
||||||
|
createOperand name (Just t) addr
|
||||||
|
|
||||||
|
codegenStmt (Block body)
|
||||||
|
|
||||||
|
-- Given a function, get all the local variables
|
||||||
|
-- Used so allocation can be done before the function body
|
||||||
|
getLocals :: TLFunc -> [Bind]
|
||||||
|
getLocals (Func _ args _ body) = blockGetLocals body
|
||||||
|
|
||||||
|
blockGetLocals :: [Stmt] -> [Bind]
|
||||||
|
blockGetLocals = concatMap stmtGetLocals
|
||||||
|
|
||||||
|
stmtGetLocals :: Stmt -> [Bind]
|
||||||
|
stmtGetLocals (Var n (Just t) _) = [Bind n t]
|
||||||
|
stmtGetLocals (Var n Nothing _) = error $ "Explicit typing required (var " ++ show n ++ ")"
|
||||||
|
stmtGetLocals (Block stmts) = blockGetLocals stmts
|
||||||
|
stmtGetLocals (If _ t f) = blockGetLocals t ++ maybe [] blockGetLocals f
|
||||||
|
stmtGetLocals (While _ body) = blockGetLocals body
|
||||||
|
stmtGetLocals _ = []
|
||||||
|
|
||||||
|
-- Create structs
|
||||||
|
emitTypeDef :: TLStruct -> ModuleBuilder LLVM.AST.Type
|
||||||
|
emitTypeDef (Struct name fields) = do
|
||||||
|
modify $ \ctx -> ctx { structs = Struct name fields : structs ctx }
|
||||||
|
sType <- convertType (StructType name)
|
||||||
|
typedef (mkName (cs ("struct." <> name))) (Just sType)
|
||||||
82
src/Windows12/Lexer.hs
Normal file
82
src/Windows12/Lexer.hs
Normal file
@@ -0,0 +1,82 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module Windows12.Lexer where
|
||||||
|
|
||||||
|
import Data.Text (Text)
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import Data.Void
|
||||||
|
import Text.Megaparsec
|
||||||
|
import Text.Megaparsec.Char
|
||||||
|
import qualified Text.Megaparsec.Char.Lexer as L
|
||||||
|
|
||||||
|
type Parser = Parsec Void Text
|
||||||
|
|
||||||
|
sc :: Parser ()
|
||||||
|
sc =
|
||||||
|
L.space
|
||||||
|
space1
|
||||||
|
(L.skipLineComment "#")
|
||||||
|
(L.skipBlockComment "/*" "*/")
|
||||||
|
|
||||||
|
lexeme :: Parser a -> Parser a
|
||||||
|
lexeme = L.lexeme sc
|
||||||
|
|
||||||
|
symbol :: Text -> Parser Text
|
||||||
|
symbol = L.symbol sc
|
||||||
|
|
||||||
|
charLiteral :: Parser Char
|
||||||
|
charLiteral = between (char '\'') (char '\'') L.charLiteral
|
||||||
|
|
||||||
|
stringLiteral :: Parser Text
|
||||||
|
stringLiteral = T.pack <$> (char '"' *> manyTill L.charLiteral (char '"'))
|
||||||
|
|
||||||
|
intLiteral :: Parser Int
|
||||||
|
intLiteral = lexeme L.decimal
|
||||||
|
|
||||||
|
uintLiteral :: Parser Word
|
||||||
|
uintLiteral = lexeme L.decimal <* char 'u'
|
||||||
|
|
||||||
|
floatLiteral :: Parser Double
|
||||||
|
floatLiteral = lexeme L.float
|
||||||
|
|
||||||
|
reserved :: Text -> Parser ()
|
||||||
|
reserved word = lexeme (string word *> notFollowedBy alphaNumChar)
|
||||||
|
|
||||||
|
reservedWords :: [Text]
|
||||||
|
reservedWords =
|
||||||
|
[ "if",
|
||||||
|
"else",
|
||||||
|
"while",
|
||||||
|
"for",
|
||||||
|
"return",
|
||||||
|
"int",
|
||||||
|
"uint",
|
||||||
|
"float",
|
||||||
|
"char",
|
||||||
|
"bool",
|
||||||
|
"struct",
|
||||||
|
"sizeof",
|
||||||
|
"true",
|
||||||
|
"false",
|
||||||
|
"fn",
|
||||||
|
"on",
|
||||||
|
"var"
|
||||||
|
]
|
||||||
|
|
||||||
|
identifier :: Parser Text
|
||||||
|
identifier = (lexeme . try) (p >>= check)
|
||||||
|
where
|
||||||
|
p = fmap T.pack $ (:) <$> letterChar <*> many (alphaNumChar <|> char '_')
|
||||||
|
check x =
|
||||||
|
if x `elem` reservedWords
|
||||||
|
then fail $ "keyword " <> show x <> " cannot be an identifier"
|
||||||
|
else return x
|
||||||
|
|
||||||
|
parens :: Parser a -> Parser a
|
||||||
|
parens = between (symbol "(") (symbol ")")
|
||||||
|
|
||||||
|
braces :: Parser a -> Parser a
|
||||||
|
braces = between (symbol "{") (symbol "}")
|
||||||
|
|
||||||
|
brackets :: Parser a -> Parser a
|
||||||
|
brackets = between (symbol "[") (symbol "]")
|
||||||
184
src/Windows12/Parser.hs
Normal file
184
src/Windows12/Parser.hs
Normal file
@@ -0,0 +1,184 @@
|
|||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module Windows12.Parser (programP) where
|
||||||
|
|
||||||
|
import Control.Monad.Combinators.Expr
|
||||||
|
import Text.Megaparsec
|
||||||
|
import Windows12.Ast
|
||||||
|
import Windows12.Lexer
|
||||||
|
import Data.Text.Prettyprint.Doc (pretty)
|
||||||
|
|
||||||
|
opTable :: [[Operator Parser Expr]]
|
||||||
|
opTable =
|
||||||
|
[ [ Postfix $ do
|
||||||
|
_ <- symbol "."
|
||||||
|
field <- identifier
|
||||||
|
pure (\expr -> Member expr field),
|
||||||
|
Postfix $ do
|
||||||
|
_ <- symbol "->"
|
||||||
|
field <- identifier
|
||||||
|
pure (\expr -> Member (UnOp Deref expr) field)
|
||||||
|
],
|
||||||
|
[ unary (UnOp Neg) "-",
|
||||||
|
unary (UnOp Not) "!",
|
||||||
|
unary (UnOp BitNot) "~",
|
||||||
|
unary (UnOp Deref) "*",
|
||||||
|
unary (UnOp AddrOf) "&"
|
||||||
|
],
|
||||||
|
[ Postfix $ flip Index <$> (symbol "[" *> exprP <* symbol "]")
|
||||||
|
],
|
||||||
|
[ Postfix $ flip Call <$> parens (sepBy exprP (symbol ","))
|
||||||
|
],
|
||||||
|
[ infixL' Mul "*",
|
||||||
|
infixL' Div "/",
|
||||||
|
infixL' Mod "%"
|
||||||
|
],
|
||||||
|
[ infixL' Add "+",
|
||||||
|
infixL' Sub "-"
|
||||||
|
],
|
||||||
|
[ infixL' ShiftL "<<",
|
||||||
|
infixL' ShiftR ">>"
|
||||||
|
],
|
||||||
|
[ infixL Le "<=",
|
||||||
|
infixL Lt "<",
|
||||||
|
infixL Ge ">=",
|
||||||
|
infixL Gt ">"
|
||||||
|
],
|
||||||
|
[ infixL Eq "==",
|
||||||
|
infixL Ne "!="
|
||||||
|
],
|
||||||
|
[ infixL' BitAnd "&"
|
||||||
|
],
|
||||||
|
[ infixL' BitXor "^"
|
||||||
|
],
|
||||||
|
[ infixL' BitOr "|"
|
||||||
|
],
|
||||||
|
[ infixL And "&&"
|
||||||
|
],
|
||||||
|
[ infixL Or "||"
|
||||||
|
]
|
||||||
|
]
|
||||||
|
where
|
||||||
|
unary op sym = Prefix $ foldr1 (.) <$> some (op <$ symbol sym)
|
||||||
|
infixL op sym = InfixL $ BinOp op <$ symbol sym
|
||||||
|
infixL' op sym = InfixL $ BinOp op <$ operator sym
|
||||||
|
infixR op sym = InfixR $ BinOp op <$ symbol sym
|
||||||
|
operator sym = lexeme $ try $ (symbol sym <* notFollowedBy opChar)
|
||||||
|
opChar = oneOf ("+-*/%<>&|^=!~" :: [Char])
|
||||||
|
|
||||||
|
termP :: Parser Expr
|
||||||
|
termP =
|
||||||
|
parens exprP
|
||||||
|
<|> IntLit <$> intLiteral
|
||||||
|
<|> UIntLit <$> uintLiteral
|
||||||
|
<|> try (FloatLit <$> floatLiteral)
|
||||||
|
<|> StrLit <$> stringLiteral
|
||||||
|
<|> BoolLit <$> (reserved "true" *> pure True <|> reserved "false" *> pure False)
|
||||||
|
<|> CharLit <$> charLiteral
|
||||||
|
<|> try (Sizeof <$> (reserved "sizeof" *> typeP))
|
||||||
|
<|> try (Cast <$> (parens typeP) <*> termP)
|
||||||
|
<|> try (StructInit <$> identifier <*> braces (sepEndBy1 ((,) <$> identifier <* symbol ":" <*> exprP) (symbol ",")))
|
||||||
|
<|> Id <$> identifier
|
||||||
|
|
||||||
|
exprP :: Parser Expr
|
||||||
|
exprP = makeExprParser termP opTable
|
||||||
|
|
||||||
|
exprToLVal :: Expr -> Maybe LVal
|
||||||
|
exprToLVal (Id x) = Just (LId x)
|
||||||
|
exprToLVal (Index arr idx) = Just (LIndex arr idx)
|
||||||
|
exprToLVal (UnOp Deref e) = Just (LDeref e)
|
||||||
|
exprToLVal (Member e m) = Just (LMember e m)
|
||||||
|
exprToLVal _ = Nothing
|
||||||
|
|
||||||
|
lvalP :: Parser LVal
|
||||||
|
lvalP = do
|
||||||
|
e <- exprP
|
||||||
|
case exprToLVal e of
|
||||||
|
Just lv -> pure lv
|
||||||
|
Nothing -> fail $ "Invalid l-value: " ++ show (pretty e) ++ " (" ++ show e ++ ")"
|
||||||
|
|
||||||
|
structP :: Parser TLStruct
|
||||||
|
structP = do
|
||||||
|
reserved "struct"
|
||||||
|
name <- identifier
|
||||||
|
fields <- braces (sepEndBy (Bind <$> identifier <* symbol ":" <*> typeP) (symbol ","))
|
||||||
|
return $ Struct name fields
|
||||||
|
|
||||||
|
typeP :: Parser Type
|
||||||
|
typeP = do
|
||||||
|
t <-
|
||||||
|
ArrayType <$> (brackets typeP)
|
||||||
|
<|> IntType <$ reserved "int"
|
||||||
|
<|> UIntType <$ reserved "uint"
|
||||||
|
<|> FloatType <$ reserved "float"
|
||||||
|
<|> StrType <$ reserved "str"
|
||||||
|
<|> BoolType <$ reserved "bool"
|
||||||
|
<|> CharType <$ reserved "char"
|
||||||
|
<|> StructType <$> identifier
|
||||||
|
foldr (const PtrType) t <$> many (symbol "*")
|
||||||
|
|
||||||
|
assignP :: Parser Stmt
|
||||||
|
assignP = do
|
||||||
|
lhs <- lvalP
|
||||||
|
op <-
|
||||||
|
AddAssign <$ symbol "+="
|
||||||
|
<|> SubAssign <$ symbol "-="
|
||||||
|
<|> MulAssign <$ symbol "*="
|
||||||
|
<|> DivAssign <$ symbol "/="
|
||||||
|
<|> ModAssign <$ symbol "%="
|
||||||
|
<|> BitAndAssign <$ symbol "&="
|
||||||
|
<|> BitOrAssign <$ symbol "|="
|
||||||
|
<|> BitXorAssign <$ symbol "^="
|
||||||
|
<|> ShiftLAssign <$ symbol "<<="
|
||||||
|
<|> ShiftRAssign <$ symbol ">>="
|
||||||
|
<|> BaseAssign <$ symbol "="
|
||||||
|
Assign op lhs <$> exprP <* symbol ";"
|
||||||
|
|
||||||
|
stmtP :: Parser Stmt
|
||||||
|
stmtP =
|
||||||
|
Return <$> (reserved "return" *> exprP <* symbol ";")
|
||||||
|
<|> (If <$> (reserved "if" *> exprP) <*> braces (many stmtP) <*> optional (reserved "else" *> braces (many stmtP)))
|
||||||
|
<|> (While <$> (reserved "while" *> exprP) <*> braces (many stmtP))
|
||||||
|
<|> (Var <$> (reserved "var" *> identifier) <*> optional (symbol ":" *> typeP) <*> optional (symbol "=" *> exprP) <* symbol ";")
|
||||||
|
<|> try assignP
|
||||||
|
<|> Expr <$> exprP <* symbol ";"
|
||||||
|
<|> Block <$> braces (many stmtP)
|
||||||
|
|
||||||
|
funcP :: Parser TLFunc
|
||||||
|
funcP = do
|
||||||
|
reserved "fn"
|
||||||
|
name <- identifier
|
||||||
|
args <- parens (sepBy (Bind <$> identifier <* symbol ":" <*> typeP) (symbol ","))
|
||||||
|
retType <- (symbol "->" *> typeP) <|> pure VoidType
|
||||||
|
body <- braces (many stmtP)
|
||||||
|
return $ Func name args retType body
|
||||||
|
|
||||||
|
enumP :: Parser TLEnum
|
||||||
|
enumP = do
|
||||||
|
reserved "enum"
|
||||||
|
name <- identifier
|
||||||
|
fields <- braces (sepEndBy1 identifier (symbol ","))
|
||||||
|
return $ Enum name fields
|
||||||
|
|
||||||
|
memberFuncP :: Parser TLFunc
|
||||||
|
memberFuncP = do
|
||||||
|
reserved "fn"
|
||||||
|
reserved "on"
|
||||||
|
self <- typeP
|
||||||
|
name <- identifier
|
||||||
|
args <- parens (sepBy (Bind <$> identifier <* symbol ":" <*> typeP) (symbol ","))
|
||||||
|
retType <- (symbol "->" *> typeP) <|> pure VoidType
|
||||||
|
body <- braces (many stmtP)
|
||||||
|
return $ Func name (Bind "self" (PtrType self) : args) retType body
|
||||||
|
|
||||||
|
organize :: [TL] -> Program
|
||||||
|
organize tls = Program structs enums funcs
|
||||||
|
where
|
||||||
|
structs = [s | TLStruct s <- tls]
|
||||||
|
enums = [e | TLEnum e <- tls]
|
||||||
|
funcs = [f | TLFunc f <- tls]
|
||||||
|
|
||||||
|
programP :: Parser Program
|
||||||
|
programP = between sc eof $ do
|
||||||
|
tls <- many (TLStruct <$> structP <|> TLEnum <$> enumP <|> try (TLFunc <$> memberFuncP) <|> TLFunc <$> funcP)
|
||||||
|
return $ organize tls
|
||||||
43
test/arith.w12
Normal file
43
test/arith.w12
Normal file
@@ -0,0 +1,43 @@
|
|||||||
|
fn factorial(n: int) -> int {
|
||||||
|
var result: int;
|
||||||
|
|
||||||
|
if n == 0 {
|
||||||
|
result = 1;
|
||||||
|
} else {
|
||||||
|
result = n * factorial(n - 1);
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
fn is_positive(n: int) -> bool {
|
||||||
|
return n > 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
fn main() -> int {
|
||||||
|
var a: int = 5;
|
||||||
|
printf("a = %d\n", a);
|
||||||
|
|
||||||
|
var b: int = 3;
|
||||||
|
printf("b = %d\n", b);
|
||||||
|
|
||||||
|
var c: int = (a + b) * 2 - 1;
|
||||||
|
c += factorial(5);
|
||||||
|
|
||||||
|
printf("c = %d\n", c);
|
||||||
|
|
||||||
|
while c > 0 {
|
||||||
|
printf("c = %d\n", c);
|
||||||
|
|
||||||
|
if c > 50 {
|
||||||
|
printf("c is greater than 50\n");
|
||||||
|
} else {
|
||||||
|
printf("c is less than or equal to 50\n");
|
||||||
|
}
|
||||||
|
|
||||||
|
c -= 16;
|
||||||
|
}
|
||||||
|
|
||||||
|
printf("End result: %d\n", c);
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
1
test/bad.w12
Normal file
1
test/bad.w12
Normal file
@@ -0,0 +1 @@
|
|||||||
|
function test() {}
|
||||||
21
test/basic-structs.w12
Normal file
21
test/basic-structs.w12
Normal file
@@ -0,0 +1,21 @@
|
|||||||
|
struct Test {
|
||||||
|
a: int,
|
||||||
|
b: char,
|
||||||
|
}
|
||||||
|
|
||||||
|
fn main() -> int {
|
||||||
|
var t: Test;
|
||||||
|
t.a = 5;
|
||||||
|
t.b = 'a';
|
||||||
|
|
||||||
|
printf("t.a = %d\n", t.a);
|
||||||
|
printf("t.b = %c\n", t.b);
|
||||||
|
|
||||||
|
t.a += 3;
|
||||||
|
t.b = 'b';
|
||||||
|
|
||||||
|
printf("t.a = %d\n", t.a);
|
||||||
|
printf("t.b = %c\n", t.b);
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
0
test/empty.w12
Normal file
0
test/empty.w12
Normal file
38
test/fib.w12
Normal file
38
test/fib.w12
Normal file
@@ -0,0 +1,38 @@
|
|||||||
|
fn rec_fib(n: int) -> int {
|
||||||
|
if n <= 1 {
|
||||||
|
return n;
|
||||||
|
}
|
||||||
|
|
||||||
|
return rec_fib(n - 1) + rec_fib(n - 2);
|
||||||
|
}
|
||||||
|
|
||||||
|
fn loop_fib(n: int) -> int {
|
||||||
|
var a: int = 0;
|
||||||
|
var b: int = 1;
|
||||||
|
var i: int = 0;
|
||||||
|
|
||||||
|
while i < n {
|
||||||
|
var c: int = a + b;
|
||||||
|
a = b;
|
||||||
|
b = c;
|
||||||
|
i += 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
return a;
|
||||||
|
}
|
||||||
|
|
||||||
|
fn main() -> int {
|
||||||
|
var n: int = 20;
|
||||||
|
var rec_result: int = rec_fib(n);
|
||||||
|
var loop_result: int = loop_fib(n);
|
||||||
|
printf("Fibonacci of %d via recursion is %d\n", n, rec_result);
|
||||||
|
printf("Fibonacci of %d via loop is %d\n", n, loop_result);
|
||||||
|
|
||||||
|
if rec_result == loop_result {
|
||||||
|
printf("Results match\n");
|
||||||
|
} else {
|
||||||
|
printf("Results do not match\n");
|
||||||
|
}
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
32
test/functions.w12
Normal file
32
test/functions.w12
Normal file
@@ -0,0 +1,32 @@
|
|||||||
|
fn mult3(a: int, b: int, c: int) -> int {
|
||||||
|
return a * b * c;
|
||||||
|
}
|
||||||
|
|
||||||
|
fn loop_test() -> int {
|
||||||
|
var i: int = 0;
|
||||||
|
var result: int = 0;
|
||||||
|
|
||||||
|
while i < 10 {
|
||||||
|
printf("i = %d\n", i);
|
||||||
|
result += i;
|
||||||
|
i += 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
fn main() -> int {
|
||||||
|
var a: int = 5;
|
||||||
|
var b: int = 3;
|
||||||
|
var c: int = 2;
|
||||||
|
|
||||||
|
var result: int = mult3(a, b, c);
|
||||||
|
printf("Result: %d\n", result);
|
||||||
|
|
||||||
|
result = loop_test();
|
||||||
|
printf("Result: %d\n", result);
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
64
test/hello.w12
Normal file
64
test/hello.w12
Normal file
@@ -0,0 +1,64 @@
|
|||||||
|
# Create an enum
|
||||||
|
enum AnimalType {
|
||||||
|
Dog,
|
||||||
|
Cat,
|
||||||
|
}
|
||||||
|
|
||||||
|
# Create a struct
|
||||||
|
struct Pet {
|
||||||
|
name: [char], # A list of characters
|
||||||
|
age: uint, # An unsigned 32-bit integer
|
||||||
|
type: AnimalType,
|
||||||
|
living: bool,
|
||||||
|
}
|
||||||
|
|
||||||
|
# Create a function that can be called on a Pet
|
||||||
|
fn on Pet rename(newName: [char]) {
|
||||||
|
self.name = newName;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Create another struct
|
||||||
|
struct Person {
|
||||||
|
pet: Pet,
|
||||||
|
name: [char],
|
||||||
|
age: uint,
|
||||||
|
living: bool,
|
||||||
|
}
|
||||||
|
|
||||||
|
fn on Person growUp() {
|
||||||
|
self.age += 1;
|
||||||
|
}
|
||||||
|
fn main() -> int {
|
||||||
|
# Create an instance of Pet
|
||||||
|
# "let" creates an immutable binding
|
||||||
|
var dog = Pet {
|
||||||
|
name: "Fido",
|
||||||
|
age: 3,
|
||||||
|
type: AnimalType.Dog,
|
||||||
|
};
|
||||||
|
|
||||||
|
# Create a (variable) instance of Person
|
||||||
|
# "var" creates a mutable binding
|
||||||
|
var person = Person {
|
||||||
|
pet: dog,
|
||||||
|
name: "Fred",
|
||||||
|
age: 41,
|
||||||
|
};
|
||||||
|
|
||||||
|
# Create a new name for the Pet
|
||||||
|
var new_name = "George";
|
||||||
|
person.pet.rename(new_name);
|
||||||
|
|
||||||
|
# Print out the person's name and age
|
||||||
|
# Uses C for I/O
|
||||||
|
printf("Person %s is %u years old.\n", person.name, person.age);
|
||||||
|
if person.age % 2 == 0 {
|
||||||
|
printf("Age is even\n");
|
||||||
|
} else {
|
||||||
|
printf("Age is odd\n");
|
||||||
|
}
|
||||||
|
|
||||||
|
*test[12](3);
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
33
test/sizeof.w12
Normal file
33
test/sizeof.w12
Normal file
@@ -0,0 +1,33 @@
|
|||||||
|
struct BigStruct {
|
||||||
|
name: [char],
|
||||||
|
number: int,
|
||||||
|
number2: int,
|
||||||
|
}
|
||||||
|
|
||||||
|
struct BiggerStruct {
|
||||||
|
character: char,
|
||||||
|
big: BigStruct,
|
||||||
|
}
|
||||||
|
|
||||||
|
struct SmallStruct {
|
||||||
|
value: int,
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
fn main() -> int {
|
||||||
|
printf("Size of int: %u\n", sizeof int);
|
||||||
|
printf("Size of uint: %u\n", sizeof uint);
|
||||||
|
printf("Size of float: %u\n", sizeof float);
|
||||||
|
printf("Size of [char]: %u\n", sizeof [char]);
|
||||||
|
printf("Size of [int]: %u\n", sizeof [int]);
|
||||||
|
printf("Size of bool: %u\n", sizeof bool);
|
||||||
|
printf("Size of int*: %u\n", sizeof int*);
|
||||||
|
printf("Size of bool*: %u\n", sizeof bool*);
|
||||||
|
printf("Size of BigStruct*: %u\n", sizeof BigStruct*);
|
||||||
|
printf("Size of SmallStruct*: %u\n", sizeof SmallStruct*);
|
||||||
|
printf("Size of BigStruct: %u\n", sizeof BigStruct);
|
||||||
|
printf("Size of BiggerStruct: %u\n", sizeof BiggerStruct);
|
||||||
|
printf("Size of SmallStruct: %u\n", sizeof SmallStruct);
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
@@ -63,13 +63,60 @@ executable windows12
|
|||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
|
|
||||||
-- Modules included in this executable, other than Main.
|
-- Modules included in this executable, other than Main.
|
||||||
-- other-modules:
|
other-modules:
|
||||||
|
Windows12
|
||||||
|
Windows12.Ast
|
||||||
|
Windows12.Lexer
|
||||||
|
Windows12.Parser
|
||||||
|
Windows12.CodeGen
|
||||||
|
|
||||||
-- LANGUAGE extensions used by modules in this package.
|
-- LANGUAGE extensions used by modules in this package.
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
|
|
||||||
-- Other library packages from which modules are imported.
|
-- Other library packages from which modules are imported.
|
||||||
build-depends: base ^>=4.18.2.1
|
build-depends:
|
||||||
|
base >= 4.15.1 && < 4.16,
|
||||||
|
llvm-hs-pure >= 9.0.0 && < 9.1,
|
||||||
|
llvm-hs-pretty >= 0.9.0 && < 0.10,
|
||||||
|
megaparsec >= 9.6.1 && < 9.7,
|
||||||
|
text >= 1.2.5 && < 1.3,
|
||||||
|
parser-combinators >= 1.3.0 && < 1.4,
|
||||||
|
prettyprinter >= 1.5.1 && < 1.6,
|
||||||
|
string-conversions >= 0.4.0 && < 0.5,
|
||||||
|
mtl >= 2.2.2 && < 2.3,
|
||||||
|
|
||||||
|
-- Directories containing source files.
|
||||||
|
hs-source-dirs: src
|
||||||
|
|
||||||
|
-- Base language which the package is written in.
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
executable windows12-qc
|
||||||
|
-- Import common warning flags.
|
||||||
|
import: warnings
|
||||||
|
|
||||||
|
-- .hs or .lhs file containing the Main module.
|
||||||
|
main-is: QuickCheckTests.hs
|
||||||
|
|
||||||
|
-- Modules included in this executable, other than Main.
|
||||||
|
other-modules:
|
||||||
|
Windows12.Ast
|
||||||
|
Windows12.Lexer
|
||||||
|
Windows12.Parser
|
||||||
|
|
||||||
|
-- LANGUAGE extensions used by modules in this package.
|
||||||
|
-- other-extensions:
|
||||||
|
|
||||||
|
-- Other library packages from which modules are imported.
|
||||||
|
build-depends:
|
||||||
|
base >= 4.15.1 && < 4.16,
|
||||||
|
megaparsec >= 9.6.1 && < 9.7,
|
||||||
|
text >= 1.2.5 && < 1.3,
|
||||||
|
parser-combinators >= 1.3.0 && < 1.4,
|
||||||
|
prettyprinter >= 1.5.1 && < 1.6,
|
||||||
|
string-conversions >= 0.4.0 && < 0.5,
|
||||||
|
mtl >= 2.2.2 && < 2.3,
|
||||||
|
QuickCheck >= 2.14.2 && < 2.15,
|
||||||
|
|
||||||
-- Directories containing source files.
|
-- Directories containing source files.
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
|
|||||||
Reference in New Issue
Block a user