feat(Parser): parse when x is expressions

CHANGELOG.md

@@ -1,4 +1,4 @@
-# Changelog for `purist`
+# Changelog for `pure`
 
 All notable changes to this project will be documented in this file.
 

README.md

@@ -1,4 +1,4 @@
-# `purist` - Pure Dev Suite 🧰
+# `pure` - Pure Dev Suite 🧰
 
 Pure is a
 
@@ -27,15 +27,15 @@ We hope that Pure will be able to target the following use cases:
 You may use the installation script:
 
 ```bash
-source <(curl -s https://raw.githubusercontent.com/prog-lang/purist/main/install.sh)
+source <(curl -s https://raw.githubusercontent.com/prog-lang/pure/main/install.sh)
 ```
 
 Or execute these commands manually (the script does the same as the following
 code snippet):
 
 ```bash
-git clone git@github.com:prog-lang/purist.git
-cd purist
+git clone git@github.com:prog-lang/pure.git
+cd pure
 stack install
 ```
 
@@ -49,18 +49,18 @@ on UNIX systems and probably something similar on Windows.
 Therefore, uninstalling is extremely straightforward:
 
 ```bash
-rm $(which purist)
+rm $(which pure)
 ```
 
 ## Usage Basics 👷‍♀️
 
 The following command will transpile `someModule.pure` into `someModule.js`.
 
 ```bash
-purist c < someModule.pure > someModule.js
+pure compile someModule.pure > someModule.js
 ```
 
-**NOTE:** Executing `purist` with no arguments displays the _help_ message. Use
+**NOTE:** Executing `pure` with no arguments displays the _help_ message. Use
 it to get acquainted with its capabilities.
 
 ## Develop 👨‍💻
@@ -73,10 +73,10 @@ We are working hard to give you a tool you can be excited about.
 ### Progress
 
 - [x] [Parser](./src/Pure/Parser.hs)
-- [x] [Module (AST)](./src/Pure.hs)
-- [ ] Type Checker with Inference
-- [ ] [Transpiler $\to$ Node.js](./src/Node/Transpiler.hs)
-- [ ] Transpiler $\to$ Go
+- [x] [Type Checker with Inference](./src/Pure/Typing/)
+- [x] [Transpiler to Node.js](./src/Node/Transpiler.hs)
+- [ ] `when x is` expressions
+- [ ] `trait T a can` and `proof T R can` typing
 
 ### Vision
 
@@ -90,9 +90,14 @@ ever touched Elm or Haskell, you will know what I'm on about.
 
 ### Inspiration
 
+- [Elm][elm] - a delightful language for reliable web applications
 - [Duet][duet] - a subset of Haskell aimed at aiding teachers teach Haskell
 - [PureScript][ps] - a strongly-typed language that compiles to JavaScript
 
+[elm]: https://elm-lang.org/
+[duet]: https://github.com/chrisdone/duet
+[ps]: https://github.com/purescript/purescript
+
 ### Syntactic Analysis
 
 - [Parsec tutorial][parsecTutorial] and some conveniences like
@@ -111,8 +116,6 @@ ever touched Elm or Haskell, you will know what I'm on about.
 - [Programming Languages: Application and Interpretation][langs-ch.15] -
   chapter 15: Checking Program Invariants Statically: Types
 
-[duet]: https://github.com/chrisdone/duet
-[ps]: https://github.com/purescript/purescript
 [thih]: https://github.com/ocramz/thih
 [thih-pdf]: https://web.cecs.pdx.edu/~mpj/thih/thih.pdf
 [warn]: http://moscova.inria.fr/~maranget/papers/warn/warn.pdf

app/Main.hs

@@ -18,7 +18,7 @@ main = runIO app
 app :: Application
 app =
   application
-    "purist"
+    "pure"
     (showVersion version)
     "Development suite for the Pure programming language"
     ["Viktor A. Rozenko Voitenko <sharp.vik@gmail.com>"]

install.sh

@@ -1,7 +1,7 @@
 #!/usr/bin/env bash
 
-git clone git@github.com:prog-lang/purist.git
-cd purist
+git clone git@github.com:prog-lang/pure.git
+cd pure
 stack install
 cd ..
-rm -rf purist
+rm -rf pure

