diff --git a/flake.nix b/flake.nix index c0bde101..38929581 100644 --- a/flake.nix +++ b/flake.nix @@ -75,7 +75,14 @@ inherit (protosBuild) compilerHsPb; inherit (pre-commit-check) shellHook; }; - compilerFlake = compilerBuild.compilerHsNixProj.flake { }; + compilerFlake = compilerBuild.hsNixProj.flake { }; + + frontendBuild = import ./lambda-buffers-frontend/build.nix { + inherit pkgs compiler-nix-name index-state haskell-nix mlabs-tooling commonTools; + inherit (protosBuild) compilerHsPb; + inherit (pre-commit-check) shellHook; + }; + frontendFlake = frontendBuild.hsNixProj.flake { }; # Utilities # INFO: Will need this; renameAttrs = rnFn: pkgs.lib.attrsets.mapAttrs' (n: value: { name = rnFn n; inherit value; }); @@ -85,7 +92,7 @@ inherit pkgs; # Standard flake attributes - packages = { inherit (protosBuild) compilerHsPb; } // compilerFlake.packages; + packages = { inherit (protosBuild) compilerHsPb; } // compilerFlake.packages // frontendFlake.packages; devShells = rec { dev-pre-commit = preCommitDevShell; @@ -93,6 +100,7 @@ dev-docs = docsDevShell; dev-protos = protosBuild.devShell; dev-compiler = compilerFlake.devShell; + dev-frontend = frontendFlake.devShell; default = preCommitDevShell; }; diff --git a/lambda-buffers-compiler/build.nix b/lambda-buffers-compiler/build.nix index 4a2debf3..354eb0d9 100644 --- a/lambda-buffers-compiler/build.nix +++ b/lambda-buffers-compiler/build.nix @@ -27,7 +27,7 @@ let allComponent.doHaddock = true; # Enable strict compilation - allComponent.configureFlags = [ "-f-dev" ]; + lambda-buffers-compiler.configureFlags = [ "-f-dev" ]; }; }) ]; @@ -40,10 +40,6 @@ let nativeBuildInputs = builtins.attrValues commonTools; - additional = ps: [ - ps.lambda-buffers-compiler-pb - ]; - tools = { cabal = { }; haskell-language-server = { }; @@ -59,7 +55,7 @@ let }; in { - compilerHsNixProj = haskell-nix.cabalProject' [ + hsNixProj = haskell-nix.cabalProject' [ mlabs-tooling.lib.mkHackageMod project ]; diff --git a/lambda-buffers-compiler/lambda-buffers-compiler.cabal b/lambda-buffers-compiler/lambda-buffers-compiler.cabal index 10118009..c54e0b52 100644 --- a/lambda-buffers-compiler/lambda-buffers-compiler.cabal +++ b/lambda-buffers-compiler/lambda-buffers-compiler.cabal @@ -79,24 +79,15 @@ common common-language default-language: Haskell2010 -common common-dependencies - build-depends: - , base >=4.16 - , containers >=0.6 - , lens >=5.2 - , proto-lens >=0.7 - , text >=1.2 - , transformers >=0.5 - library import: common-language - import: common-dependencies build-depends: - , containers >=0.6 + , base >=4.16 , freer-simple >=1.2 , lambda-buffers-compiler-pb >=0.1.0.0 - , mtl >=2.2 + , lens >=5.2 , prettyprinter >=1.7 + , text >=1.2 exposed-modules: LambdaBuffers.Compiler.KindCheck @@ -104,9 +95,8 @@ library hs-source-dirs: src -executable lambda-buffers-compiler +executable lambda-buffers-compiler-cli import: common-language - import: common-dependencies main-is: Main.hs build-depends: , base >=4.16 @@ -118,18 +108,13 @@ executable lambda-buffers-compiler test-suite tests import: common-language - import: common-dependencies type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Test.hs build-depends: - , hedgehog >=1 + , base >=4.16 , lambda-buffers-compiler - , QuickCheck >=2 , tasty >=1.4 - , tasty-expected-failure >=0.12 - , tasty-hedgehog >=1.4 , tasty-hunit >=0.10 - , tasty-quickcheck >=0.10 other-modules: Test.KindCheck diff --git a/lambda-buffers-compiler/src/LambdaBuffers/Compiler/KindCheck.hs b/lambda-buffers-compiler/src/LambdaBuffers/Compiler/KindCheck.hs index 5674cfa7..b086de80 100644 --- a/lambda-buffers-compiler/src/LambdaBuffers/Compiler/KindCheck.hs +++ b/lambda-buffers-compiler/src/LambdaBuffers/Compiler/KindCheck.hs @@ -18,7 +18,7 @@ import Control.Lens (folded, makeLenses, to, (&), (.~), (^.), (^..)) import Control.Monad.Freer (Eff, interpret, run) import Control.Monad.Freer.Error (Error, runError, throwError) import Control.Monad.Freer.TH (makeEffect) -import Data.Text (Text, unpack) +import Data.Text (Text, intercalate, unpack) import LambdaBuffers.Compiler.KindCheck.Inference ( Context, InferErr, @@ -32,7 +32,7 @@ import Control.Monad (void) import Data.Traversable (for) import Proto.Compiler ( Product'NTuple, - Product'Product (Product'Empty', Product'Ntuple, Product'Record'), + Product'Product (Product'Ntuple, Product'Record'), Product'Record, Sum, Ty, @@ -54,6 +54,7 @@ import Proto.Compiler_Fields as PF ( maybe'tyRef, moduleName, name, + parts, product, tyAbs, tyArgs, @@ -171,7 +172,6 @@ sumToType sumT = do for products $ \case - Just (Product'Empty' _) -> pure $ Var "()" Just (Product'Ntuple nt) -> nTupleToType nt Just (Product'Record' re) -> recordToType re Nothing -> throwError $ InvalidProto "Every constructor should have a product defining it" @@ -236,5 +236,5 @@ tyRefToType :: TyRef -> Eff KindCheckFailEff Type tyRefToType tR = do case tR ^. maybe'tyRef of Just (TyRef'LocalTyRef t) -> pure $ Var $ t ^. tyName . name . to unpack - Just (TyRef'ForeignTyRef t) -> pure $ Var $ (t ^. moduleName . name . to unpack) <> "." <> (t ^. tyName . name . to unpack) + Just (TyRef'ForeignTyRef t) -> pure $ Var $ (t ^. moduleName . parts . to (\ps -> unpack $ intercalate "." [p ^. name | p <- ps])) <> "." <> (t ^. tyName . name . to unpack) Nothing -> throwError $ InvalidProto "TyRef Cannot be empty" diff --git a/lambda-buffers-compiler/test/Test.hs b/lambda-buffers-compiler/test/Test.hs index affd4634..5f39b210 100644 --- a/lambda-buffers-compiler/test/Test.hs +++ b/lambda-buffers-compiler/test/Test.hs @@ -1,9 +1,7 @@ -{-# LANGUAGE ImportQualifiedPost #-} - module Main (main) where import Test.KindCheck qualified as KC -import Test.Tasty +import Test.Tasty (defaultMain, testGroup) main :: IO () -main = defaultMain $ testGroup "All Tests" [KC.test] +main = defaultMain $ testGroup "Compiler tests" [KC.test] diff --git a/lambda-buffers-compiler/test/Test/KindCheck.hs b/lambda-buffers-compiler/test/Test/KindCheck.hs index 657eee4a..d445da27 100644 --- a/lambda-buffers-compiler/test/Test/KindCheck.hs +++ b/lambda-buffers-compiler/test/Test/KindCheck.hs @@ -1,36 +1,48 @@ -{-# OPTIONS_GHC -Wno-missing-signatures #-} - module Test.KindCheck (test) where -import LambdaBuffers.Compiler.KindCheck -import LambdaBuffers.Compiler.KindCheck.Inference -import Test.Tasty -import Test.Tasty.HUnit +import LambdaBuffers.Compiler.KindCheck ( + KindCheckFailure (InferenceFailed), + TypeDefinition (TypeDefinition, _td'name, _td'sop, _td'variables), + kindCheckType, + runKindCheckEff, + ) +import LambdaBuffers.Compiler.KindCheck.Inference ( + InferErr (ImpossibleUnificationErr), + Kind (Type, (:->:)), + Type (Abs, App, Var), + ) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (testCase, (@?=)) test :: TestTree -test = testGroup "KindChecker Tests" [t1, t2, t3, t4, t5] +test = testGroup "KindChecker tests" [t1, t2, t3, t4, t5] runKC :: [TypeDefinition] -> Either KindCheckFailure [Kind] runKC = runKindCheckEff . kindCheckType +t1 :: TestTree t1 = - testCase "No Definition, No Kinds." $ + testCase "No Definition, No Kinds" $ runKC [] @?= Right [] +t2 :: TestTree t2 = - testCase "Maybe has the correct Kind." $ + testCase "Maybe has the correct Kind" $ runKC [tdMaybe] @?= Right [Type :->: Type] +t3 :: TestTree t3 = - testCase "Maybe works correctly when used as a type." $ + testCase "Maybe works correctly when used as a type" $ runKC [tdT1, tdMaybe] @?= Right [Type :->: Type, Type :->: Type] +t4 :: TestTree t4 = - testCase "Maybe and a term containing a maybe work correctly." $ + testCase "Maybe and a term containing a maybe work correctly" $ runKC [tdT1, tdMaybe, tdT2] @?= Right [Type :->: Type, Type :->: Type, Type :->: Type] +t5 :: TestTree t5 = - testCase "Bad Type is caught and reported." $ + testCase "Bad Type is caught and reported" $ runKC [tdMaybe, tdBT0] @?= Left ( InferenceFailed @@ -46,6 +58,7 @@ t5 = -------------------------------------------------------------------------------- -- Manual type definitions. +tdMaybe :: TypeDefinition tdMaybe = TypeDefinition { _td'name = "Maybe" @@ -58,6 +71,7 @@ tdMaybe = } -- T1 ~ T a = T Maybe (Maybe a) +tdT1 :: TypeDefinition tdT1 = TypeDefinition { _td'name = "T" @@ -66,6 +80,7 @@ tdT1 = } -- T2 ~ T a = T Maybe (Maybe a) +tdT2 :: TypeDefinition tdT2 = TypeDefinition { _td'name = "T2" @@ -74,6 +89,7 @@ tdT2 = } -- T2 ~ T = T Maybe Maybe +tdBT0 :: TypeDefinition tdBT0 = TypeDefinition { _td'name = "T" diff --git a/lambda-buffers-frontend/.envrc b/lambda-buffers-frontend/.envrc new file mode 100644 index 00000000..5c96b3a7 --- /dev/null +++ b/lambda-buffers-frontend/.envrc @@ -0,0 +1 @@ +use flake ..#dev-frontend diff --git a/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Compile.hs b/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Compile.hs new file mode 100644 index 00000000..23dfa4e0 --- /dev/null +++ b/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Compile.hs @@ -0,0 +1,26 @@ +module LambdaBuffers.Frontend.Cli.Compile (CompileOpts (..), compile) where + +import Control.Lens (makeLenses, (^.)) +import Data.Map qualified as Map +import LambdaBuffers.Frontend (runFrontend) +import LambdaBuffers.Frontend.PPrint () +import Prettyprinter (Pretty (pretty)) +import Proto.Compiler () + +data CompileOpts = CompileOpts + { _importPaths :: [FilePath] + , _moduleFilepath :: FilePath + } + deriving stock (Eq, Show) + +makeLenses ''CompileOpts + +-- | Compile a filepath containing a LambdaBuffers module +compile :: CompileOpts -> IO () +compile opts = do + errOrMod <- runFrontend (opts ^. importPaths) (opts ^. moduleFilepath) + case errOrMod of + Left err -> print err + Right mods -> do + putStrLn "OK" + putStrLn $ "Compiler closure contains the following modules: " <> (show . pretty . Map.elems $ mods) diff --git a/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Format.hs b/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Format.hs new file mode 100644 index 00000000..95106aef --- /dev/null +++ b/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Format.hs @@ -0,0 +1,29 @@ +module LambdaBuffers.Frontend.Cli.Format (FormatOpts (..), format) where + +import Control.Lens (makeLenses, (^.)) +import Data.Text.IO qualified as Text +import LambdaBuffers.Frontend.PPrint () +import LambdaBuffers.Frontend.Parsec qualified as Parsec +import Prettyprinter (Pretty (pretty)) +import Proto.Compiler () + +data FormatOpts = FormatOpts + { _moduleFilepath :: FilePath + , _inPlace :: Bool + } + deriving stock (Eq, Show) + +makeLenses ''FormatOpts + +-- | Format a LambdaBuffers file +format :: FormatOpts -> IO () +format opts = do + modContent <- Text.readFile (opts ^. moduleFilepath) + modOrErr <- Parsec.runParser Parsec.parseModule (opts ^. moduleFilepath) modContent + case modOrErr of + Left err -> print err + Right m -> do + let formatted = show . pretty $ m + if opts ^. inPlace + then Prelude.writeFile (opts ^. moduleFilepath) formatted + else Prelude.putStrLn formatted diff --git a/lambda-buffers-frontend/app/Main.hs b/lambda-buffers-frontend/app/Main.hs new file mode 100644 index 00000000..aafca163 --- /dev/null +++ b/lambda-buffers-frontend/app/Main.hs @@ -0,0 +1,89 @@ +module Main (main) where + +import Control.Applicative (Alternative (many), (<**>)) + +import LambdaBuffers.Frontend.Cli.Compile (CompileOpts (CompileOpts), compile) +import LambdaBuffers.Frontend.Cli.Format (FormatOpts (FormatOpts), format) +import Options.Applicative ( + Parser, + ParserInfo, + command, + customExecParser, + flag, + fullDesc, + help, + helper, + info, + long, + metavar, + prefs, + progDesc, + short, + showDefault, + showHelpOnEmpty, + showHelpOnError, + strOption, + subparser, + ) + +data Command + = Compile CompileOpts + | Format FormatOpts + +importPathP :: Parser FilePath +importPathP = + strOption + ( long "import-path" + <> short 'i' + <> metavar "FILEPATH" + <> help "Directory to look for LambdaBuffer Module source files (.lbf)" + ) + +compileOptsP :: Parser CompileOpts +compileOptsP = + CompileOpts + <$> many importPathP + <*> strOption + ( long "file" + <> short 'f' + <> metavar "FILEPATH" + <> help "LambdaBuffers file to compile" + ) + +formatOptsP :: Parser FormatOpts +formatOptsP = + FormatOpts + <$> strOption + ( long "file" + <> short 'f' + <> metavar "FILEPATH" + <> help "LambdaBuffers file to format" + ) + <*> flag + False + True + ( long "inplace" + <> short 'i' + <> help "Replace the file content with the formatted version" + <> showDefault + ) + +optionsP :: Parser Command +optionsP = + subparser $ + command + "compile" + (info (Compile <$> compileOptsP <* helper) (progDesc "Compile a LambdaBuffers Module (.lbf)")) + <> command + "format" + (info (Format <$> formatOptsP <* helper) (progDesc "Format a LambdaBuffers Module (.lbf)")) + +parserInfo :: ParserInfo Command +parserInfo = info (optionsP <**> helper) (fullDesc <> progDesc "LambdaBuffers Frontend command-line interface tool") + +main :: IO () +main = do + cmd <- customExecParser (prefs (showHelpOnEmpty <> showHelpOnError)) parserInfo + case cmd of + Compile opts -> compile opts + Format opts -> format opts diff --git a/lambda-buffers-frontend/build.nix b/lambda-buffers-frontend/build.nix new file mode 100644 index 00000000..683aff0f --- /dev/null +++ b/lambda-buffers-frontend/build.nix @@ -0,0 +1,62 @@ +{ pkgs +, haskell-nix +, mlabs-tooling +, compiler-nix-name +, index-state +, compilerHsPb +, commonTools +, shellHook +}: +let + inherit pkgs; + project = { + src = ./.; + + name = "lambda-buffers-frontend"; + + inherit compiler-nix-name index-state; + + extraHackage = [ + (builtins.toString compilerHsPb) + ]; + + modules = [ + (_: { + packages = { + allComponent.doHoogle = true; + allComponent.doHaddock = true; + + # Enable strict compilation + lambda-buffers-frontend.configureFlags = [ "-f-dev" ]; + }; + }) + ]; + + shell = { + + withHoogle = true; + + exactDeps = true; + + nativeBuildInputs = builtins.attrValues commonTools; + + tools = { + cabal = { }; + haskell-language-server = { }; + }; + + shellHook = '' + export LC_CTYPE=C.UTF-8 + export LC_ALL=C.UTF-8 + export LANG=C.UTF-8 + ${shellHook} + ''; + }; + }; +in +{ + hsNixProj = haskell-nix.cabalProject' [ + mlabs-tooling.lib.mkHackageMod + project + ]; +} diff --git a/lambda-buffers-frontend/cabal.project b/lambda-buffers-frontend/cabal.project new file mode 100644 index 00000000..6b0c1f6a --- /dev/null +++ b/lambda-buffers-frontend/cabal.project @@ -0,0 +1,3 @@ +packages: ./. + +tests: true \ No newline at end of file diff --git a/lambda-buffers-frontend/hie.yaml b/lambda-buffers-frontend/hie.yaml new file mode 100644 index 00000000..04cd2439 --- /dev/null +++ b/lambda-buffers-frontend/hie.yaml @@ -0,0 +1,2 @@ +cradle: + cabal: diff --git a/lambda-buffers-frontend/lambda-buffers-frontend.cabal b/lambda-buffers-frontend/lambda-buffers-frontend.cabal new file mode 100644 index 00000000..ef68678f --- /dev/null +++ b/lambda-buffers-frontend/lambda-buffers-frontend.cabal @@ -0,0 +1,138 @@ +cabal-version: 3.0 +name: lambda-buffers-frontend +version: 0.1.0.0 +synopsis: Lambda Buffers Frontend + +-- license: + +author: MLabs LTD +maintainer: info@mlabs.city + +-- A copyright notice. +-- copyright: +-- category: + +flag dev + description: Enable non-strict compilation for development + manual: True + +common common-language + ghc-options: + -Wall -Wcompat -fprint-explicit-foralls -fprint-explicit-kinds + -fwarn-missing-import-lists -Weverything -Wno-unsafe + -Wno-missing-safe-haskell-mode -Wno-implicit-prelude + -Wno-missing-kind-signatures -Wno-all-missed-specializations + + if !flag(dev) + ghc-options: -Werror + + default-extensions: + NoStarIsType + BangPatterns + BinaryLiterals + ConstrainedClassMethods + ConstraintKinds + DataKinds + DeriveAnyClass + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveLift + DeriveTraversable + DerivingStrategies + DoAndIfThenElse + EmptyCase + EmptyDataDecls + EmptyDataDeriving + ExistentialQuantification + ExplicitForAll + ExplicitNamespaces + FlexibleContexts + FlexibleInstances + ForeignFunctionInterface + GADTSyntax + HexFloatLiterals + ImportQualifiedPost + InstanceSigs + KindSignatures + LambdaCase + MonomorphismRestriction + MultiParamTypeClasses + NamedFieldPuns + NamedWildCards + NumericUnderscores + OverloadedStrings + PartialTypeSignatures + PatternGuards + PolyKinds + PostfixOperators + RankNTypes + RelaxedPolyRec + ScopedTypeVariables + StandaloneDeriving + StandaloneKindSignatures + TemplateHaskell + TraditionalRecordSyntax + TupleSections + TypeApplications + TypeFamilies + TypeOperators + TypeSynonymInstances + ViewPatterns + + default-language: Haskell2010 + +library + import: common-language + build-depends: + , base >=4.16 + , containers >=0.6 + , directory >=1.3 + , filepath >=1.4 + , mtl >=2.2 + , parsec >=3.1 + , prettyprinter >=1.7 + , text >=1.2 + , transformers >=0.5 + + hs-source-dirs: src + exposed-modules: + LambdaBuffers.Frontend + LambdaBuffers.Frontend.Parsec + LambdaBuffers.Frontend.PPrint + LambdaBuffers.Frontend.Syntax + +executable lambda-buffers-frontend-cli + import: common-language + build-depends: + , base >=4.16 + , containers >=0.6 + , lambda-buffers-compiler-pb >=0.1 + , lambda-buffers-frontend + , lens >=5.2 + , optparse-applicative >=0.17 + , prettyprinter >=1.7 + , text >=1.2 + + hs-source-dirs: app + main-is: Main.hs + other-modules: + LambdaBuffers.Frontend.Cli.Compile + LambdaBuffers.Frontend.Cli.Format + +test-suite tests + import: common-language + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Test.hs + build-depends: + , base >=4.16 + , containers >=0.6 + , filepath >=1.4 + , lambda-buffers-frontend + , prettyprinter >=1.7 + , tasty >=1.4 + , tasty-hunit >=0.10 + + other-modules: Test.LambdaBuffers.Frontend diff --git a/lambda-buffers-frontend/resources/duplicate_tydef/A.lbf b/lambda-buffers-frontend/resources/duplicate_tydef/A.lbf new file mode 100644 index 00000000..418a8781 --- /dev/null +++ b/lambda-buffers-frontend/resources/duplicate_tydef/A.lbf @@ -0,0 +1,5 @@ +module A + +sum A = MkA + +sum A = MkA \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/formatting/A.lbf b/lambda-buffers-frontend/resources/formatting/A.lbf new file mode 100644 index 00000000..b8b43c4f --- /dev/null +++ b/lambda-buffers-frontend/resources/formatting/A.lbf @@ -0,0 +1,7 @@ +module A + +sum X = MkX + +sum Y = MkY + +sum Z = MkZ \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/formatting/BadFormat.lbf b/lambda-buffers-frontend/resources/formatting/BadFormat.lbf new file mode 100644 index 00000000..9b36c2ce --- /dev/null +++ b/lambda-buffers-frontend/resources/formatting/BadFormat.lbf @@ -0,0 +1,52 @@ +module BadFormat + +import + qualified + A + as + B + ( + X, + Y, Z + ) + + +sum + Maybe + a + = + Just + a + | + Nothing + +sum + Either + a b = + Left + a + | + Right + b + +sum List a = + Nil + | + List + a ( + List + a + ) + +opaque + Int + a +opaque + Bytes + +sum Foo a = MkFoo + B.X + B.Y + ((B.Z ) + ((B.X) a) ((a)) ) + | A a a a a a | B | C | D | E | A | B | C | D | E \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/formatting/good/A.lbf b/lambda-buffers-frontend/resources/formatting/good/A.lbf new file mode 100644 index 00000000..b8b43c4f --- /dev/null +++ b/lambda-buffers-frontend/resources/formatting/good/A.lbf @@ -0,0 +1,7 @@ +module A + +sum X = MkX + +sum Y = MkY + +sum Z = MkZ \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/formatting/good/BadFormat.lbf b/lambda-buffers-frontend/resources/formatting/good/BadFormat.lbf new file mode 100644 index 00000000..38431e66 --- /dev/null +++ b/lambda-buffers-frontend/resources/formatting/good/BadFormat.lbf @@ -0,0 +1,25 @@ +module BadFormat + +import qualified A as B (X,Y,Z) + +sum Maybe a = Just a | Nothing + +sum Either a b = Left a | Right b + +sum List a = Nil | List a (List a) + +opaque Int a + +opaque Bytes + +sum Foo a = MkFoo B.X B.Y (B.Z (B.X a) a) + | A a a a a a + | B + | C + | D + | E + | A + | B + | C + | D + | E diff --git a/lambda-buffers-frontend/resources/good/A.lbf b/lambda-buffers-frontend/resources/good/A.lbf new file mode 100644 index 00000000..baa37a63 --- /dev/null +++ b/lambda-buffers-frontend/resources/good/A.lbf @@ -0,0 +1,3 @@ +module A + +sum A = MkA \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/good/A/B.lbf b/lambda-buffers-frontend/resources/good/A/B.lbf new file mode 100644 index 00000000..7eb9f760 --- /dev/null +++ b/lambda-buffers-frontend/resources/good/A/B.lbf @@ -0,0 +1,3 @@ +module A.B + +sum A = MkA \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/good/B.lbf b/lambda-buffers-frontend/resources/good/B.lbf new file mode 100644 index 00000000..6b1910db --- /dev/null +++ b/lambda-buffers-frontend/resources/good/B.lbf @@ -0,0 +1,3 @@ +module B + +sum A = MkA \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/good/C.lbf b/lambda-buffers-frontend/resources/good/C.lbf new file mode 100644 index 00000000..f4ce50aa --- /dev/null +++ b/lambda-buffers-frontend/resources/good/C.lbf @@ -0,0 +1,3 @@ +module C + +sum A = MkA \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/good/Test.lbf b/lambda-buffers-frontend/resources/good/Test.lbf new file mode 100644 index 00000000..22ed22fd --- /dev/null +++ b/lambda-buffers-frontend/resources/good/Test.lbf @@ -0,0 +1,30 @@ +module Test + +import A + +import qualified B + +import qualified A.B +import qualified A.B as AB + +import qualified C (A) +import qualified C as D (A) +import qualified C as D () + +sum Maybe a = Just a | Nothing + +sum Either a b = Left a | Right b + +sum List a = Nil | List a (List a) + +opaque Int a +opaque Bytes + +sum Foo a = MkFoo + A + A.A + B.A + A.B.A + AB.A + C.A + D.A diff --git a/lambda-buffers-frontend/resources/import_cycle_found/A.lbf b/lambda-buffers-frontend/resources/import_cycle_found/A.lbf new file mode 100644 index 00000000..b3c4f193 --- /dev/null +++ b/lambda-buffers-frontend/resources/import_cycle_found/A.lbf @@ -0,0 +1,3 @@ +module A + +import B \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/import_cycle_found/B.lbf b/lambda-buffers-frontend/resources/import_cycle_found/B.lbf new file mode 100644 index 00000000..8933d45d --- /dev/null +++ b/lambda-buffers-frontend/resources/import_cycle_found/B.lbf @@ -0,0 +1,3 @@ +module B + +import C \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/import_cycle_found/C.lbf b/lambda-buffers-frontend/resources/import_cycle_found/C.lbf new file mode 100644 index 00000000..85d6c9a5 --- /dev/null +++ b/lambda-buffers-frontend/resources/import_cycle_found/C.lbf @@ -0,0 +1,3 @@ +module C + +import A \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/imported_not_found/A.lbf b/lambda-buffers-frontend/resources/imported_not_found/A.lbf new file mode 100644 index 00000000..04d8374b --- /dev/null +++ b/lambda-buffers-frontend/resources/imported_not_found/A.lbf @@ -0,0 +1,3 @@ +module A + +import B (A, B, C) \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/imported_not_found/B.lbf b/lambda-buffers-frontend/resources/imported_not_found/B.lbf new file mode 100644 index 00000000..b295be28 --- /dev/null +++ b/lambda-buffers-frontend/resources/imported_not_found/B.lbf @@ -0,0 +1,4 @@ +module B + +sum A = MkA +sum B = MkB \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/invalid_module_filepath/A.lbf b/lambda-buffers-frontend/resources/invalid_module_filepath/A.lbf new file mode 100644 index 00000000..1bf3e1b7 --- /dev/null +++ b/lambda-buffers-frontend/resources/invalid_module_filepath/A.lbf @@ -0,0 +1,2 @@ +module A.B.C + diff --git a/lambda-buffers-frontend/resources/module_not_found/A.lbf b/lambda-buffers-frontend/resources/module_not_found/A.lbf new file mode 100644 index 00000000..b3c4f193 --- /dev/null +++ b/lambda-buffers-frontend/resources/module_not_found/A.lbf @@ -0,0 +1,3 @@ +module A + +import B \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/module_parse_error/A.lbf b/lambda-buffers-frontend/resources/module_parse_error/A.lbf new file mode 100644 index 00000000..e9c1ec72 --- /dev/null +++ b/lambda-buffers-frontend/resources/module_parse_error/A.lbf @@ -0,0 +1,3 @@ +module A + +thisshouldnotwork \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/multiple_modules_found/A.lbf b/lambda-buffers-frontend/resources/multiple_modules_found/A.lbf new file mode 100644 index 00000000..b3c4f193 --- /dev/null +++ b/lambda-buffers-frontend/resources/multiple_modules_found/A.lbf @@ -0,0 +1,3 @@ +module A + +import B \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/multiple_modules_found/B.lbf b/lambda-buffers-frontend/resources/multiple_modules_found/B.lbf new file mode 100644 index 00000000..397c9758 --- /dev/null +++ b/lambda-buffers-frontend/resources/multiple_modules_found/B.lbf @@ -0,0 +1 @@ +module B \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/multiple_modules_found/another_import_path/B.lbf b/lambda-buffers-frontend/resources/multiple_modules_found/another_import_path/B.lbf new file mode 100644 index 00000000..397c9758 --- /dev/null +++ b/lambda-buffers-frontend/resources/multiple_modules_found/another_import_path/B.lbf @@ -0,0 +1 @@ +module B \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/run.sh b/lambda-buffers-frontend/resources/run.sh new file mode 100755 index 00000000..3d6c38af --- /dev/null +++ b/lambda-buffers-frontend/resources/run.sh @@ -0,0 +1,16 @@ +function lbcli { + cabal run lambda-buffers-frontend-cli -- $@ +} + +lbcli compile -i duplicate_tydef -f duplicate_tydef/A.lbf +lbcli compile -i import_cycle_found -f import_cycle_found/A.lbf +lbcli compile -i imported_not_found -f imported_not_found/A.lbf +lbcli compile -i invalid_module_filepath -f invalid_module_filepath/A.lbf +lbcli compile -i module_not_found -f module_not_found/A.lbf +lbcli compile -i module_parse_error -f module_parse_error/A.lbf +lbcli compile -i multiple_modules_found -i multiple_modules_found/another_import_path -f multiple_modules_found/A.lbf +lbcli compile -i symbol_already_imported -f symbol_already_imported/A.lbf +lbcli compile -i tydef_name_conflict -f tydef_name_conflict/A.lbf +lbcli compile -i tyref_not_found -f tyref_not_found/A.lbf + +lbcli compile -i good -f good/Test.lbf diff --git a/lambda-buffers-frontend/resources/symbol_already_imported/A.lbf b/lambda-buffers-frontend/resources/symbol_already_imported/A.lbf new file mode 100644 index 00000000..64c1a944 --- /dev/null +++ b/lambda-buffers-frontend/resources/symbol_already_imported/A.lbf @@ -0,0 +1,4 @@ +module A + +import B +import C diff --git a/lambda-buffers-frontend/resources/symbol_already_imported/B.lbf b/lambda-buffers-frontend/resources/symbol_already_imported/B.lbf new file mode 100644 index 00000000..6b1910db --- /dev/null +++ b/lambda-buffers-frontend/resources/symbol_already_imported/B.lbf @@ -0,0 +1,3 @@ +module B + +sum A = MkA \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/symbol_already_imported/C.lbf b/lambda-buffers-frontend/resources/symbol_already_imported/C.lbf new file mode 100644 index 00000000..f4ce50aa --- /dev/null +++ b/lambda-buffers-frontend/resources/symbol_already_imported/C.lbf @@ -0,0 +1,3 @@ +module C + +sum A = MkA \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/tydef_name_conflict/A.lbf b/lambda-buffers-frontend/resources/tydef_name_conflict/A.lbf new file mode 100644 index 00000000..39ebb7d6 --- /dev/null +++ b/lambda-buffers-frontend/resources/tydef_name_conflict/A.lbf @@ -0,0 +1,5 @@ +module A + +import B + +sum A = MkA \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/tydef_name_conflict/B.lbf b/lambda-buffers-frontend/resources/tydef_name_conflict/B.lbf new file mode 100644 index 00000000..6b1910db --- /dev/null +++ b/lambda-buffers-frontend/resources/tydef_name_conflict/B.lbf @@ -0,0 +1,3 @@ +module B + +sum A = MkA \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/tyref_not_found/A.lbf b/lambda-buffers-frontend/resources/tyref_not_found/A.lbf new file mode 100644 index 00000000..c41dbc41 --- /dev/null +++ b/lambda-buffers-frontend/resources/tyref_not_found/A.lbf @@ -0,0 +1,6 @@ +module A + +import B +import C + +sum A = MkA WhereIsThisType \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/tyref_not_found/B.lbf b/lambda-buffers-frontend/resources/tyref_not_found/B.lbf new file mode 100644 index 00000000..3904163f --- /dev/null +++ b/lambda-buffers-frontend/resources/tyref_not_found/B.lbf @@ -0,0 +1,3 @@ +module B + +sum B = MkB \ No newline at end of file diff --git a/lambda-buffers-frontend/resources/tyref_not_found/C.lbf b/lambda-buffers-frontend/resources/tyref_not_found/C.lbf new file mode 100644 index 00000000..03b57c0a --- /dev/null +++ b/lambda-buffers-frontend/resources/tyref_not_found/C.lbf @@ -0,0 +1,3 @@ +module C + +sum C = MkC \ No newline at end of file diff --git a/lambda-buffers-frontend/src/LambdaBuffers/Frontend.hs b/lambda-buffers-frontend/src/LambdaBuffers/Frontend.hs new file mode 100644 index 00000000..8883ab38 --- /dev/null +++ b/lambda-buffers-frontend/src/LambdaBuffers/Frontend.hs @@ -0,0 +1,239 @@ +module LambdaBuffers.Frontend (runFrontend, FrontendError (..), parseModule) where + +import Control.Monad (foldM, void, when) +import Control.Monad.Except (ExceptT, runExceptT) +import Control.Monad.State.Strict (MonadIO (liftIO), MonadTrans (lift), StateT (runStateT), gets, modify) +import Control.Monad.Trans.Except (throwE) +import Control.Monad.Trans.Reader (ReaderT (runReaderT), asks, local) +import Data.Foldable (for_) +import Data.List (isSuffixOf) +import Data.Map (Map) +import Data.Map qualified as Map +import Data.Maybe (fromMaybe) +import Data.Set (Set) +import Data.Set qualified as Set +import Data.Text (Text, unpack) +import Data.Text.IO qualified as Text +import Data.Traversable (for) +import LambdaBuffers.Frontend.PPrint () +import LambdaBuffers.Frontend.Parsec qualified as Parsec +import LambdaBuffers.Frontend.Syntax (Constructor (Constructor), Import (Import, importInfo, importModuleName), Module (moduleImports, moduleName, moduleTyDefs), ModuleAlias (ModuleAlias), ModuleName (ModuleName), ModuleNamePart (ModuleNamePart), Product (Product), SourceInfo, Ty (TyApp, TyRef', TyVar), TyBody (Opaque, Sum), TyDef (TyDef, tyBody, tyDefInfo, tyName), TyName (TyName), TyRef (TyRef)) +import Prettyprinter (Doc, LayoutOptions (layoutPageWidth), PageWidth (Unbounded), Pretty (pretty), defaultLayoutOptions, layoutPretty, (<+>)) +import Prettyprinter.Render.String (renderShowS) +import System.Directory (findFiles) +import System.FilePath (joinPath, (<.>)) +import Text.Parsec (ParseError) + +data FrontRead = FrontRead + { current :: ModuleName SourceInfo + , visited :: [ModuleName ()] + , importPaths :: [FilePath] + } + deriving stock (Eq, Show) + +newtype FrontState = FrontState + { importedModules :: Map (ModuleName ()) (Module SourceInfo) + } + deriving stock (Eq, Show) + +type Symbol = TyRef () +type Scope = Map Symbol (ModuleName SourceInfo) + +data FrontendError + = ModuleNotFound (ModuleName SourceInfo) (Import SourceInfo) [FilePath] + | MultipleModulesFound (ModuleName SourceInfo) (Import SourceInfo) [FilePath] + | ImportCycleFound (ModuleName SourceInfo) (Import SourceInfo) [ModuleName ()] + | ModuleParseError FilePath ParseError + | ImportedNotFound (ModuleName SourceInfo) (ModuleName SourceInfo) (TyName SourceInfo) (Set (TyName SourceInfo)) + | InvalidModuleFilepath (ModuleName SourceInfo) FilePath FilePath + | SymbolAlreadyImported (ModuleName SourceInfo) (Import SourceInfo) Symbol (ModuleName SourceInfo) + | TyRefNotFound (ModuleName SourceInfo) (TyRef SourceInfo) Scope + | DuplicateTyDef (ModuleName SourceInfo) (TyDef SourceInfo) + | TyDefNameConflict (ModuleName SourceInfo) (TyDef SourceInfo) (ModuleName SourceInfo) + deriving stock (Eq) + +showOneLine :: Doc a -> String +showOneLine d = (renderShowS . layoutPretty (defaultLayoutOptions {layoutPageWidth = Unbounded}) $ d) "" + +instance Show FrontendError where + show (ModuleNotFound _cm imp impPaths) = showOneLine $ pretty (importInfo imp) <+> "Module" <+> pretty (importModuleName imp) <+> "not found in available import paths" <+> pretty impPaths + show (MultipleModulesFound _cm imp conflictingPaths) = showOneLine $ pretty (importInfo imp) <+> "Module" <+> pretty (importModuleName imp) <+> "found in multiple files" <+> pretty conflictingPaths + show (ImportCycleFound _cm imp visited) = showOneLine $ pretty (importInfo imp) <+> "Tried to load module" <+> pretty (importModuleName imp) <+> "which constitutes a cycle" <+> pretty visited + show (ModuleParseError _fp err) = showOneLine $ pretty err + show (ImportedNotFound _cm mn tn@(TyName _ info) available) = showOneLine $ pretty info <+> "Type" <+> pretty tn <+> "not found in module" <+> pretty mn <> ", did you mean one of" <+> pretty (Set.toList available) + show (InvalidModuleFilepath mn@(ModuleName _ info) gotModFp wantedFpSuffix) = showOneLine $ pretty info <+> "File name" <+> pretty gotModFp <+> "doesn't match module name" <+> pretty mn <+> "expected" <+> pretty wantedFpSuffix + show (SymbolAlreadyImported _cm imp sym alreadyInModuleName) = showOneLine $ pretty (importInfo imp) <+> "Symbol" <+> pretty sym <+> "already imported from module" <+> pretty alreadyInModuleName + show (TyRefNotFound _cm tyR@(TyRef _ _ info) scope) = showOneLine $ pretty info <+> "Type " <> pretty tyR <+> "not found in the module's scope" <+> (pretty . Map.keys $ scope) + show (DuplicateTyDef _cm tyDef) = showOneLine $ pretty (tyDefInfo tyDef) <+> "Duplicate type definition with the name" <+> pretty (tyName tyDef) + show (TyDefNameConflict _cm tyDef imn) = showOneLine $ pretty (tyDefInfo tyDef) <+> "Type name" <+> pretty (tyName tyDef) <+> "conflicts with an imported type name from module" <+> pretty imn + +type FrontendT m a = MonadIO m => ReaderT FrontRead (StateT FrontState (ExceptT FrontendError m)) a + +-- | Run a Frontend compilation action on a "lbf" file, return the entire compilation closure or a frontend error. +runFrontend :: MonadIO m => [FilePath] -> FilePath -> m (Either FrontendError (Map (ModuleName ()) (Module SourceInfo))) +runFrontend importPaths modFp = do + let stM = runReaderT (processFile modFp) (FrontRead (ModuleName [] undefined) [] importPaths) + exM = runStateT stM (FrontState mempty) + ioM = runExceptT exM + fmap (importedModules . snd) <$> ioM + +throwE' :: FrontendError -> FrontendT m a +throwE' = lift . lift . throwE + +moduleNameToFilepath :: ModuleName info -> FilePath +moduleNameToFilepath (ModuleName parts _) = joinPath [unpack p | ModuleNamePart p _ <- parts] <.> "lbf" + +checkCycle :: Import SourceInfo -> FrontendT m () +checkCycle imp = do + ms <- asks visited + cm <- asks current + when ((strip . importModuleName $ imp) `elem` ms) $ throwE' $ ImportCycleFound cm imp ms + +-- | Parse a LambdaBuffers modules with a specified filename (for reporting) and content. +parseModule :: FilePath -> Text -> FrontendT m (Module SourceInfo) +parseModule modFp modContent = do + modOrErr <- liftIO $ Parsec.runParser Parsec.parseModule modFp modContent + case modOrErr of + Left err -> throwE' $ ModuleParseError modFp err + Right m -> return m + +strip :: Functor f => f a -> f () +strip = void + +importModule :: Import SourceInfo -> FrontendT m (Module SourceInfo) +importModule imp = do + let modName = importModuleName imp + ims <- gets importedModules + case Map.lookup (strip modName) ims of + Nothing -> do + ips <- asks importPaths + found <- liftIO $ findFiles ips (moduleNameToFilepath modName) + case found of + [] -> do + cm <- asks current + throwE' $ ModuleNotFound cm imp ips + [modFp] -> do + modContent <- liftIO $ Text.readFile modFp + modOrErr <- liftIO $ Parsec.runParser Parsec.parseModule modFp modContent + case modOrErr of + Left err -> throwE' $ ModuleParseError modFp err + Right m -> return m + modFps -> do + cm <- asks current + throwE' $ MultipleModulesFound cm imp modFps + Just m -> return m + +processFile :: FilePath -> FrontendT m (Module SourceInfo) +processFile modFp = do + modContent <- liftIO $ Text.readFile modFp + m <- parseModule modFp modContent + checkModuleName modFp (moduleName m) + processModule m + +processModule :: Module SourceInfo -> FrontendT m (Module SourceInfo) +processModule m = local + ( \ir -> + ir + { current = moduleName m + , visited = (strip . current $ ir) : visited ir + } + ) + $ do + importedScope <- processImports m + localScope <- collectLocalScope m importedScope + checkReferences (localScope <> importedScope) m + _ <- lift $ modify (FrontState . Map.insert (strip . moduleName $ m) m . importedModules) + return m + +checkReferences :: Scope -> Module SourceInfo -> FrontendT m () +checkReferences scope m = for_ (moduleTyDefs m) (checkBody . tyBody) + where + checkBody (Sum cs _) = for_ cs checkConstructor + checkBody Opaque = return () + + checkConstructor (Constructor _ (Product tys _) _) = for tys checkTy + + checkTy (TyApp tyF tyAs _) = checkTy tyF >> for_ tyAs checkTy + checkTy (TyVar _ _) = return () + checkTy (TyRef' tyR _) = + if Map.member (strip tyR) scope + then return () + else do + cm <- asks current + throwE' $ TyRefNotFound cm tyR scope + +checkModuleName :: FilePath -> ModuleName SourceInfo -> FrontendT m () +checkModuleName fp mn = + let suffix = moduleNameToFilepath mn + in if suffix `isSuffixOf` fp + then return () + else throwE' $ InvalidModuleFilepath mn fp suffix + +processImports :: Module SourceInfo -> FrontendT m Scope +processImports m = + foldM + ( \totalScope imp -> do + scope <- processImport imp + foldM + ( \totalScope' sym -> case Map.lookup sym totalScope' of + Nothing -> return $ Map.insert sym (importModuleName imp) totalScope' + Just mn -> do + cm <- asks current + throwE' $ SymbolAlreadyImported cm imp sym mn + ) + totalScope + scope + ) + mempty + (moduleImports m) + +processImport :: Import SourceInfo -> FrontendT m (Set Symbol) +processImport imp = do + checkCycle imp + im <- importModule imp >>= processModule + collectImportedScope imp im + +collectImportedScope :: Import SourceInfo -> Module SourceInfo -> FrontendT m (Set Symbol) +collectImportedScope (Import isQual modName mayImports mayAlias _) m = + let availableTyNs = [tyN | (TyDef tyN _ _ _) <- moduleTyDefs m] + availableTyNs' = Set.fromList availableTyNs + importedTyNs = fromMaybe availableTyNs mayImports + availableSTyNs = Set.fromList $ strip <$> availableTyNs + in foldM + ( \total tyN -> + let styN = strip tyN + in if Set.member styN availableSTyNs + then return . Set.union total . Set.fromList $ + case mayAlias of + Nothing -> + if isQual + then [TyRef (Just $ ModuleAlias (strip modName) ()) styN ()] + else [TyRef (Just $ ModuleAlias (strip modName) ()) styN (), TyRef Nothing styN ()] + Just al -> + if isQual + then [TyRef (Just . strip $ al) styN ()] + else [TyRef (Just . strip $ al) styN (), TyRef Nothing styN ()] + else do + cm <- asks current + throwE' $ ImportedNotFound cm modName tyN availableTyNs' + ) + Set.empty + importedTyNs + +collectLocalScope :: Module SourceInfo -> Scope -> FrontendT m Scope +collectLocalScope m importedScope = + foldM + ( \totalScope tyDef@(TyDef tn _ _ _) -> do + let tyR = TyRef Nothing (strip tn) () + case Map.lookup tyR totalScope of + Nothing -> case Map.lookup tyR importedScope of + Nothing -> return $ Map.insert tyR (moduleName m) totalScope + Just im -> do + cm <- asks current + throwE' $ TyDefNameConflict cm tyDef im + Just _ -> do + cm <- asks current + throwE' $ DuplicateTyDef cm tyDef + ) + mempty + (moduleTyDefs m) diff --git a/lambda-buffers-frontend/src/LambdaBuffers/Frontend/PPrint.hs b/lambda-buffers-frontend/src/LambdaBuffers/Frontend/PPrint.hs new file mode 100644 index 00000000..ee6af421 --- /dev/null +++ b/lambda-buffers-frontend/src/LambdaBuffers/Frontend/PPrint.hs @@ -0,0 +1,107 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +{- | +Module : LambdaBuffers.Frontend.PPrint +Description : Pretty printing implementation of the LambdaBuffers.Frontend.Syntax types used for formatting +-} +module LambdaBuffers.Frontend.PPrint () where + +import Data.List (sort) +import Data.Text qualified as Text +import LambdaBuffers.Frontend.Syntax (ClassName (ClassName), ConstrName (ConstrName), Constructor (Constructor), FieldName (FieldName), Import (Import), Module (Module), ModuleAlias (ModuleAlias), ModuleName (ModuleName), ModuleNamePart (ModuleNamePart), Product (Product), SourceInfo (SourceInfo), SourcePos (SourcePos), Ty (TyApp, TyRef', TyVar), TyArg (TyArg), TyBody (Opaque, Sum), TyDef (TyDef), TyName (TyName), TyRef (TyRef), VarName (VarName)) +import Prettyprinter (Doc, Pretty (pretty), align, comma, concatWith, encloseSep, equals, group, hsep, line, lparen, pipe, rparen, space, (<+>)) +import Text.Parsec qualified as Parsec +import Text.Parsec.Error qualified as Parsec + +intercalate :: Doc a -> [Doc a] -> Doc a +intercalate sep = concatWith (\l r -> l <> sep <> r) + +instance (Ord info, Pretty info) => Pretty (Module info) where + pretty (Module mn imports tyDs _info) = + let sortedImports = sort imports + in "module" + <+> pretty mn + <> ( if null sortedImports + then "" + else + line + <> line + <> intercalate line (pretty <$> sortedImports) + ) + <> ( if null tyDs + then "" + else + line + <> line + <> intercalate (line <> line) (pretty <$> tyDs) + ) + +instance Pretty info => Pretty (Import info) where + pretty (Import isQ imn maySyms mayAl _info) = + "import" + <> (if isQ then space <> "qualified" else "") + <+> pretty imn + <> case mayAl of + Nothing -> "" + Just al -> space <> "as" <+> pretty al + <> case maySyms of + Nothing -> "" + Just syms -> space <> encloseSep lparen rparen comma (pretty <$> syms) + +instance Pretty info => Pretty (TyDef info) where + pretty (TyDef tn args body@(Sum _ _) _info) = group $ "sum" <+> pretty tn <+> hsep (pretty <$> args) <+> equals <+> pretty body + pretty (TyDef tn args Opaque _info) = "opaque" <+> pretty tn <> if null args then "" else space <> hsep (pretty <$> args) + +instance Pretty info => Pretty (TyBody info) where + pretty (Sum cs _info) = if null cs then "" else align $ encloseSep "" "" (space <> pipe <> space) (pretty <$> cs) + pretty Opaque = "" + +instance Pretty info => Pretty (TyArg info) where + pretty (TyArg a _info) = pretty a + +instance Pretty info => Pretty (ModuleName info) where + pretty (ModuleName ps _info) = pretty $ Text.intercalate "." [p | ModuleNamePart p _ <- ps] + +instance Pretty info => Pretty (TyName info) where + pretty (TyName t _info) = pretty t + +instance Pretty info => Pretty (VarName info) where + pretty (VarName t _info) = pretty t + +instance Pretty info => Pretty (ConstrName info) where + pretty (ConstrName t _info) = pretty t + +instance Pretty info => Pretty (ClassName info) where + pretty (ClassName t _info) = pretty t + +instance Pretty info => Pretty (FieldName info) where + pretty (FieldName t _info) = pretty t + +instance Pretty info => Pretty (ModuleAlias info) where + pretty (ModuleAlias mn _info) = pretty mn + +instance Pretty info => Pretty (TyRef info) where + pretty (TyRef mayModAl tn _info) = maybe "" (\al -> pretty al <> ".") mayModAl <> pretty tn + +instance Pretty info => Pretty (Ty info) where + pretty (TyVar vn _info) = pretty vn + pretty (TyRef' tr _info) = pretty tr + pretty (TyApp tyF tyAs _info) = group $ encloseSep lparen rparen space (pretty <$> tyF : tyAs) + +instance Pretty info => Pretty (Constructor info) where + pretty (Constructor cn p _info) = align $ group (pretty cn <> pretty p) + +instance Pretty info => Pretty (Product info) where + pretty (Product tys _info) = group $ if null tys then "" else space <> hsep (pretty <$> tys) + +instance Pretty SourceInfo where + pretty (SourceInfo fn pos pos') = pretty fn <> ":" <> "(" <> pretty pos <> ")-(" <> pretty pos' <> ")" + +instance Pretty SourcePos where + pretty (SourcePos r c) = pretty r <> ":" <> pretty c + +instance Pretty Parsec.ParseError where + pretty pe = pretty (Parsec.errorPos pe) <> ":" <> pretty (Parsec.showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" $ Parsec.errorMessages pe) + +instance Pretty Parsec.SourcePos where + pretty sp = pretty (Parsec.sourceName sp) <> ":" <> "(" <> pretty (Parsec.sourceLine sp) <> ":" <> pretty (Parsec.sourceColumn sp) <> ")" diff --git a/lambda-buffers-frontend/src/LambdaBuffers/Frontend/Parsec.hs b/lambda-buffers-frontend/src/LambdaBuffers/Frontend/Parsec.hs new file mode 100644 index 00000000..f24d3e7a --- /dev/null +++ b/lambda-buffers-frontend/src/LambdaBuffers/Frontend/Parsec.hs @@ -0,0 +1,195 @@ +module LambdaBuffers.Frontend.Parsec (parseModule, parseImport, runParser) where + +import Control.Applicative (Alternative ((<|>))) +import Control.Monad (MonadPlus (mzero), void) +import Data.Kind (Type) +import Data.Maybe (isJust) +import Data.String (IsString (fromString)) +import Data.Text (Text) +import LambdaBuffers.Frontend.Syntax (ConstrName (ConstrName), Constructor (Constructor), Import (Import), Module (Module), ModuleAlias (ModuleAlias), ModuleName (ModuleName), ModuleNamePart (ModuleNamePart), Product (Product), SourceInfo (SourceInfo), SourcePos (SourcePos), Ty (TyApp, TyRef', TyVar), TyArg (TyArg), TyBody (Opaque, Sum), TyDef (TyDef), TyName (TyName), TyRef (TyRef), VarName (VarName)) +import Text.Parsec (ParseError, ParsecT, SourceName, Stream, alphaNum, char, endOfLine, eof, getPosition, label, lower, many, many1, optionMaybe, optional, runParserT, sepBy, sepEndBy, sourceColumn, sourceLine, sourceName, space, string, try) +import Text.Parsec.Char (upper) + +type Parser :: Type -> (Type -> Type) -> Type -> Type +type Parser s m a = ParsecT s () m a + +runParser :: (Stream s IO Char) => Parser s IO a -> SourceName -> s -> IO (Either ParseError a) +runParser p = runParserT (p <* eof) () + +parseUpperCamelCase :: Stream s m Char => Parser s m Text +parseUpperCamelCase = label' "UpperCamelCase" $ fromString <$> ((:) <$> upper <*> many alphaNum) + +parseModuleNamePart :: Stream s m Char => Parser s m (ModuleNamePart SourceInfo) +parseModuleNamePart = withSourceInfo . label' "module part name" $ ModuleNamePart <$> parseUpperCamelCase + +parseModuleName :: Stream s m Char => Parser s m (ModuleName SourceInfo) +parseModuleName = withSourceInfo . label' "module name" $ ModuleName <$> sepBy (try parseModuleNamePart) (try $ char '.') + +parseTyVarName :: Stream s m Char => Parser s m (VarName SourceInfo) +parseTyVarName = withSourceInfo . label' "type variable name" $ VarName . fromString <$> many1 lower + +parseTyName :: Stream s m Char => Parser s m (TyName SourceInfo) +parseTyName = withSourceInfo . label' "type name" $ TyName <$> parseUpperCamelCase + +parseModuleAliasInRef :: Stream s m Char => Parser s m (ModuleAlias SourceInfo) +parseModuleAliasInRef = + withSourceInfo . label' "module alias in type reference" $ + ModuleAlias <$> do + ps <- many1 (try (parseModuleNamePart <* char '.')) + withSourceInfo . return $ ModuleName ps + +parseModuleAliasInImport :: Stream s m Char => Parser s m (ModuleAlias SourceInfo) +parseModuleAliasInImport = withSourceInfo . label' "module alias in module import" $ ModuleAlias <$> parseModuleName + +parseTyRef' :: Stream s m Char => Parser s m (TyRef SourceInfo) +parseTyRef' = withSourceInfo . label' "type reference" $ do + mayAlias <- optionMaybe parseModuleAliasInRef + TyRef mayAlias <$> parseTyName + +parseTyVar :: Stream s m Char => Parser s m (Ty SourceInfo) +parseTyVar = withSourceInfo . label' "type variable" $ TyVar <$> parseTyVarName + +parseTyRef :: Stream s m Char => Parser s m (Ty SourceInfo) +parseTyRef = withSourceInfo . label' "type reference" $ TyRef' <$> parseTyRef' + +parseTys :: Stream s m Char => Parser s m [Ty SourceInfo] +parseTys = label' "type list" $ sepEndBy parseTy' parseLineSpaces1 + +parseTy' :: Stream s m Char => Parser s m (Ty SourceInfo) +parseTy' = + label' "type expression" $ + parseTyRef + <|> parseTyVar + <|> ( (char '(' >> parseLineSpaces) + *> (try parseTys >>= tysToTy) + <* (parseLineSpaces >> char ')') + ) + +tysToTy :: Stream s m Char => [Ty SourceInfo] -> Parser s m (Ty SourceInfo) +tysToTy tys = withSourceInfo $ case tys of + [] -> mzero + [ty] -> return $ const ty + f : as -> return $ TyApp f as + +parseSumBody :: Stream s m Char => Parser s m (TyBody SourceInfo) +parseSumBody = withSourceInfo . label' "sum type body" $ do + cs <- + sepBy + parseSumConstructor + (char '|' >> parseLineSpaces1) + return $ Sum cs + +parseSumConstructor :: Stream s m Char => Parser s m (Constructor SourceInfo) +parseSumConstructor = withSourceInfo . label' "sum type constructor" $ Constructor <$> parseConstructorName <*> parseProduct + +parseProduct :: Stream s m Char => Parser s m (Product SourceInfo) +parseProduct = do + maySpace <- optionMaybe parseLineSpace + case maySpace of + Nothing -> withSourceInfo . label' "empty constructor" $ do + return $ Product [] + Just _ -> withSourceInfo . label' "type product" $ do + _ <- parseLineSpaces + Product <$> parseTys + +parseConstructorName :: Stream s m Char => Parser s m (ConstrName SourceInfo) +parseConstructorName = withSourceInfo . label' "sum constructor name" $ ConstrName <$> parseUpperCamelCase + +parseTyDef :: Stream s m Char => Parser s m (TyDef SourceInfo) +parseTyDef = label' "type definition" $ parseSumTyDef <|> parseOpaqueTyDef + +parseSumTyDef :: Stream s m Char => Parser s m (TyDef SourceInfo) +parseSumTyDef = withSourceInfo . label' "sum type definition" $ do + _ <- string "sum" + _ <- parseLineSpaces1 + tyN <- parseTyName + _ <- parseLineSpaces1 + args <- sepEndBy parseTyArg parseLineSpaces1 + _ <- char '=' + _ <- parseLineSpaces1 + TyDef tyN args <$> parseSumBody + +parseOpaqueTyDef :: Stream s m Char => Parser s m (TyDef SourceInfo) +parseOpaqueTyDef = withSourceInfo . label' "opaque type definition" $ do + _ <- string "opaque" + _ <- parseLineSpaces1 + tyN <- parseTyName + maySpace <- optionMaybe parseLineSpace + args <- case maySpace of + Nothing -> parseLineSpaces >> return [] + Just _ -> do + _ <- parseLineSpaces + sepBy parseTyArg parseLineSpaces1 + return $ TyDef tyN args Opaque + +parseTyArg :: Stream s m Char => Parser s m (TyArg SourceInfo) +parseTyArg = withSourceInfo . label' "type argument" $ do + VarName vn _ <- parseTyVarName + return $ TyArg vn + +parseModule :: Stream s m Char => Parser s m (Module SourceInfo) +parseModule = withSourceInfo . label' "module definition" $ do + _ <- string "module" + _ <- parseLineSpaces1 + modName <- parseModuleName + _ <- parseLineSpaces + _ <- many1 parseNewLine + imports <- sepEndBy parseImport (many1 parseNewLine) + tyDs <- sepEndBy parseTyDef (many1 parseNewLine) + _ <- many space + return $ Module modName imports tyDs + +parseImport :: Stream s m Char => Parser s m (Import SourceInfo) +parseImport = withSourceInfo . label' "import statement" $ do + _ <- string "import" + _ <- parseLineSpaces1 + isQual <- isJust <$> optionMaybe (string "qualified" >> parseLineSpaces1) + modName <- parseModuleName + may <- + optionMaybe + ( do + mayModAlias <- optionMaybe (try $ parseLineSpaces1 >> string "as" >> parseLineSpaces1 *> parseModuleAliasInImport) + mayTyNs <- + optionMaybe + ( try $ do + parseLineSpaces1 >> char '(' >> parseLineSpaces + tyNs <- sepEndBy parseTyName (char ',' >> parseLineSpaces) + _ <- try parseLineSpaces >> char ')' + return tyNs + ) + _ <- try parseLineSpaces + return (mayModAlias, mayTyNs) + ) + case may of + Nothing -> return $ Import isQual modName Nothing Nothing + Just (mayModAlias, mayTyNs) -> return $ Import isQual modName mayTyNs mayModAlias + +parseNewLine :: Stream s m Char => Parser s m () +parseNewLine = label' "lb new line" $ void endOfLine + +parseLineSpace :: Stream s m Char => Parser s m () +parseLineSpace = label' "line space" $ void $ try $ do + optional endOfLine + char ' ' <|> char '\t' + +parseLineSpaces1 :: Stream s m Char => Parser s m () +parseLineSpaces1 = void $ try $ many1 parseLineSpace + +parseLineSpaces :: Stream s m Char => Parser s m () +parseLineSpaces = void $ try $ many parseLineSpace + +getSourcePosition :: Stream s m Char => Parser s m SourcePos +getSourcePosition = do + pos <- getPosition + return $ SourcePos (sourceLine pos) (sourceColumn pos) + +withSourceInfo :: Stream s m Char => Parser s m (SourceInfo -> a) -> Parser s m a +withSourceInfo p = do + pos <- getSourcePosition + x <- p + pos' <- getSourcePosition + filename <- fromString . sourceName <$> getPosition + return $ x $ SourceInfo filename pos pos' + +label' :: String -> Parser s m a -> Parser s m a +label' l m = label m l diff --git a/lambda-buffers-frontend/src/LambdaBuffers/Frontend/Syntax.hs b/lambda-buffers-frontend/src/LambdaBuffers/Frontend/Syntax.hs new file mode 100644 index 00000000..a83bc5c9 --- /dev/null +++ b/lambda-buffers-frontend/src/LambdaBuffers/Frontend/Syntax.hs @@ -0,0 +1,98 @@ +module LambdaBuffers.Frontend.Syntax ( + Module (..), + Import (..), + Ty (..), + TyRef (..), + TyDef (..), + TyBody (..), + Constructor (..), + Product (..), + TyArg (..), + ModuleName (..), + ModuleAlias (..), + ModuleNamePart (..), + TyName (..), + VarName (..), + ConstrName (..), + FieldName (..), + ClassName (..), + SourceInfo (..), + SourcePos (..), +) where + +import Data.Text (Text) + +-- | Syntax DSL +data Module info = Module + { moduleName :: ModuleName info + , moduleImports :: [Import info] + , moduleTyDefs :: [TyDef info] + , moduleInfo :: info + } + deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) + +data Import info = Import + { importQualified :: Bool + , importModuleName :: ModuleName info + , imported :: Maybe [TyName info] + , alias :: Maybe (ModuleAlias info) + , importInfo :: info + } + deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) + +data Ty info + = TyVar (VarName info) info + | TyApp (Ty info) [Ty info] info + | TyRef' (TyRef info) info + deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable) + +data TyDef info = TyDef + { tyName :: TyName info + , tyArgs :: [TyArg info] + , tyBody :: TyBody info + , tyDefInfo :: info + } + deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) + +data TyBody info + = Sum [Constructor info] info + | Opaque + deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable) + +data Constructor info = Constructor (ConstrName info) (Product info) info deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable) + +data Product info = Product [Ty info] info deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable) + +data TyArg info = TyArg Text info deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) + +data ModuleName info = ModuleName [ModuleNamePart info] info deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) + +data ModuleNamePart info = ModuleNamePart Text info deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) + +data ModuleAlias info = ModuleAlias (ModuleName info) info deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) + +data VarName info = VarName Text info deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) + +data TyName info = TyName Text info deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) + +data TyRef info = TyRef (Maybe (ModuleAlias info)) (TyName info) info deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) + +data ConstrName info = ConstrName Text info deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable) + +data FieldName info = FieldName Text info deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable) + +data ClassName info = ClassName Text info deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable) + +-- | Source information +data SourceInfo = SourceInfo + { filename :: Text + , from :: SourcePos + , to :: SourcePos + } + deriving stock (Eq, Ord, Show) + +data SourcePos = SourcePos + { row :: Int + , column :: Int + } + deriving stock (Eq, Ord, Show) diff --git a/lambda-buffers-frontend/test/Test.hs b/lambda-buffers-frontend/test/Test.hs new file mode 100644 index 00000000..39f9bb3c --- /dev/null +++ b/lambda-buffers-frontend/test/Test.hs @@ -0,0 +1,7 @@ +module Main (main) where + +import Test.LambdaBuffers.Frontend (tests) +import Test.Tasty (defaultMain, testGroup) + +main :: IO () +main = defaultMain $ testGroup "Frontend tests" [tests "resources"] diff --git a/lambda-buffers-frontend/test/Test/LambdaBuffers/Frontend.hs b/lambda-buffers-frontend/test/Test/LambdaBuffers/Frontend.hs new file mode 100644 index 00000000..03080510 --- /dev/null +++ b/lambda-buffers-frontend/test/Test/LambdaBuffers/Frontend.hs @@ -0,0 +1,120 @@ +module Test.LambdaBuffers.Frontend (tests) where + +import Test.Tasty (TestTree, testGroup) + +import Data.Map (Map) +import Data.Map qualified as Map +import Data.Set qualified as Set +import LambdaBuffers.Frontend (FrontendError, runFrontend) +import LambdaBuffers.Frontend.Parsec () +import LambdaBuffers.Frontend.Syntax (Module, ModuleName, SourceInfo) +import Prettyprinter (Pretty (pretty)) +import System.FilePath (()) +import Test.Tasty.HUnit (Assertion, assertFailure, testCase, (@?=)) + +tests :: FilePath -> TestTree +tests resourcesFp = + testGroup + "LambdaBuffers.Frontend" + [ frontendErrorTests resourcesFp + , frontendSuccessTests resourcesFp + ] + +-- FIXME(bladyjoker): Seems like all the SourceInfo positions are off by one. +frontendErrorTests :: FilePath -> TestTree +frontendErrorTests resourcesFp = + testGroup + "Frontend error tests" + [ testCase "Duplicate type definition" $ do + let workDir = resourcesFp "duplicate_tydef" + fileIn = workDir "A.lbf" + fileErr = fileIn + errOrMod <- runFrontend [workDir] fileIn + assertError (fileErr <> ":(5:1)-(5:12) Duplicate type definition with the name A") errOrMod + , testCase "Import cycle found" $ do + let workDir = resourcesFp "import_cycle_found" + fileIn = workDir "A.lbf" + fileErr = workDir "C.lbf" + errOrMod <- runFrontend [workDir] fileIn + assertError (fileErr <> ":(3:1)-(3:9) Tried to load module A which constitutes a cycle [B, A, ]") errOrMod + , testCase "Imported symbol not found" $ do + let workDir = resourcesFp "imported_not_found" + fileIn = workDir "A.lbf" + fileErr = fileIn + errOrMod <- runFrontend [workDir] fileIn + assertError (fileErr <> ":(3:17)-(3:18) Type C not found in module B, did you mean one of [A, B]") errOrMod + , testCase "Invalid module filepath" $ do + let workDir = resourcesFp "invalid_module_filepath" + fileIn = workDir "A.lbf" + fileErr = fileIn + errOrMod <- runFrontend [workDir] fileIn + assertError (fileErr <> ":(1:8)-(1:13) File name resources/invalid_module_filepath/A.lbf doesn't match module name A.B.C expected A/B/C.lbf") errOrMod + , testCase "Module not found" $ do + let workDir = resourcesFp "module_not_found" + fileIn = workDir "A.lbf" + fileErr = fileIn + errOrMod <- runFrontend [workDir] fileIn + assertError (fileErr <> ":(3:1)-(3:9) Module B not found in available import paths [resources/module_not_found]") errOrMod + , testCase "Module parse error" $ do + let workDir = resourcesFp "module_parse_error" + fileIn = workDir "A.lbf" + fileErr = fileIn + errOrMod <- runFrontend [workDir] fileIn + assertError (fileErr <> ":(3:1):\nunexpected 't'\nexpecting lb new line, import statement, type definition, space or end of input") errOrMod + , testCase "Multiple modules found" $ do + let workDir = resourcesFp "multiple_modules_found" + fileIn = workDir "A.lbf" + fileErr = fileIn + errOrMod <- runFrontend [workDir, workDir "another_import_path"] fileIn + assertError (fileErr <> ":(3:1)-(3:9) Module B found in multiple files [resources/multiple_modules_found/B.lbf, resources/multiple_modules_found/another_import_path/B.lbf]") errOrMod + , testCase "Symbol already imported" $ do + let workDir = resourcesFp "symbol_already_imported" + fileIn = workDir "A.lbf" + fileErr = fileIn + errOrMod <- runFrontend [workDir] fileIn + assertError (fileErr <> ":(4:1)-(4:9) Symbol A already imported from module B") errOrMod + , testCase "Type definition name conflict" $ do + let workDir = resourcesFp "tydef_name_conflict" + fileIn = workDir "A.lbf" + fileErr = fileIn + errOrMod <- runFrontend [workDir] fileIn + assertError (fileErr <> ":(5:1)-(5:12) Type name A conflicts with an imported type name from module B") errOrMod + , testCase "Type reference not found" $ do + let workDir = resourcesFp "tyref_not_found" + fileIn = workDir "A.lbf" + fileErr = fileIn + errOrMod <- runFrontend [workDir] fileIn + assertError (fileErr <> ":(6:13)-(6:28) Type WhereIsThisType not found in the module's scope [A, B, C, B.B, C.C]") errOrMod + ] + +assertError :: String -> Either FrontendError (Map (ModuleName ()) (Module SourceInfo)) -> Assertion +assertError expected (Left frErr) = expected @?= show frErr +assertError _ (Right _) = assertFailure "Expected to fail but succeeded" + +assertSuccess :: [String] -> Either FrontendError (Map (ModuleName ()) (Module SourceInfo)) -> Assertion +assertSuccess _ (Left err) = assertFailure $ "Expected to succeed but failed with: " <> show err +assertSuccess expected (Right mods) = Set.fromList expected @?= Set.fromList (show . pretty <$> Map.keys mods) + +frontendSuccessTests :: FilePath -> TestTree +frontendSuccessTests resourcesFp = + testGroup + "Frontend success tests" + [ testCase "Good" $ do + let workDir = resourcesFp "good" + fileIn = workDir "Test.lbf" + errOrMod <- runFrontend [workDir] fileIn + assertSuccess ["A", "A.B", "B", "C", "Test"] errOrMod + , testGroup + "Formatting" -- TODO(bladyjoker): Add Equality check on compiled inputs (Set semantics on imports, ty defs etc) + [ testCase "BadFormat.lbf compiles" $ do + let workDir = resourcesFp "formatting" + fileIn = workDir "BadFormat.lbf" + errOrMod <- runFrontend [workDir] fileIn + assertSuccess ["A", "BadFormat"] errOrMod + , testCase "good/BadFormat.lbf also compiles" $ do + let workDir = resourcesFp "formatting" "good" + fileIn = workDir "BadFormat.lbf" + errOrMod' <- runFrontend [workDir] fileIn + assertSuccess ["A", "BadFormat"] errOrMod' + ] + ] diff --git a/lambda-buffers-proto/compiler.proto b/lambda-buffers-proto/compiler.proto index 3290d333..6064459f 100644 --- a/lambda-buffers-proto/compiler.proto +++ b/lambda-buffers-proto/compiler.proto @@ -102,18 +102,19 @@ message TyName { SourceInfo source_info = 2; } -// Regex [A-Z]+[A-Za-z0-9_]* +// Regex (ModuleNamePart|.)+ message ModuleName { - string name = 1; + repeated ModuleNamePart parts = 1; SourceInfo source_info = 2; } -// Regex [a-z]+ -message ArgName { +// Regex [A-Z]+[A-Za-z0-9_]* +message ModuleNamePart { string name = 1; SourceInfo source_info = 2; } +// Regex [a-z]+ // Regex [a-z]+ message VarName { string name = 1; @@ -189,7 +190,7 @@ EitherF (f :: Type -> Type) (a :: Type) (b :: Type) = Left (f a) | Right (f b) ``` */ message TyArg { - ArgName arg_name = 1; + VarName arg_name = 1; Kind arg_kind = 2; SourceInfo source_info = 3; } @@ -204,23 +205,21 @@ Because of that we can simply encode them using the notion of `arity` which represents a number of type arguments that have to be applied to a type of `Type -> Type -> .. -> Type` to get a `Type` (ie. fully applied function, fully saturated). - -Alternatively and generally, `Kind` term could be could be expressed as - -message Kind { - message KindName { string name = 1;} - message KindArrow { Kind left = 1; Kind right = 2;} - oneof kind { - KindName kind_name = 1; - KindArrow kind_arrow = 2; - } -} */ message Kind { + enum KindRef { + KIND_REF_UNSPECIFIED = 0; + KIND_REF_TYPE = 1; + }; + message KindArrow { + Kind left = 1; + Kind right = 2; + } oneof kind { - int32 arity = 1; + KindRef kind_ref = 1; + KindArrow kind_arrow = 2; }; - SourceInfo source_info = 2; + SourceInfo source_info = 3; } @@ -315,15 +314,11 @@ message Product { repeated Ty fields = 1; SourceInfo source_info = 2; } - message Empty { - SourceInfo source_info = 1; - } oneof product { - Empty empty = 1; - Record record = 2; - NTuple ntuple = 3; + Record record = 1; + NTuple ntuple = 2; } - SourceInfo source_info = 4; + SourceInfo source_info = 3; }