diff --git a/app/Main.hs b/app/Main.hs index de1c1ab..672db60 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,6 @@ module Main where -import Lib +import PxLang.Repl main :: IO () -main = someFunc +main = repl diff --git a/package.yaml b/package.yaml index bbea583..4442346 100644 --- a/package.yaml +++ b/package.yaml @@ -42,7 +42,7 @@ library: - -Werror executables: - px-lang-exe: + px-repl: main: Main.hs source-dirs: app ghc-options: @@ -54,7 +54,7 @@ executables: - px-lang tests: - px-lang-test: + px-test: main: Spec.hs source-dirs: test ghc-options: diff --git a/src/Lib.hs b/src/Lib.hs deleted file mode 100644 index 5bf2c78..0000000 --- a/src/Lib.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Lib - ( someFunc - ) where - - - -someFunc :: IO () -someFunc = putStrLn "someFunc" diff --git a/src/PxLang/Eval.hs b/src/PxLang/Eval.hs index 0f507a1..f28f407 100644 --- a/src/PxLang/Eval.hs +++ b/src/PxLang/Eval.hs @@ -1,9 +1,10 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module PxLang.Eval where import Control.Arrow ((>>>)) @@ -14,13 +15,14 @@ import Control.Monad.Reader (MonadReader (..), asks) import Data.Fix import Data.Map (Map) import qualified Data.Map as M +import Data.Semigroup (Semigroup) import Text.Show.Pretty (ppShow) import PxLang.Syntax newtype TermEnv = TermEnv { unTermEnv :: Map String (Fix Expr) } - deriving (Show) + deriving (Show, Semigroup, Monoid) showScope :: TermEnv -> String @@ -29,23 +31,6 @@ showScope (TermEnv env) = in unlines $ zipWith (++) hdrs $ lines $ ppShow $ pxPretty <$> env --- | In order to support some primitive operations we're just sticking some --- named lambdas in here. -prelude :: TermEnv -prelude = TermEnv mempty ---prelude = TermEnv $ M.fromList [ ("add", f Add) --- , ("sub", f Sub) --- , ("mult", f Mult) --- , ("div", f Div) --- , ("equal", f Equal) --- ] --- where f op = let x = Name "x" --- y = Name "y" --- in Fix $ Lam x --- $ Fix $ Lam y --- $ Fix $ Op op (Fix $ Var x) (Fix $ Var y) - - data Repl = Repl { replTermEnv :: TermEnv , replEvalDepth :: Int , replBreakOnEval :: Bool @@ -54,7 +39,7 @@ data Repl = Repl { replTermEnv :: TermEnv defaultRepl :: Repl -defaultRepl = Repl { replTermEnv = prelude +defaultRepl = Repl { replTermEnv = mempty , replEvalDepth = 0 , replBreakOnEval = False , replParseOnly = False diff --git a/src/PxLang/Parser.hs b/src/PxLang/Parser.hs index 4946d5d..4aa55b1 100644 --- a/src/PxLang/Parser.hs +++ b/src/PxLang/Parser.hs @@ -8,7 +8,7 @@ {-# LANGUAGE TypeFamilies #-} module PxLang.Parser where -import Control.Monad (msum) +import Control.Monad (msum, void) import Control.Monad.Combinators.Expr (makeExprParser) import Data.Bifunctor (bimap) import Data.Char (isUpper) @@ -20,16 +20,16 @@ import Text.Megaparsec (MonadParsec, ParseErrorBundle, notFollowedBy, parse, satisfy, some, try, (), (<|>)) import Text.Megaparsec.Char (alphaNumChar, letterChar, - space, space1, string) + space, space1, string, char) import qualified Text.Megaparsec.Char.Lexer as L import PxLang.Syntax -type CharToken s = (Token s ~ Char, Tokens s ~ String) - - -type PxParser e s m = (MonadParsec e s m, CharToken s) +type PxParser e s m = ( MonadParsec e s m + , Token s ~ Char + , Tokens s ~ String + ) -- $setup @@ -62,11 +62,23 @@ prettyReplParse = replParse (space *> expr) -- Lexer -------------------------------------------------------------------------------- +lineComment :: PxParser e s m => m () +lineComment = L.skipLineComment "--" + + +blockComment :: PxParser e s m => m () +blockComment = L.skipBlockComment "{-" "-}" + +-- | A "space consumer" parser that consumes newlines. +scn :: PxParser e s m => m () +scn = L.space space1 lineComment blockComment + + +-- | A "space consumer" parser that does not consume newlines. +-- We don't even allow tabs. Tab is a soda, not a char. sc :: PxParser e s m => m () -sc = L.space space1 lineComment blockComment - where lineComment = L.skipLineComment "--" - blockComment = L.skipBlockComment "{-" "-}" +sc = L.space (void $ some (char ' ')) lineComment blockComment lexeme :: PxParser e s m => m a -> m a @@ -211,6 +223,16 @@ lit = (number <|> bool) "lit" -- -- >>> testParse lambda "\\x y -> add x y" -- \x -> \y -> add x y +-- +-- >>> +-- :{ +-- testParse lambda $ unlines +-- [ "\\x" +-- , " y" +-- , " z -> add x y (succ z)" +-- ] +-- :} +-- \x -> \y -> \z -> add x y (succ z) lambda :: PxParser e s m => m (Fix Expr) lambda = flip () "lambda" $ do _ <- symbol "\\" @@ -220,6 +242,11 @@ lambda = flip () "lambda" $ do return $ foldr ((Fix .) . Lam) body args +blah :: a -> b -> c -> () +blah = \_x + _y _z -> () + + -- | Parse a let binding expression. -- -- >>> testParse letin "let x = 1000 in y"