src/Pure/Expr.hs

@@ -1,55 +1,85 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 module Pure.Expr (Expr (..), positionOf) where
 
+import Data.Char (isUpperCase)
+import Data.Set (Set)
+import qualified Data.Set as Set
 import qualified Pure.Sacred as S
+import Pure.Typing.Free (Free (..))
 import Text.Parsec (SourcePos)
 import Utility.Common (Id)
-import Utility.Strings (Parens (..), list, parenthesised, (+-+))
+import Utility.Strings (Parens (..), parenthesised, (+-+))
 
 -- EXPRESSION ------------------------------------------------------------------
 
 data Expr
   = Lam Id Expr SourcePos
+  | XLam Expr Expr SourcePos
   | If Expr Expr Expr SourcePos
   | App Expr Expr SourcePos
-  | List [Expr] SourcePos
   | Id Id SourcePos
   | Str String SourcePos
   | Float Double SourcePos
   | Int Integer SourcePos
   | Bool Bool SourcePos
+  | --         XLam
+    When Expr [Expr] SourcePos
   deriving (Eq)
 
+-- FREE ------------------------------------------------------------------------
+
+instance Free Expr where
+  free (Lam i e _) = Set.union (freeVar i) (free e)
+  free (XLam e1 e2 _) = Set.unions $ map free [e1, e2]
+  free (If e1 e2 e3 _) = Set.unions $ map free [e1, e2, e3]
+  free (App e1 e2 _) = Set.unions $ map free [e1, e2]
+  free (Id i _) = freeVar i
+  free _ = Set.empty
+
+freeVar :: Id -> Set Id
+freeVar i@(l : _) =
+  if l == S.underscore || isUpperCase l
+    then Set.empty
+    else Set.singleton i
+freeVar "" = undefined
+
 -- POSITION --------------------------------------------------------------------
 
-positionOf :: Expr -> SourcePos
-positionOf (Lam _ _ pos) = pos
-positionOf (If _ _ _ pos) = pos
-positionOf (App _ _ pos) = pos
-positionOf (List _ pos) = pos
-positionOf (Id _ pos) = pos
-positionOf (Str _ pos) = pos
-positionOf (Float _ pos) = pos
-positionOf (Int _ pos) = pos
-positionOf (Bool _ pos) = pos
+class Position a where
+  positionOf :: a -> SourcePos
+
+instance Position Expr where
+  positionOf (Lam _ _ pos) = pos
+  positionOf (When _ _ pos) = pos
+  positionOf (XLam _ _ pos) = pos
+  positionOf (If _ _ _ pos) = pos
+  positionOf (App _ _ pos) = pos
+  positionOf (Id _ pos) = pos
+  positionOf (Str _ pos) = pos
+  positionOf (Float _ pos) = pos
+  positionOf (Int _ pos) = pos
+  positionOf (Bool _ pos) = pos
 
 -- SHOW ------------------------------------------------------------------------
 
 instance Parens Expr where
-  parens b@(Bool _ _) = show b
-  parens i@(Int _ _) = show i
-  parens f@(Float _ _) = show f
-  parens s@(Str _ _) = show s
-  parens i@(Id _ _) = show i
-  parens l@(List _ _) = show l
+  parens literal@(Id _ _) = show literal
+  parens literal@(Str _ _) = show literal
+  parens literal@(Float _ _) = show literal
+  parens literal@(Int _ _) = show literal
+  parens literal@(Bool _ _) = show literal
   parens ex = parenthesised $ show ex
 
 instance Show Expr where
-  show (Bool bool _) = show bool
-  show (Int int _) = show int
-  show (Float number _) = show number
+  show (Id i _) = i
   show (Str str _) = show str
-  show (Id ident _) = ident
-  show (List l _) = list (map show l)
+  show (Float f _) = show f
+  show (Int int _) = show int
+  show (Bool bool _) = show bool
   show (App f arg _) = show f +-+ parens arg
   show (If x y z _) = S.if_ +-+ show x +-+ S.then_ +-+ show y +-+ S.else_ +-+ show z
