Commit 5e02f974 authored by Nicolas Lenz's avatar Nicolas Lenz

WHOOOHOO: First working compilation

parent 009036d7
import Katrin.Parse
import qualified Katrin.Core
import qualified Katrin.AST
import System.Environment
import Control.Monad
import Data.Text.IO as T (readFile)
import Text.Megaparsec
......@@ -8,5 +11,6 @@ main :: IO ()
main = getArgs >>= \case
[file] -> do
content <- T.readFile file
parseTest katrin content
parseTest k content where
k = (Katrin.Core.foldExpression Katrin.Core.algebraEval <=< Katrin.Core.foldExpression Katrin.Core.algebraBeta <=< Katrin.Core.foldExpression Katrin.Core.algebraBeta) <$> Katrin.AST.foldKatrin Katrin.AST.algebraKatrinCore <$> katrin
_ -> putStrLn "Invalid argument format"
{-# LANGUAGE RecordWildCards#-}
-- | Contains algebras, types and folds for Katrin abstract syntax trees.
module Katrin where
import Data.Text (Text)
import qualified Katrin.Core as Core
{-|
Algebra for Katrin AST. This corresponds (is equivalent) to the context-free grammar in ABNF of Katrin:
@
katrin = *definition
definition = identifier "=" expression
expression = 1*segment ; Multiple times for application. Note that 1* means "one or more", not "once"
segment = literal / identifier / identifier "=>" expression / "(" expression ")"
literal = ["-" / "+"] 1*DIGIT
identifier = ALPHA *(ALPHA / DIGIT)
@
-}
data Algebra katrin definition expression segment = Algebra {
algebraKatrin :: [definition] -> katrin,
algebraDefinition :: Text -> expression -> definition,
algebraExpression :: [segment] -> expression,
algebraLiteral :: Int -> segment,
algebraValue :: Text -> segment,
algebraLambda :: Text -> expression -> segment,
algebraSubexpression :: expression -> segment
}
newtype Katrin = Katrin [Definition]
deriving (Show)
data Definition = Definition Text Expression
deriving (Show)
newtype Expression = Expression [Segment]
deriving (Show)
data Segment = Literal Int | Value Text | Lambda Text Expression | Subexpression Expression
deriving (Show)
-- Algebras
algebraTerm :: Algebra Katrin Definition Expression Segment
algebraTerm = Algebra Katrin Definition Expression Literal Value Lambda Subexpression
algebraKatrinCore :: Algebra Core.Expression b c d
algebraKatrinCore = undefined -- TODO
-- Catamorphic fold functions
foldKatrin :: Algebra katrin definition expression segment -> Katrin -> katrin
foldKatrin alg@Algebra{..} (Katrin defs) = algebraKatrin (foldDefinition alg <$> defs)
foldDefinition :: Algebra katrin def exp seg -> Definition -> def
foldDefinition alg@Algebra{..} (Definition name exp) = algebraDefinition name (foldExpression alg exp)
foldExpression :: Algebra katrin definition expression segment -> Expression -> expression
foldExpression alg@Algebra{..} (Expression segs) = algebraExpression (foldSegment alg <$> segs)
foldSegment :: Algebra katrin definition expression segment -> Segment -> segment
foldSegment alg@Algebra{..} = \case
Literal num -> algebraLiteral num
Value txt -> algebraValue txt
Lambda txt exp -> algebraLambda txt (foldExpression alg exp)
Subexpression exp -> algebraSubexpression (foldExpression alg exp)
{-# LANGUAGE RecordWildCards#-}
-- | Contains algebras, types and folds for Katrin abstract syntax trees.
module Katrin.AST where
import Data.Text (Text)
import Data.Maybe (fromJust)
import qualified Katrin.Core as Core
{-|
Algebra for Katrin AST. This corresponds (is equivalent) to the context-free grammar in ABNF of Katrin:
@
katrin = *definition
definition = identifier "=" expression
expression = 1*segment ; Multiple times for application. Note that 1* means "one or more", not "once"
segment = literal / identifier / identifier "=>" expression / "(" expression ")"
literal = ["-" / "+"] 1*DIGIT
identifier = ALPHA *(ALPHA / DIGIT)
@
-}
data Algebra katrin definition expression segment = Algebra {
algebraKatrin :: [definition] -> katrin,
algebraDefinition :: Text -> expression -> definition,
algebraExpression :: [segment] -> expression,
algebraLiteral :: Int -> segment,
algebraValue :: Text -> segment,
algebraLambda :: Text -> expression -> segment,
algebraSubexpression :: expression -> segment
}
newtype Katrin = Katrin [Definition]
deriving (Show)
data Definition = Definition Text Expression
deriving (Show)
newtype Expression = Expression [Segment]
deriving (Show)
data Segment = Literal Int | Value Text | Lambda Text Expression | Subexpression Expression
deriving (Show)
-- Algebras
algebraTerm :: Algebra Katrin Definition Expression Segment
algebraTerm = Algebra Katrin Definition Expression Literal Value Lambda Subexpression
algebraKatrinCore :: Algebra Core.Expression (Text, Core.Expression) Core.Expression Core.Expression
algebraKatrinCore = Algebra {
algebraKatrin = \defs -> fromJust $ lookup "main" defs,
algebraDefinition = \name exp -> (name, exp),
algebraExpression = let
f [] = error "Segments may not be empty"
f (seg:[]) = seg
f (seg:segs) = Core.Application (f segs) seg
in \segs -> f $ reverse segs,
algebraLiteral = \num -> Core.Literal num,
algebraValue = \name -> Core.Value name,
algebraLambda = \name exp -> Core.Lambda name exp,
algebraSubexpression = \exp -> exp
}
-- Catamorphic fold functions
foldKatrin :: Algebra katrin definition expression segment -> Katrin -> katrin
foldKatrin alg@Algebra{..} (Katrin defs) = algebraKatrin (foldDefinition alg <$> defs)
foldDefinition :: Algebra katrin def exp seg -> Definition -> def
foldDefinition alg@Algebra{..} (Definition name exp) = algebraDefinition name (foldExpression alg exp)
foldExpression :: Algebra katrin definition expression segment -> Expression -> expression
foldExpression alg@Algebra{..} (Expression segs) = algebraExpression (foldSegment alg <$> segs)
foldSegment :: Algebra katrin definition expression segment -> Segment -> segment
foldSegment alg@Algebra{..} = \case
Literal num -> algebraLiteral num
Value txt -> algebraValue txt
Lambda txt exp -> algebraLambda txt (foldExpression alg exp)
Subexpression exp -> algebraSubexpression (foldExpression alg exp)
......@@ -44,15 +44,6 @@ data Expression =
data Result = Number Int | Function (Int -> Result)
-- Catamorphic fold functions
foldExpression :: Algebra expression -> Expression -> expression
foldExpression alg@Algebra{..} = \case
(Literal num) -> algebraLiteral num
(Value txt) -> algebraValue txt
(Application exp1 exp2) -> algebraApplication (foldExpression alg exp1) (foldExpression alg exp2)
(Lambda txt exp) -> algebraLambda txt (foldExpression alg exp)
-- Algebras
-- | Term algebra.
......@@ -77,16 +68,25 @@ algebraBeta = Algebra {
algebraLambda = \txt exp -> exp >>= (Right . Lambda txt)
}
-- | Algebra for evaluating an β-reduced expression.
-- | Algebra for evaluating an expression.
-- This only works if the expression is completely β-reduced down to a literal.
algebraEval :: Algebra (Either Text Int)
algebraEval = Algebra {
algebraLiteral = \num -> Right num,
algebraValue = \txt -> Left $ "Unresolved identifier " <> txt,
algebraApplication = \exp1' exp2' -> Left "Unapplied Application",
algebraLambda = \txt exp -> Left "Unapplied Lambda"
algebraApplication = \exp1' exp2' -> Left "Unapplied function application",
algebraLambda = \txt exp -> Left "Unapplied lambda"
}
-- Catamorphic fold functions
foldExpression :: Algebra expression -> Expression -> expression
foldExpression alg@Algebra{..} = \case
(Literal num) -> algebraLiteral num
(Value txt) -> algebraValue txt
(Application exp1 exp2) -> algebraApplication (foldExpression alg exp1) (foldExpression alg exp2)
(Lambda txt exp) -> algebraLambda txt (foldExpression alg exp)
-- Helper functions
-- | Replaces all values in an expression with fitting identifier with literal values
......
-- | Contains the parser for Katrin.
module Katrin.Parse where
import Katrin
import Katrin.AST
import Data.Text (Text)
import qualified Data.Text as T
import Data.Void
......
main = kek => ( succ 3 )
main = (x => succ (succ x)) 3
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment