Add LVal to AST

Fix prettyprinter version conflict

.gitignore

@@ -21,3 +21,7 @@ cabal.project.local
 cabal.project.local~
 .HTF/
 .ghc.environment.*
+
+# Windows12 output files
+*.ll
+*.s

README.md

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

cabal.project

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

flake.lock

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

flake.nix

@@ -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
+          ];
+        };
+      }
+    );
+}

src/Main.hs

@@ -1,4 +1,29 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 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 = 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))

src/QuickCheckTests.hs

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

src/Windows12.hs

@@ -0,0 +1,6 @@
+module Windows12 where
+
+import Windows12.Ast
+import Windows12.Lexer
+import Windows12.Parser
+import Windows12.CodeGen

src/Windows12/Ast.hs

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

src/Windows12/CodeGen.hs

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

src/Windows12/Lexer.hs

@@ -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 "]")

src/Windows12/Parser.hs

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

test/arith.w12

@@ -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;
+}

test/bad.w12

@@ -0,0 +1 @@
+function test() {}

test/basic-structs.w12

@@ -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;
+}

test/fib.w12

@@ -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;
+}

test/functions.w12

@@ -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;
+}
+
+

test/hello.w12

@@ -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;
+}

test/sizeof.w12

@@ -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;
+}

windows12.cabal

@@ -63,7 +63,12 @@ executable windows12
     main-is:          Main.hs
 
     -- 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.
     -- other-extensions:
@@ -72,7 +77,46 @@ executable windows12
     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.
     hs-source-dirs:   src