Indentation WIP

app/Main.hs

@@ -1,6 +1,6 @@
 module Main where
 
-import Lib
+import PxLang.Repl
 
 main :: IO ()
-main = someFunc
+main = repl

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:

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

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"