packages feed

oplang 0.3.0.1 → 0.4.0.0

raw patch · 16 files changed

+442/−404 lines, 16 filesdep ~basedep ~containersdep ~directory

Dependency ranges changed: base, containers, directory, filepath, megaparsec, process

Files

CHANGELOG.md view
@@ -1,3 +1,10 @@+<!-- markdownlint-disable first-line-h1   -->++## v0.4.0.0 \[2023-05-06\]++* Add command-line options for printing the AST and IR, ignoring warnings, and skipping C compilation+* Require GHC 9.2 or newer+ ## v0.3.0.1 \[2022-08-12\]  * Update [`base`](https://hackage.haskell.org/package/base) version bound to require GHC 9.0 (`base` 4.15) or newer
README.md view
@@ -14,11 +14,11 @@  ## Usage -To compile an OpLang file with default options, use:+To compile and run an OpLang program, use:  ```sh oplang code.op-./code+./code.out ```  For a list of available command-line options, use `oplang --help`.@@ -27,16 +27,15 @@  Prerequisites: -* `GHC` >=9.0-* `cabal` >=3.0+* `GHC` >=9.2+* `cabal` >=3.6  (Both can be installed via [ghcup](https://www.haskell.org/ghcup/)) -```sh-cabal build-cabal run . -- <args>-```+To build the project, use `cabal build`. +To run the project locally (without installing), use `cabal run . -- <args>`.+ ## Language Features  OpLang is a strict superset of Brainfuck.@@ -49,7 +48,7 @@  The default size of the stack is 4KB, and the default size for each memory tape is 64KB. These can be modified via the command-line. -## Syntax+### Syntax  OpLang has 10 "intrinsic" operators, 8 of which are the Brainfuck operators, with the same semantics: @@ -80,7 +79,13 @@ ,: a ;. ``` -For more example programs, see the [examples](examples/) folder.+For more example programs, see the [examples](examples) folder.++## Compiler Architecture++The compiler works by translating the input OpLang source into C, and then compiling that using the system's C compiler. To use a different C compiler, set the `CC` environment variable.++The compiler uses an intermediate representation (which can be shown with the `--dump-ir` option) on which it performs a number of optimizations, generating C code that is much smaller and faster than a direct translation would be.  ## License
oplang.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0  name: oplang-version: 0.3.0.1+version: 0.4.0.0 synopsis: Stack-based esoteric programming language description: Please see the README on GitHub at <https://github.com/aionescu/oplang#readme> homepage: https://github.com/aionescu/oplang#readme@@ -9,111 +9,100 @@ license: GPL-3.0-only license-file: LICENSE.txt author: Alex Ionescu-maintainer: alxi.2001@gmail.com-copyright: Copyright (C) 2019-2022 Alex Ionescu+maintainer: aaionescu@pm.me+copyright: Copyright (C) 2019-2023 Alex Ionescu category: Compilers/Interpreters, Language build-type: Simple -extra-source-files:+extra-doc-files:   CHANGELOG.md++extra-source-files:   README.md  source-repository head   type: git   location: https://github.com/aionescu/oplang -executable oplang-  main-is: Main.hs--  other-modules:-    Language.OpLang.Codegen-    Language.OpLang.CompT-    Language.OpLang.IR-    Language.OpLang.Optimize-    Language.OpLang.Parse-    Language.OpLang.Validate-    Opts--  hs-source-dirs: src--  build-depends:-    base >=4.15 && <5-    , containers ^>= 0.6.5-    , directory ^>= 1.3.7-    , filepath ^>= 1.4.2-    , megaparsec ^>= 9.2-    , mtl ^>= 2.3-    , optparse-applicative ^>= 0.17-    , process ^>= 1.6.14-    , text ^>= 2-    , text-builder-linear ^>= 0.1-    , transformers ^>= 0.6--  ghc-options:-    -threaded-    -rtsopts-    -with-rtsopts=-N-    -Wall-    -Wcompat-    -Wincomplete-uni-patterns-    -Wprepositive-qualified-module-    -Wmissing-deriving-strategies-    -Wunused-packages-    -Widentities-    -Wredundant-constraints-    -Wunticked-promoted-constructors-    -Wpartial-fields-    -Wmissing-exported-signatures-    -Wno-name-shadowing-+common ghc-flags+  default-language: GHC2021   default-extensions:     ApplicativeDo-    BangPatterns     BlockArguments-    ConstraintKinds     DataKinds     DefaultSignatures     DeriveAnyClass-    DeriveFoldable-    DeriveFunctor-    DeriveGeneric-    DeriveLift-    DeriveTraversable-    DerivingStrategies     DerivingVia-    EmptyCase-    ExistentialQuantification-    FlexibleContexts-    FlexibleInstances+    DuplicateRecordFields     FunctionalDependencies     GADTs-    GeneralizedNewtypeDeriving-    ImportQualifiedPost-    InstanceSigs-    KindSignatures+    ImplicitParams+    ImpredicativeTypes     LambdaCase+    LexicalNegation     MagicHash-    MultiParamTypeClasses     MultiWayIf-    NamedFieldPuns     NegativeLiterals+    NoFieldSelectors     NoMonomorphismRestriction     NoStarIsType+    OverloadedLabels+    OverloadedRecordDot     OverloadedStrings     PartialTypeSignatures     PatternSynonyms-    RankNTypes+    QuantifiedConstraints     RecordWildCards     RecursiveDo-    ScopedTypeVariables-    StandaloneDeriving-    TupleSections-    TypeApplications-    TypeFamilies     TypeFamilyDependencies-    TypeOperators     UnboxedTuples     UndecidableInstances+    UnliftedDatatypes+    UnliftedNewtypes     ViewPatterns -  default-language: Haskell2010+  ghc-options:+    -threaded+    -rtsopts+    -with-rtsopts=-N+    -Wall+    -Wcompat+    -Widentities+    -Wmissing-deriving-strategies+    -Wno-name-shadowing+    -Wpartial-fields+    -Wprepositive-qualified-module+    -Wredundant-constraints+    -Wunused-packages++executable oplang+  import: ghc-flags++  hs-source-dirs: src+  main-is: Main.hs++  other-modules:+    Control.Monad.Comp+    Language.OpLang.Codegen+    Language.OpLang.Optimizer+    Language.OpLang.Parser+    Language.OpLang.Syntax+    Language.OpLang.Validation+    Opts+    Paths_oplang++  autogen-modules:+    Paths_oplang++  build-depends:+    base >=4.16 && <5+    , containers ^>= 0.6.7+    , directory ^>= 1.3.8+    , filepath ^>= 1.4.100+    , megaparsec ^>= 9.3+    , mtl ^>= 2.3+    , optparse-applicative ^>= 0.17+    , process ^>= 1.6.17+    , text ^>= 2+    , text-builder-linear ^>= 0.1+    , transformers ^>= 0.6
+ src/Control/Monad/Comp.hs view
@@ -0,0 +1,34 @@+module Control.Monad.Comp(CompT(..), runCompT) where++import Control.Applicative(Alternative)+import Control.Monad(MonadPlus)+import Control.Monad.IO.Class(MonadIO)+import Control.Monad.Reader(MonadReader, ReaderT(..))+import Control.Monad.Trans(MonadTrans(..))+import Control.Monad.Trans.Maybe(MaybeT(..))+import Control.Monad.Trans.Writer.CPS(WriterT, runWriterT)+import Control.Monad.Writer.CPS(MonadWriter)+import Data.Text(Text)++import Opts(Opts)++-- The "Compilation" Monad Transformer+newtype CompT m a =+  CompT (ReaderT Opts (MaybeT (WriterT [Text] m)) a)+  deriving newtype+    ( Functor+    , Applicative+    , Alternative+    , Monad+    , MonadPlus+    , MonadReader Opts+    , MonadWriter [Text]+    , MonadIO+    )++instance MonadTrans CompT where+  lift :: Monad m => m a -> CompT m a+  lift = CompT . lift . lift . lift++runCompT :: CompT m a -> Opts -> m (Maybe a, [Text])+runCompT (CompT m) = runWriterT . runMaybeT . runReaderT m
src/Language/OpLang/Codegen.hs view
@@ -1,6 +1,5 @@ module Language.OpLang.Codegen(compile) where -import Control.Monad(unless) import Control.Monad.Reader(ask) import Control.Monad.Trans(lift) import Data.Char(ord)@@ -11,12 +10,13 @@ import Data.Text.Builder.Linear(Builder, fromDec, runBuilder) import Data.Text.IO qualified as T import System.Directory(createDirectoryIfMissing, removeFile)+import System.Environment(lookupEnv) import System.FilePath(dropExtension, takeDirectory) import System.Info(os)-import System.Process(system)+import System.Process(callProcess) -import Language.OpLang.CompT(CompT)-import Language.OpLang.IR+import Control.Monad.Comp(CompT)+import Language.OpLang.Syntax import Opts(Opts(..))  type CCode = Builder@@ -58,16 +58,16 @@  compileOp :: Instr -> CCode compileOp = \case-    Add n o -> tape o <> plusEq n <> fromDec (abs n) <> ";"-    Set n o -> tape o <> "=" <> fromDec n <> ";"-    Pop o -> tape o <> "=*(--s);"-    Push o -> "*(s++)=" <> tape o <> ";"-    Read o -> "scanf(\"%c\",&" <> tape o <> ");"-    Write o -> "printf(\"%c\"," <> tape o <> ");"-    Move n -> "t" <> plusEq n <> fromDec (abs n) <> ";"-    AddCell n o o' -> addCell n o o'-    Loop ops -> "while(*t){" <> compileOps ops <> "}"-    Call c -> cName c <> "();"+  Add n o -> tape o <> plusEq n <> fromDec (abs n) <> ";"+  Set n o -> tape o <> "=" <> fromDec n <> ";"+  Pop o -> tape o <> "=*(--s);"+  Push o -> "*(s++)=" <> tape o <> ";"+  Read o -> "scanf(\"%c\",&" <> tape o <> ");"+  Write o -> "printf(\"%c\"," <> tape o <> ");"+  Move n -> "t" <> plusEq n <> fromDec (abs n) <> ";"+  AddCell n o o' -> addCell n o o'+  Loop ops -> "while(*t){" <> compileOps ops <> "}"+  Call c -> cName c <> "();"  codegen :: Word -> Word -> Program Instr -> Text codegen stackSize tapeSize Program{..} =@@ -81,18 +81,29 @@ exePath path = dropExtension path <> ext os   where     ext "mingw32" = ".exe"-    ext _ = ""+    ext _ = ".out" +ccPath :: IO FilePath+ccPath = fromMaybe "cc" <$> lookupEnv "CC"+ compile :: Program Instr -> CompT IO () compile p = do   Opts{..} <- ask-  let cFile = dropExtension optsPath <> ".c"-  let cCode = codegen optsStackSize optsTapeSize p-  let outFile = fromMaybe (exePath optsPath) optsOutPath+  let cFile = dropExtension path <> ".c"+  let cCode = codegen stackSize tapeSize p -  lift do-    T.writeFile cFile cCode-    createDirectoryIfMissing True $ takeDirectory outFile+  lift+    if noCC then do+      let outFile = fromMaybe cFile outPath+      createDirectoryIfMissing True $ takeDirectory outFile -    system $ show optsCCPath <> " -o " <> show outFile <> " " <> show cFile-    unless optsKeepCFile $ removeFile cFile+      T.writeFile outFile cCode+    else do+      T.writeFile cFile cCode++      let outFile = fromMaybe (exePath path) outPath+      createDirectoryIfMissing True $ takeDirectory outFile++      cc <- ccPath+      callProcess cc ["-o", outFile, cFile]+      removeFile cFile
− src/Language/OpLang/CompT.hs 
@@ -1,31 +0,0 @@-module Language.OpLang.CompT(CompT(..)) where--import Control.Applicative(Alternative)-import Control.Monad(MonadPlus)-import Control.Monad.IO.Class(MonadIO)-import Control.Monad.Reader(MonadReader, ReaderT(..))-import Control.Monad.Trans(MonadTrans(..))-import Control.Monad.Trans.Maybe(MaybeT(..))-import Control.Monad.Writer.Strict(MonadWriter, WriterT(..))-import Data.Coerce(coerce)-import Data.Text(Text)--import Opts(Opts)---- The "Compilation" Monad Transformer-newtype CompT m a =-  CompT { runCompT :: Opts -> m (Maybe a, [Text]) }-  deriving-    ( Functor-    , Applicative-    , Alternative-    , Monad-    , MonadPlus-    , MonadReader Opts-    , MonadWriter [Text]-    , MonadIO-    )-    via ReaderT Opts (MaybeT (WriterT [Text] m))--instance MonadTrans CompT where-  lift = coerce . lift @(ReaderT Opts) . lift @MaybeT . lift @(WriterT [Text])
− src/Language/OpLang/IR.hs 
@@ -1,42 +0,0 @@-{-# LANGUAGE StrictData #-}--module Language.OpLang.IR where--import Data.Int(Int8)-import Data.Map.Strict(Map)--type Id = Char-type Val = Int8-type Offset = Int---- "Surface-level" AST, produced by the parser-data Op-  = Incr-  | Decr-  | MoveL-  | MoveR-  | Read'-  | Write'-  | Pop'-  | Push'-  | Loop' [Op]-  | Call' Id---- Internal AST, used for optimizations and codegen-data Instr-  = Add Val Offset-  | Set Val Offset-  | Read Offset-  | Write Offset-  | Pop Offset-  | Push Offset-  | Move Offset-  | Loop [Instr]-  | Call Id-  | AddCell Val Offset Offset--data Program op-  = Program-  { opDefs :: Map Id [op]-  , topLevel :: [op]-  }
− src/Language/OpLang/Optimize.hs 
@@ -1,59 +0,0 @@-module Language.OpLang.Optimize(optimize) where--import Language.OpLang.IR--syncTally :: Bool -> Val -> Offset -> [Instr] -> [Instr]-syncTally False 0 _ acc = acc-syncTally False n offset acc = Add n offset : acc-syncTally True n offset acc = Set n offset : acc--syncOffset :: Offset -> [Instr] -> [Instr]-syncOffset 0 acc = acc-syncOffset n acc = Move n : acc--syncAll :: Bool -> Val -> Offset -> [Instr] -> [Instr]-syncAll known tally offset = syncTally known tally 0 . syncOffset offset--removeSet0 :: [Instr] -> [Instr]-removeSet0 (Set 0 0 : ops) = ops-removeSet0 ops = ops--optimizeOps :: [Op] -> [Instr]-optimizeOps = removeSet0 . go False True 0 0 []-  where-    go :: Bool -> Bool -> Val -> Offset -> [Instr] -> [Op] -> [Instr]-    go False _ _ _ acc [] = reverse acc-    go True known tally offset acc [] = reverse $ syncAll known tally offset acc-    go loop known tally offset acc (op : ops) =-      case op of-        Incr -> go loop known (tally + 1) offset acc ops-        Decr -> go loop known (tally - 1) offset acc ops-        Read' -> go loop False 0 offset (Read offset : acc) ops-        Pop' -> go loop False 0 offset (Pop offset : acc) ops--        MoveL -> go loop False 0 (offset - 1) (syncTally known tally offset acc) ops-        MoveR -> go loop False 0 (offset + 1) (syncTally known tally offset acc) ops-        Write' -> go loop False 0 offset (Write offset : syncTally known tally offset acc) ops-        Push' -> go loop False 0 offset (Push offset : syncTally known tally offset acc) ops-        Call' c -> go loop False 0 offset (Call c : syncTally known tally offset acc) ops--        Loop' _ | (True, 0) <- (known, tally) -> go loop known tally offset acc ops-        Loop' l ->-          case go True False 0 0 [] l of-            [Add 1 0] -> go loop True 0 offset acc ops-            [Add -1 0] -> go loop True 0 offset acc ops--            [Add 1 o] -> go loop known tally offset (Set 0 (offset + o) : acc) ops-            [Add -1 o] -> go loop known tally offset (Set 0 (offset + o) : acc) ops--            [Add n o, Add -1 0] -> go loop False 0 offset (AddCell n (o + offset) offset : syncTally known tally offset acc) ops-            [Add -1 0, Add n o] -> go loop False 0 offset (AddCell n (o + offset) offset : syncTally known tally offset acc) ops--            l' -> go loop False 0 0 (Loop l' : syncAll known tally offset acc) ops--optimize :: Program Op -> Program Instr-optimize Program{..} =-  Program-  { opDefs = optimizeOps <$> opDefs-  , topLevel = optimizeOps topLevel-  }
+ src/Language/OpLang/Optimizer.hs view
@@ -0,0 +1,67 @@+module Language.OpLang.Optimizer(optimize) where++import Control.Monad(when)+import Control.Monad.Reader(ask)+import Control.Monad.Trans(lift)+import Data.Functor(($>))++import Control.Monad.Comp(CompT)+import Language.OpLang.Syntax+import Opts(Opts(..))++syncTally :: Bool -> Val -> Offset -> [Instr] -> [Instr]+syncTally False 0 _ acc = acc+syncTally False n offset acc = Add n offset : acc+syncTally True n offset acc = Set n offset : acc++syncOffset :: Offset -> [Instr] -> [Instr]+syncOffset 0 acc = acc+syncOffset n acc = Move n : acc++syncAll :: Bool -> Val -> Offset -> [Instr] -> [Instr]+syncAll known tally offset = syncTally known tally 0 . syncOffset offset++removeSet0 :: [Instr] -> [Instr]+removeSet0 (Set 0 0 : ops) = ops+removeSet0 ops = ops++optimizeOps :: [Op] -> [Instr]+optimizeOps = removeSet0 . go False True 0 0 []+  where+    go :: Bool -> Bool -> Val -> Offset -> [Instr] -> [Op] -> [Instr]+    go False _ _ _ acc [] = reverse acc+    go True known tally offset acc [] = reverse $ syncAll known tally offset acc+    go loop known tally offset acc (op : ops) =+      case op of+        Incr -> go loop known (tally + 1) offset acc ops+        Decr -> go loop known (tally - 1) offset acc ops+        Read' -> go loop False 0 offset (Read offset : acc) ops+        Pop' -> go loop False 0 offset (Pop offset : acc) ops++        MoveL -> go loop False 0 (offset - 1) (syncTally known tally offset acc) ops+        MoveR -> go loop False 0 (offset + 1) (syncTally known tally offset acc) ops+        Write' -> go loop False 0 offset (Write offset : syncTally known tally offset acc) ops+        Push' -> go loop False 0 offset (Push offset : syncTally known tally offset acc) ops+        Call' c -> go loop False 0 offset (Call c : syncTally known tally offset acc) ops++        Loop' _ | (True, 0) <- (known, tally) -> go loop known tally offset acc ops+        Loop' l ->+          case go True False 0 0 [] l of+            [Add n 0] | abs n == 1 -> go loop True 0 offset acc ops+            [Add n o] | abs n == 1 -> go loop known tally offset (Set 0 (offset + o) : acc) ops++            [Add n o, Add m 0] | abs m == 1 -> go loop False 0 offset (AddCell n (o + offset) offset : syncTally known tally offset acc) ops+            [Add m 0, Add n o] | abs m == 1 -> go loop False 0 offset (AddCell n (o + offset) offset : syncTally known tally offset acc) ops++            l' -> go loop False 0 0 (Loop l' : syncAll known tally offset acc) ops++optimize :: Program Op -> CompT IO (Program Instr)+optimize Program{..} = do+  Opts{..} <- ask+  when dumpIR (lift $ putStrLn $ "IR:\n" <> show p <> "\n") $> p+  where+    p =+      Program+      { opDefs = optimizeOps <$> opDefs+      , topLevel = optimizeOps topLevel+      }
− src/Language/OpLang/Parse.hs 
@@ -1,86 +0,0 @@-module Language.OpLang.Parse(parse) where--import Control.Monad.Reader(asks)-import Control.Monad.Writer.Strict(tell)-import Data.Functor(($>))-import Data.List(intercalate)-import Data.Map.Strict(Map)-import Data.Map.Strict qualified as M-import Data.Set qualified as S-import Data.Text(Text)-import Data.Text qualified as T-import Data.Void(Void)-import Text.Megaparsec hiding (parse)-import Text.Megaparsec.Char(space1)-import Text.Megaparsec.Char.Lexer qualified as L--import Language.OpLang.CompT(CompT)-import Language.OpLang.IR(Program(..), Op(..), Id)-import Opts(Opts(..))--type Parser = Parsec Void Text--ws :: Parser ()-ws = L.space space1 (L.skipLineComment "#") empty--lexeme :: Parser a -> Parser a-lexeme = L.lexeme ws--symbol :: Text -> Parser Text-symbol = L.symbol ws--reserved :: [Char]-reserved = "+-<>,.;:[]{}"--intrinsic :: Parser Op-intrinsic =-  choice-  [ symbol "+" $> Incr-  , symbol "-" $> Decr-  , symbol "<" $> MoveL-  , symbol ">" $> MoveR-  , symbol "," $> Read'-  , symbol "." $> Write'-  , symbol ";" $> Pop'-  , symbol ":" $> Push'-  ]-  <?> "intrinsic operator"--block :: Text -> Text -> Parser [Op]-block b e = between (symbol b) (symbol e) $ many op--loop :: Parser Op-loop = Loop' <$> block "[" "]" <?> "loop"--custom :: Parser Char-custom = lexeme (satisfy (`notElem` reserved) <?> "custom operator")--op :: Parser Op-op = choice [loop, intrinsic, Call' <$> custom] <?> "operator"--def :: Parser (Id, [Op])-def = (,) <$> lexeme custom <*> block "{" "}" <?> "definition"--defs :: Parser (Map Id [Op])-defs = many (try def) >>= toMap-  where-    toMap ds-      | unique = pure $ M.fromList ds-      | otherwise = fail $ "Duplicate definition of operators: " <> intercalate ", " (show <$> S.toList set)-      where-        ids = fst <$> ds-        set = S.fromList ids-        unique = S.size set == length ids--program :: Parser (Program Op)-program = Program <$> defs <*> (many op <?> "toplevel")--programFull :: Parser (Program Op)-programFull = ws *> program <* eof--parse :: Monad m => Text -> CompT m (Program Op)-parse code = do-  file <- asks optsPath-  case runParser programFull file code of-    Left e -> tell [T.pack $ errorBundlePretty e] *> empty-    Right p -> pure p
+ src/Language/OpLang/Parser.hs view
@@ -0,0 +1,89 @@+module Language.OpLang.Parser(parse) where++import Control.Monad(when)+import Control.Monad.Reader(ask)+import Control.Monad.Trans(lift)+import Control.Monad.Writer(tell)+import Data.Functor(($>))+import Data.List(intercalate)+import Data.Map.Strict(Map)+import Data.Map.Strict qualified as M+import Data.Set qualified as S+import Data.Text(Text)+import Data.Text qualified as T+import Data.Void(Void)+import Text.Megaparsec hiding (parse)+import Text.Megaparsec.Char(space1)+import Text.Megaparsec.Char.Lexer qualified as L++import Control.Monad.Comp(CompT)+import Language.OpLang.Syntax+import Opts(Opts(..))++type Parser = Parsec Void Text++ws :: Parser ()+ws = L.space space1 (L.skipLineComment "#") empty++lexeme :: Parser a -> Parser a+lexeme = L.lexeme ws++symbol :: Text -> Parser Text+symbol = L.symbol ws++reserved :: Text+reserved = "+-<>,.;:[]{}"++intrinsic :: Parser Op+intrinsic =+  choice+  [ symbol "+" $> Incr+  , symbol "-" $> Decr+  , symbol "<" $> MoveL+  , symbol ">" $> MoveR+  , symbol "," $> Read'+  , symbol "." $> Write'+  , symbol ";" $> Pop'+  , symbol ":" $> Push'+  ] <?> "intrinsic operator"++block :: Text -> Text -> Parser [Op]+block b e = between (symbol b) (symbol e) $ many op++loop :: Parser Op+loop = Loop' <$> block "[" "]" <?> "loop"++custom :: Parser Char+custom = lexeme (satisfy $ not . (`T.elem` reserved)) <?> "custom operator"++op :: Parser Op+op =+  choice+  [ loop+  , intrinsic+  , Call' <$> custom+  ] <?> "operator"++def :: Parser (Id, [Op])+def = (,) <$> custom <*> block "{" "}" <?> "definition"++defs :: Parser (Map Id [Op])+defs = many (try def) >>= toMap+  where+    toMap ds+      | unique = pure $ M.fromList ds+      | otherwise = fail $ "Duplicate definition of operators: " <> intercalate ", " (show <$> S.toList set)+      where+        ids = fst <$> ds+        set = S.fromList ids+        unique = S.size set == length ids++program :: Parser (Program Op)+program = Program <$> defs <*> (many op <?> "toplevel")++parse :: Text -> CompT IO (Program Op)+parse code = do+  Opts{..} <- ask+  case runParser (ws *> program <* eof) path code of+    Left e -> tell ["Parse error at " <> T.pack (errorBundlePretty e)] *> empty+    Right p -> when dumpAST (lift $ putStrLn $ "AST:\n" <> show p <> "\n") $> p
+ src/Language/OpLang/Syntax.hs view
@@ -0,0 +1,43 @@+module Language.OpLang.Syntax where++import Data.Int(Int8)+import Data.Map.Strict(Map)++type Id = Char+type Val = Int8+type Offset = Int++-- Surface-level AST, produced by the parser+data Op+  = Incr+  | Decr+  | MoveL+  | MoveR+  | Read'+  | Write'+  | Pop'+  | Push'+  | Loop' [Op]+  | Call' Id+  deriving stock Show++-- Internal IR, used for optimizations and codegen+data Instr+  = Add Val Offset+  | Set Val Offset+  | Read Offset+  | Write Offset+  | Pop Offset+  | Push Offset+  | Move Offset+  | Loop [Instr]+  | Call Id+  | AddCell Val Offset Offset+  deriving stock Show++data Program op+  = Program+  { opDefs :: Map Id [op]+  , topLevel :: [op]+  }+  deriving stock Show
− src/Language/OpLang/Validate.hs 
@@ -1,58 +0,0 @@-module Language.OpLang.Validate(validate) where--import Control.Monad(guard, unless)-import Control.Monad.Writer.Strict(tell)-import Data.Bifunctor(bimap)-import Data.Functor(($>))-import Data.List(intercalate)-import Data.Map.Strict(Map)-import Data.Map.Strict qualified as M-import Data.Set(Set)-import Data.Set qualified as S-import Data.Text(Text)-import Data.Text qualified as T--import Language.OpLang.CompT(CompT)-import Language.OpLang.IR(Program(..), Op(..), Id)--calledOps :: [Op] -> Set Id-calledOps = foldMap \case-  Call' op -> S.singleton op-  Loop' ops -> calledOps ops-  _ -> S.empty--enumerate :: Show a => [a] -> Text-enumerate l = T.pack $ intercalate ", " $ show <$> l--errUndefinedCalls :: Monad m => Program Op -> CompT m ()-errUndefinedCalls Program{..} = tell errors *> guard (null errors)-  where-    defined = M.keysSet opDefs--    undefinedInTopLevel = (Nothing, calledOps topLevel S.\\ defined)-    undefinedInDefs = bimap Just ((S.\\ defined) . calledOps) <$> M.toList opDefs--    fmt = maybe "top level" $ ("definition of " <>) . T.pack . show-    toMsg (name, ops) =-      "Error (in " <> fmt name <> "): Calls to undefined operators: " <> enumerate (S.toList ops)--    errors = toMsg <$> filter (not . S.null . snd) (undefinedInTopLevel : undefinedInDefs)--allUsedOps :: Map Id [Op] -> Set Id -> [Op] -> Set Id-allUsedOps defs seen ops-  | S.null used = seen-  | otherwise = foldMap (allUsedOps defs (seen <> used) . (defs M.!)) used-  where-    used = calledOps ops S.\\ seen--warnUnusedOps :: Monad m => Program Op -> CompT m (Program Op)-warnUnusedOps p@Program{..} =-  unless (M.null unusedDefs) warn $> p { opDefs = usedDefs }-  where-    warn = tell ["Warning: Unused operators: " <> enumerate (M.keys unusedDefs)]-    unusedDefs = opDefs M.\\ usedDefs-    usedDefs = M.restrictKeys opDefs usedOps-    usedOps = allUsedOps opDefs S.empty topLevel--validate :: Monad m => Program Op -> CompT m (Program Op)-validate p = errUndefinedCalls p *> warnUnusedOps p
+ src/Language/OpLang/Validation.hs view
@@ -0,0 +1,61 @@+module Language.OpLang.Validation(validate) where++import Control.Monad(guard, unless)+import Control.Monad.Reader(ask)+import Control.Monad.Writer(tell)+import Data.Bifunctor(bimap)+import Data.Functor(($>))+import Data.List(intercalate)+import Data.Map.Strict(Map)+import Data.Map.Strict qualified as M+import Data.Set(Set)+import Data.Set qualified as S+import Data.Text(Text)+import Data.Text qualified as T++import Control.Monad.Comp(CompT)+import Language.OpLang.Syntax+import Opts(Opts(..))++calledOps :: [Op] -> Set Id+calledOps = foldMap \case+  Call' op -> S.singleton op+  Loop' ops -> calledOps ops+  _ -> S.empty++enumerate :: Show a => [a] -> Text+enumerate l = T.pack $ intercalate ", " $ show <$> l++checkUndefinedCalls :: Monad m => Program Op -> CompT m ()+checkUndefinedCalls Program{..} = tell errors *> guard (null errors)+  where+    defined = M.keysSet opDefs++    undefinedInTopLevel = (Nothing, calledOps topLevel S.\\ defined)+    undefinedInDefs = bimap Just ((S.\\ defined) . calledOps) <$> M.toList opDefs++    fmt = maybe "top level" $ ("definition of " <>) . T.pack . show+    toMsg (name, ops) =+      "Error (in " <> fmt name <> "): Calls to undefined operators: " <> enumerate (S.toList ops)++    errors = toMsg <$> filter (not . S.null . snd) (undefinedInTopLevel : undefinedInDefs)++allUsedOps :: Map Id [Op] -> Set Id -> [Op] -> Set Id+allUsedOps defs seen ops+  | S.null used = seen+  | otherwise = foldMap (allUsedOps defs (seen <> used) . (defs M.!)) used+  where+    used = calledOps ops S.\\ seen++removeUnusedOps :: Monad m => Program Op -> CompT m (Program Op)+removeUnusedOps p@Program{..} = do+  Opts{..} <- ask+  unless (noWarn || M.null unusedDefs) warn $> p { opDefs = usedDefs }+  where+    warn = tell ["Warning: Unused operators: " <> enumerate (M.keys unusedDefs)]+    unusedDefs = opDefs M.\\ usedDefs+    usedDefs = M.restrictKeys opDefs usedOps+    usedOps = allUsedOps opDefs S.empty topLevel++validate :: Monad m => Program Op -> CompT m (Program Op)+validate p = checkUndefinedCalls p *> removeUnusedOps p
src/Main.hs view
@@ -1,6 +1,5 @@ module Main(main) where -import Control.Category((>>>)) import Control.Monad((>=>)) import Control.Monad.Reader(asks) import Control.Monad.Trans(lift)@@ -8,24 +7,25 @@ import Data.Foldable(traverse_) import Data.Text(Text) import Data.Text.IO qualified as T+import Data.Tuple(swap) import System.Exit(exitFailure) +import Control.Monad.Comp(CompT, runCompT) import Language.OpLang.Codegen(compile)-import Language.OpLang.CompT(CompT(..))-import Language.OpLang.Optimize(optimize)-import Language.OpLang.Parse(parse)-import Language.OpLang.Validate(validate)+import Language.OpLang.Optimizer(optimize)+import Language.OpLang.Parser(parse)+import Language.OpLang.Validation(validate) import Opts(Opts(..), getOpts)  getCode :: CompT IO Text-getCode = lift . T.readFile =<< asks optsPath+getCode = lift . T.readFile =<< asks (.path)  pipeline :: CompT IO () pipeline =-  getCode >>= (parse >=> validate >=> optimize >>> compile)+  getCode >>= (parse >=> validate >=> optimize >=> compile)  main :: IO () main =   getOpts   >>= runCompT pipeline-  >>= bitraverse_ (maybe exitFailure pure) (traverse_ T.putStrLn)+  >>= bitraverse_ (traverse_ T.putStrLn) (maybe exitFailure pure) . swap
src/Opts.hs view
@@ -2,37 +2,45 @@  module Opts(Opts(..), getOpts) where +import Data.Version(showVersion) import Options.Applicative +import Paths_oplang(version)+ data Opts =   Opts-  { optsStackSize :: Word-  , optsTapeSize :: Word-  , optsKeepCFile :: Bool-  , optsCCPath :: FilePath-  , optsOutPath :: Maybe FilePath-  , optsPath :: FilePath+  { stackSize :: Word+  , tapeSize :: Word+  , noWarn :: Bool+  , noCC :: Bool+  , dumpAST :: Bool+  , dumpIR :: Bool+  , outPath :: Maybe FilePath+  , path :: FilePath   }  optsParser :: ParserInfo Opts optsParser =   info-    (infoOption "oplang v0.3.0.1" (short 'v' <> long "version" <> help "Shows version information.")+    (infoOption ("oplang v" <> ver) (short 'v' <> long "version" <> help "Shows version information.")       <*> helper       <*> programOptions)     (fullDesc       <> progDesc "Compiles an OpLang source file to a native executable."       <> header "oplang - The OpLang Compiler")-   where+    ver = showVersion version+     programOptions :: Parser Opts     programOptions =       Opts-      <$> option auto (short 'S' <> long "stack-size" <> value 4096 <> metavar "SIZE" <> help "Size of the stack.")-      <*> option auto (short 'T' <> long "tape-size" <> value 65536 <> metavar "SIZE" <> help "Size of the memory tape.")-      <*> switch (short 'K' <> long "keep-c-file" <> help "Keep the resulting C file.")-      <*> strOption (short 'C' <> long "cc-path" <> value "cc" <> metavar "PATH" <> help "Path of the C compiler to use.")-      <*> optional (strOption (short 'o' <> long "out-path" <> metavar "PATH" <> help "Path of the resulting executable."))+      <$> option auto (long "stack-size" <> value 4096 <> metavar "SIZE" <> help "Size of the stack.")+      <*> option auto (long "tape-size" <> value 65536 <> metavar "SIZE" <> help "Size of the memory tape.")+      <*> switch (long "no-warn" <> help "Don't report warnings.")+      <*> switch (long "no-cc" <> help "Output a C file without compiling it.")+      <*> switch (long "dump-ast" <> help "Print the AST after parsing.")+      <*> switch (long "dump-ir" <> help "Print the IR after optimization.")+      <*> optional (strOption (short 'o' <> long "out-path" <> metavar "PATH" <> help "Path of the resulting executable (or C file if --no-cc is passed)."))       <*> strArgument (metavar "PATH" <> help "The source file to compile.")  getOpts :: IO Opts