fnotation 0.1.0.0 → 0.1.1.0
raw patch · 5 files changed
+86/−72 lines, 5 files
Files
- fnotation.cabal +4/−2
- src/FNotation/Lexer.hs +3/−3
- src/FNotation/Parser.hs +8/−5
- src/FNotation/Pretty.hs +1/−1
- test/Main.hs +70/−61
fnotation.cabal view
@@ -1,11 +1,13 @@ cabal-version: 3.4 name: fnotation-description: A lower house syntax for programming language experimentation.-version: 0.1.0.0+version: 0.1.1.0 license: MPL-2.0 license-file: LICENSE maintainer: root@owenlynch.org author: Owen Lynch+description:+ A lower house syntax for programming language experimentation.+ category: Language build-type: Simple extra-doc-files: CHANGELOG.md
src/FNotation/Lexer.hs view
@@ -70,7 +70,7 @@ iter :: IORef TU.Iter, out :: Buffer Token, file :: File,- reporter :: ReporterFor LexerCode,+ reporter :: Reporter LexerCode, config :: ConfTable Kind } @@ -151,7 +151,7 @@ report st c m = do s <- span st let d = Diagnostic c m [Note (Just (SourceLoc (st.file) s)) Nothing]- reportTo st.reporter d+ st.reporter.reportIO d unexpectedChar :: LexState -> Char -> IO () unexpectedChar st c = do@@ -262,7 +262,7 @@ c -> unexpectedChar st c >> run st -- | Run the lexer, return a vector of tokens ready for parsing.-lex :: ConfTable Kind -> ReporterFor LexerCode -> File -> IO (V.Vector Token)+lex :: ConfTable Kind -> Reporter LexerCode -> File -> IO (V.Vector Token) lex config reporter file = do pos <- newIORef 0 prev <- newIORef 0
src/FNotation/Parser.hs view
@@ -39,7 +39,7 @@ skipNewlines :: IORef Bool, tokens :: V.Vector T.Token, file :: File,- reporter :: ReporterFor ParserCode,+ reporter :: Reporter ParserCode, config :: ConfTable Prec } @@ -50,7 +50,7 @@ report st s c m = do let n = Note (Just (SourceLoc st.file s)) Nothing let d = Diagnostic c m [n]- reportTo st.reporter d+ st.reporter.reportIO d cur :: ParseState -> IO T.Kind cur st = do@@ -58,11 +58,11 @@ if gas <= 0 then do pos <- readIORef st.pos- let token = V.unsafeIndex st.tokens pos+ let token = st.tokens V.! pos error $ "out of gas at token " ++ show (dpretty token) else writeIORef st.gas (gas - 1) pos <- readIORef st.pos- pure (V.unsafeIndex st.tokens pos).kind+ pure (st.tokens V.! pos).kind locally :: IORef a -> a -> IO b -> IO b locally ref v action = do@@ -223,6 +223,9 @@ T.Field -> do x <- curName st advanceClose st m $ Field x+ T.Tag -> do+ x <- curName st+ advanceClose st m $ Tag x T.Int -> do i <- curInt st advanceClose st m $ Int i@@ -313,7 +316,7 @@ -- Toplevel parsing interface -------------------------------------------------------------------------------- -parse :: ConfTable Prec -> ReporterFor ParserCode -> File -> V.Vector T.Token -> IO [Ntn]+parse :: ConfTable Prec -> Reporter ParserCode -> File -> V.Vector T.Token -> IO [Ntn] parse config reporter file tokens = do pos <- newIORef 0 gas <- newIORef 256
src/FNotation/Pretty.hs view
@@ -55,7 +55,7 @@ in par (looser p' p) (prt (LeftOf p') l <+> prt Bot n <+> prt (RightOf p') r) Block x hd stmts _ -> vsep $- [dpretty x <> maybe mempty prtTop hd]+ [dpretty x <> maybe mempty ((" " <>) . prtTop) hd] ++ [indent 2 $ prtTop stmt | stmt <- stmts] ++ ["end"] Decl x n _ -> dpretty x <+> prtTop n
test/Main.hs view
@@ -1,22 +1,23 @@ module Main (main) where -import Prelude hiding (lex) import Data.ByteString.Lazy qualified as LBS+import Data.Functor.Contravariant (contramap, (>$<)) import Data.Map (Map) import Data.Map qualified as Map-import Data.Vector qualified as V import Data.Text.IO.Utf8 qualified as T import Data.Text.Lazy.Encoding qualified as TLE+import Data.Vector qualified as V import Diagnostician import FNotation import FNotation.Tokens qualified as K import Prettyprinter import Prettyprinter.Render.Text-import Test.Tasty (defaultMain, TestTree, testGroup)-import Test.Tasty.Golden (goldenVsString, findByExtension)-import System.FilePath (takeBaseName, replaceExtension)+import System.FilePath (replaceExtension, takeBaseName) import System.IO import System.IO.Temp (withSystemTempFile)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.Golden (findByExtension, goldenVsString)+import Prelude hiding (lex) main :: IO () main = defaultMain =<< goldenTests@@ -25,49 +26,52 @@ render = TLE.encodeUtf8 . renderLazy . layoutPretty defaultLayoutOptions lexConfig :: ConfTable Kind-lexConfig = confTableFromList- [ ("sig", K.Block),- ("struct", K.Block),- ("sum", K.Block),- ("match", K.Block),- ("theory", K.Decl),- ("def", K.Decl),- ("type", K.Decl),- ("let", K.Decl),- ("open", K.Decl),- ("import", K.Decl),- ("end", K.End),- ("Type", K.AKeyword),- ("Int", K.AKeyword),- ("String", K.AKeyword),- (":=", K.SKeyword),- ("=", K.SKeyword),- (":", K.SKeyword),- ("->", K.SKeyword),- ("=>", K.SKeyword)- ]+lexConfig =+ confTableFromList+ [ ("sig", K.Block),+ ("struct", K.Block),+ ("sum", K.Block),+ ("match", K.Block),+ ("theory", K.Decl),+ ("def", K.Decl),+ ("type", K.Decl),+ ("let", K.Decl),+ ("open", K.Decl),+ ("import", K.Decl),+ ("end", K.End),+ ("Type", K.AKeyword),+ ("Int", K.AKeyword),+ ("String", K.AKeyword),+ (":=", K.SKeyword),+ ("=", K.SKeyword),+ (":", K.SKeyword),+ ("->", K.SKeyword),+ ("=>", K.SKeyword)+ ] parseConfig :: ConfTable Prec-parseConfig = confTableFromList- [ (":=", Prec 10 AssocNon),- (":", Prec 20 AssocNon),- ("->", Prec 30 AssocR),- ("=>", Prec 30 AssocR),- ("=", Prec 40 AssocNon),- ("+", Prec 50 AssocL),- ("-", Prec 50 AssocL),- ("*", Prec 60 AssocL),- ("/", Prec 60 AssocL)- ]+parseConfig =+ confTableFromList+ [ (":=", Prec 10 AssocNon),+ (":", Prec 20 AssocNon),+ ("->", Prec 30 AssocR),+ ("=>", Prec 30 AssocR),+ ("=", Prec 40 AssocNon),+ ("+", Prec 50 AssocL),+ ("-", Prec 50 AssocL),+ ("*", Prec 60 AssocL),+ ("/", Prec 60 AssocL)+ ] data TestCode = LexerCode LexerCode | ParserCode ParserCode deriving (Eq, Ord) codeTable :: Map TestCode CodeMeta-codeTable = mconcat- [ promoteCodeTable lexerCodeTable LexerCode 0,- promoteCodeTable parserCodeTable ParserCode 100- ]+codeTable =+ mconcat+ [ promoteCodeTable lexerCodeTable LexerCode 0,+ promoteCodeTable parserCodeTable ParserCode 100+ ] instance Code TestCode where codeMeta c = case Map.lookup c codeTable of@@ -79,30 +83,35 @@ src <- T.readFile fp let f = newFile fp src withSystemTempFile "reporter-output" $ \path h -> do- let r = Reporter h False- tokens <- lex lexConfig (ReporterFor LexerCode r) f- ns <- parse parseConfig (ReporterFor ParserCode r) f tokens+ let r = fileReporter h+ tokens <- lex lexConfig (contramap LexerCode r) f+ ns <- parse parseConfig (contramap ParserCode r) f tokens hFlush h hClose h msgs <- T.readFile path- pure $ render $ vsep [- "-- tokens",- vsep $ dpretty <$> V.toList tokens,- "",- "-- notation",- vsep $ dpretty <$> ns,- "",- "-- pretty",- vsep $ dprettyWithPrecs parseConfig <$> ns,- "",- "-- messages",- pretty $ msgs]+ pure $+ render $+ vsep+ [ "-- tokens",+ vsep $ dpretty <$> V.toList tokens,+ "",+ "-- notation",+ vsep $ dpretty <$> ns,+ "",+ "-- pretty",+ vsep $ dprettyWithPrecs parseConfig <$> ns,+ "",+ "-- messages",+ pretty $ msgs+ ] goldenTests :: IO TestTree goldenTests = do ntnFiles <- findByExtension [".ntn"] "."- return $ testGroup "FNotation golden tests"- [ goldenVsString (takeBaseName ntnFile) outputFile (parseToPretty ntnFile)- | ntnFile <- ntnFiles- , let outputFile = replaceExtension ntnFile ".output"- ]+ return $+ testGroup+ "FNotation golden tests"+ [ goldenVsString (takeBaseName ntnFile) outputFile (parseToPretty ntnFile)+ | ntnFile <- ntnFiles,+ let outputFile = replaceExtension ntnFile ".output"+ ]