diff --git a/cabal.project b/cabal.project index bc3e346..d1e1495 100644 --- a/cabal.project +++ b/cabal.project @@ -1,4 +1,4 @@ packages: initial-encoding leibniz-proof - parser-closed + tagless-final diff --git a/parser-closed/parser-closed.cabal b/parser-closed/parser-closed.cabal deleted file mode 100644 index 03f0c8a..0000000 --- a/parser-closed/parser-closed.cabal +++ /dev/null @@ -1,13 +0,0 @@ - cabal-version: 3.4 - name: parser-closed - version: 0.1.0.0 - -executable parser-closed - main-is: Main.hs - build-depends: base ^>=4.14.3.0, - eq, - megaparsec, - parser-combinators, - text - hs-source-dirs: app - default-language: Haskell2010 diff --git a/tagless-final/app/Main.hs b/tagless-final/app/Main.hs new file mode 100644 index 0000000..6d96a09 --- /dev/null +++ b/tagless-final/app/Main.hs @@ -0,0 +1,21 @@ +module Main where + +import qualified Text.Megaparsec as M + +import Closed.Parser +import Data.Text.IO (hGetContents) +import System.Environment (getArgs) +import System.IO (IOMode(ReadMode), openFile) + +-- ======================================== +-- Main +-- ======================================== + +main :: IO () +main = do + [fileName] <- getArgs + handle <- openFile fileName ReadMode + contents <- hGetContents handle + case M.parse expr fileName contents of + Left e -> print $ M.errorBundlePretty e + Right a -> print (fromDyn a :: Maybe (Eval Integer)) diff --git a/parser-closed/app/Main.hs b/tagless-final/src/Closed/Parser.hs similarity index 81% rename from parser-closed/app/Main.hs rename to tagless-final/src/Closed/Parser.hs index 806658d..481a1e6 100644 --- a/parser-closed/app/Main.hs +++ b/tagless-final/src/Closed/Parser.hs @@ -3,11 +3,21 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} -module Main where +module Closed.Parser +( Dynamic(..) +, Eval(..) +, Parser +, SQ(..) +, Symantics(..) +, TQ(..) +, Typeable(..) +, expr +, fromDyn +, toDyn +) where import qualified Control.Monad.Combinators.Expr as E import qualified Data.Eq.Type as EQ @@ -16,17 +26,10 @@ import qualified Text.Megaparsec.Char as MC import qualified Text.Megaparsec.Char.Lexer as ML import Control.Applicative ((<|>)) -import Data.Char (isDigit) import Data.Eq.Type ((:=)) -import Data.Foldable (foldl') import Data.Functor (($>), void) -import Data.Proxy (Proxy(..)) import Data.Text (Text, unpack) -import Data.Text.IO (hGetContents) import Data.Void (Void) -import Numeric (readDec) -import System.Environment (getArgs) -import System.IO (IOMode(ReadMode), openFile) -- ======================================== -- Symantics @@ -50,15 +53,15 @@ instance Symantics SQ where eAnd (SQ lhs) (SQ rhs) = SQ (eAnd lhs rhs) eOr (SQ lhs) (SQ rhs) = SQ (eOr lhs rhs) -newtype Expr a = Expr {runExpr :: a} deriving Show +newtype Eval a = Eval {runEval :: a} deriving Show -instance Symantics Expr where - eInt = Expr - eBool = Expr - eAdd (Expr lhs) (Expr rhs) = Expr (lhs + rhs) - eSub (Expr lhs) (Expr rhs) = Expr (lhs - rhs) - eAnd (Expr lhs) (Expr rhs) = Expr (lhs && rhs) - eOr (Expr lhs) (Expr rhs) = Expr (lhs || rhs) +instance Symantics Eval where + eInt = Eval + eBool = Eval + eAdd (Eval lhs) (Eval rhs) = Eval (lhs + rhs) + eSub (Eval lhs) (Eval rhs) = Eval (lhs - rhs) + eAnd (Eval lhs) (Eval rhs) = Eval (lhs && rhs) + eOr (Eval lhs) (Eval rhs) = Eval (lhs || rhs) -- ======================================== -- Typeable @@ -144,13 +147,13 @@ boolean = lexeme_ do {-# INLINE boolean #-} integer :: Parser Integer -integer = lexeme_ do - i <- M.some $ M.satisfy isDigit - case readDec i of - [(value, "")] -> pure value - _ -> fail "integer" +integer = lexeme_ ML.decimal {-# INLINE integer #-} +-- ======================================== +-- Deserialization +-- ======================================== + mkBinary :: forall repr a . Symantics repr @@ -184,16 +187,3 @@ expr = expr' >>= \case case mkBinary bin lhs' rhs' of Nothing -> Left (offset, "Invalid operands for `" <> unpack name <> "`") Just a -> pure a - --- ======================================== --- Main --- ======================================== - -main :: IO () -main = do - [fileName] <- getArgs - handle <- openFile fileName ReadMode - contents <- hGetContents handle - case M.parse expr fileName contents of - Left e -> print $ M.errorBundlePretty e - Right a -> print (fromDyn a :: Maybe (Expr Integer)) diff --git a/tagless-final/tagless-final.cabal b/tagless-final/tagless-final.cabal new file mode 100644 index 0000000..6346fdd --- /dev/null +++ b/tagless-final/tagless-final.cabal @@ -0,0 +1,22 @@ + cabal-version: 3.4 + name: tagless-final + version: 0.1.0.0 + +executable tagless-final + main-is: Main.hs + build-depends: base ^>=4.14.3.0, + megaparsec, + tagless-final, + text + hs-source-dirs: app + default-language: Haskell2010 + +library + build-depends: base ^>=4.14.3.0, + eq, + megaparsec, + parser-combinators, + text + hs-source-dirs: src + default-language: Haskell2010 + exposed-modules: Closed.Parser