-  show (Lam p ex _) = p +-+ S.arrow +-+ show ex
+  show (Lam from to _) = from +-+ S.arrow +-+ show to
+  show (XLam from to _) = parens from +-+ S.arrow +-+ show to
+  show (When x opts _) = S.when +-+ show x +-+ S.is +-+ unwords (map show opts)

src/Pure/Parser.hs

@@ -4,7 +4,6 @@
 
 module Pure.Parser
   ( Module (..),
-    Id,
     moduleNames,
     assignmentNames,
     typeHintNames,
@@ -189,20 +188,17 @@ definitionP = Def <$> (typeDefP <|> try typeHintP <|> defP)
 
 typeDefP :: Parser Def
 typeDefP = do
-  _ <- reservedP S.type_
-  name <- upperNameP
+  name <- reservedP S.type_ >> upperNameP
   params <- many lowerNameP
-  _ <- reservedP S.is >> barP
-  cons <- sepBy1 typeConsP barP
+  cons <- reservedP S.is >> barP >> sepBy1 typeConsP barP
   return $ TypeDef name params cons
   where
     barP = reservedOp parser [S.bar]
 
 typeHintP :: Parser Def
 typeHintP = do
   name <- nameP
-  _ <- reservedOp parser S.typed
-  ty <- typeP
+  ty <- reservedOp parser S.typed >> typeP
   return $ TypeHint name ty
 
 typeConsP :: Parser Type
@@ -243,12 +239,30 @@ typeVarP = do
 defP :: Parser Def
 defP = do
   name <- nameP
-  _ <- reservedOp parser S.walrus
-  expr <- exprP
+  expr <- reservedOp parser S.walrus >> exprP
   return $ ValueDef name expr
 
 exprP :: Parser Expr
-exprP = try ifP <|> try lambdaP <|> try appP <|> literalP <?> "an expression"
+exprP =
+  -- try whenP
+  try ifP
+    <|> try lambdaP
+    <|> try appP
+    <|> literalP
+    <?> "an expression"
+
+-- whenP :: Parser Expr
+-- whenP = do
+--   pos <- sourcePos
+--   e <- between (reservedP S.when) (reservedP S.is) notIfP
+--   brs <- barP >> sepBy1 branchP barP
+--   return $ When e brs pos
+--   where
+--     barP = reservedOp parser [S.bar]
+--     branchP = do
+--       pat <- litP <* reservedP S.then_
+--       result <- exprP
+--       return (pat, result)
 
 ifP :: Parser Expr
 ifP = do
@@ -265,7 +279,7 @@ notIfP = try lambdaP <|> try appP <|> literalP <?> "a condition"
 lambdaP :: Parser Expr
 lambdaP = do
   pos <- sourcePos
-  param <- nameP <* reservedOp parser S.arrow <?> "a named parameter"
+  param <- lowerNameP <* reservedOp parser S.arrow <?> "a named parameter"
   expr <- exprP
   return $ Lam param expr pos
 
@@ -281,21 +295,22 @@ callerP :: Parser Expr
 callerP = parensP exprP <|> try qualifiedP <|> idP
 
 literalP :: Parser Expr
-literalP =
-  parensP exprP
-    <|> listP
-    <|> strP
+literalP = parensP exprP <|> litP
+
+litP :: Parser Expr
+litP =
+  strP
     <|> try boolP
     <|> try qualifiedP
     <|> try idP
     <|> try floatP
     <|> intP
 
-listP :: Parser Expr
-listP = do
-  pos <- sourcePos
-  list <- brackets parser $ commaSep1 parser exprP
-  return $ List list pos
+-- listP :: Parser Expr
+-- listP = do
+--   pos <- sourcePos
+--   list <- brackets parser $ commaSep1 parser exprP
+--   return $ List list pos
 
 qualifiedP :: Parser Expr
 qualifiedP = do

src/Pure/Sacred.hs

@@ -10,7 +10,7 @@ isKeyword :: String -> Bool
 isKeyword = flip List.elem keywords
 
 keywords :: [String]
-keywords = [export, if_, then_, else_, type_, is]
+keywords = [export, if_, then_, else_, type_, when, is]
 
 export :: String
 export = "export"
@@ -27,6 +27,9 @@ else_ = "else"
 type_ :: String
 type_ = "type"
 
+when :: String
+when = "when"
+
 is :: String
 is = "is"