diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Eval.hs | 4 | ||||
| -rw-r--r-- | src/Helper.hs | 4 | ||||
| -rw-r--r-- | src/Parser.hs | 28 | ||||
| -rw-r--r-- | src/Reducer.hs | 11 |
4 files changed, 32 insertions, 15 deletions
diff --git a/src/Eval.hs b/src/Eval.hs index 65db990..6b165b2 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -66,11 +66,15 @@ evalApp f g sub = Right f' -> fmap (Application f') <$> evalExp g sub ) +evalInfix :: Expression -> String -> Expression -> Environment -> Program (Failable Expression) +evalInfix le i re = evalExp $ Application (Application (Variable i) le) re + evalExp :: Expression -> Environment -> Program (Failable Expression) evalExp idx@(Bruijn _ ) = const $ pure $ Right idx evalExp ( Variable var) = evalVar var evalExp ( Abstraction e) = evalAbs e evalExp ( Application f g) = evalApp f g +evalExp (Infix le i re) = evalInfix le i re evalDefine :: String -> Expression -> Environment -> Program (Failable Expression) diff --git a/src/Helper.hs b/src/Helper.hs index 6626598..66fe265 100644 --- a/src/Helper.hs +++ b/src/Helper.hs @@ -89,7 +89,7 @@ printBundle ParseErrorBundle {..} = <> pointer <> "\n" -data Expression = Bruijn Int | Variable String | Abstraction Expression | Application Expression Expression +data Expression = Bruijn Int | Variable String | Abstraction Expression | Application Expression Expression | Infix Expression String Expression deriving (Ord, Eq) data Instruction = Define String Expression [Instruction] | Evaluate Expression | Comment | Import String String | Test Expression Expression | ContextualInstruction Instruction String deriving (Show) @@ -99,6 +99,8 @@ instance Show Expression where show (Abstraction e ) = "\ESC[36m[\ESC[0m" <> show e <> "\ESC[36m]\ESC[0m" show (Application exp1 exp2) = "\ESC[33m(\ESC[0m" <> show exp1 <> " " <> show exp2 <> "\ESC[33m)\ESC[0m" + show (Infix le i re) = + show le <> "\ESC[95m(" <> i <> ")" <> "\ESC[0m" <> show re type EnvDef = (String, Expression) -- TODO: Add EvalConf to EnvState? diff --git a/src/Parser.hs b/src/Parser.hs index 4237db7..ddf09fb 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -17,14 +17,14 @@ type Parser = Parsec Void String sc :: Parser () sc = void $ char ' ' --- zero or more spaces --- scs :: Parser () --- scs = void $ takeWhileP (Just "white space") (== ' ') +infixOperator :: Parser String +infixOperator = some $ oneOf "!?*@+$%^&<>/|=" -- def identifier disallows the import prefix dots defIdentifier :: Parser String defIdentifier = ((:) <$> (letterChar <|> char '_') <*> many (alphaNumChar <|> oneOf "?!'_-")) + <|> parens infixOperator <?> "defining identifier" -- TODO: write as extension to defIdentifier @@ -53,7 +53,7 @@ parseAbstraction = do -- one or more singletons wrapped in coupled application parseApplication :: Parser Expression parseApplication = do - s <- sepEndBy1 parseSingleton sc -- TODO: Fix consuming space at end (re. test =) + s <- sepEndBy1 parseSingleton sc pure $ foldl1 Application s parseBruijn :: Parser Expression @@ -95,19 +95,29 @@ parseVariable = do var <- identifier pure $ Variable var +parseInfix :: Parser Expression +parseInfix = do + e1 <- parseSingleton + sc + i <- infixOperator + sc + e2 <- parseSingleton + pure $ Infix e1 i e2 + parseSingleton :: Parser Expression parseSingleton = parseBruijn - <|> parseNumeral + <|> try parseNumeral <|> parseString <|> parseChar <|> parseAbstraction + <|> try (parens parseInfix <?> "enclosed infix expr") <|> (parens parseApplication <?> "enclosed application") <|> parseVariable parseExpression :: Parser Expression parseExpression = do - e <- parseApplication + e <- try parseInfix <|> parseApplication pure e <?> "expression" parseEvaluate :: Parser Instruction @@ -160,9 +170,9 @@ parseTest :: Parser Instruction parseTest = do inp <- getInput _ <- string ":test " <?> "test" - e1 <- parseExpression - _ <- string "= " -- TODO: Disallow missing space (non-trivial) - e2 <- parseExpression + e1 <- (parens parseExpression <?> "first expression") + sc + e2 <- (parens parseExpression <?> "second expression") pure $ ContextualInstruction (Test e1 e2) inp parseCommentBlock :: Parser Instruction diff --git a/src/Reducer.hs b/src/Reducer.hs index a0edc25..87d8859 100644 --- a/src/Reducer.hs +++ b/src/Reducer.hs @@ -35,11 +35,12 @@ step (Abstraction e) = Abstraction (step e) step _ = error "invalid" reduceable :: Expression -> Bool -reduceable (Bruijn _ ) = False -reduceable (Variable _ ) = True -reduceable (Application (Abstraction _) _ ) = True -reduceable (Application e1 e2) = reduceable e1 || reduceable e2 -reduceable (Abstraction e ) = reduceable e +reduceable (Bruijn _) = False +reduceable (Variable _) = True +reduceable (Application (Abstraction _) _) = True +reduceable (Application e1 e2) = reduceable e1 || reduceable e2 +reduceable (Abstraction e) = reduceable e +reduceable _ = error "invalid" -- alpha conversion is not needed with de bruijn indexing reduce :: Expression -> Expression |