67 lines
2.7 KiB
Haskell
67 lines
2.7 KiB
Haskell
|
module LambdaCalculus.Syntax.Base
|
||
|
|
( Expr (..), ExprF (..), Def, DefF (..), VoidF, Text, NonEmpty (..)
|
||
|
|
, Parse, AST, ASTF, NonEmptyDefFs (..)
|
||
|
|
, pattern LetFP
|
||
|
|
, simplify
|
||
|
|
) where
|
||
|
|
|
||
|
|
import LambdaCalculus.Expression.Base
|
||
|
|
|
||
|
|
import Data.Functor.Foldable (embed, project)
|
||
|
|
import Data.List.NonEmpty (NonEmpty (..))
|
||
|
|
|
||
|
|
data Parse
|
||
|
|
-- | The abstract syntax tree reflects the structure of the externally-visible syntax.
|
||
|
|
--
|
||
|
|
-- It includes syntactic sugar, which allows multiple ways to express many constructions,
|
||
|
|
-- e.g. multiple definitions in a single let expression or multiple names bound by one abstraction.
|
||
|
|
type AST = Expr Parse
|
||
|
|
-- There is no technical reason that the AST can't allow nullary applications and so forth,
|
||
|
|
-- nor is there any technical reason that the parser couldn't parse them,
|
||
|
|
-- but the parser *does* reject them to avoid confusing edge cases like `let x=in`,
|
||
|
|
-- so they're forbidden here too so that the syntax tree can't contain data
|
||
|
|
--
|
||
|
|
-- that the parser would refuse to accept.
|
||
|
|
-- As a matter of curiosity, here's why `let x=in` was syntactically valid:
|
||
|
|
-- 1. Parentheses in `let` statements are optional, infer them: `let x=()in()`.
|
||
|
|
-- 2. Insert optional whitespace: `let x = () in ()`.
|
||
|
|
-- 3. Nullary application expands to the identity function because
|
||
|
|
-- the identity function is the left identity of function application:
|
||
|
|
-- `let x=(\x.x) in \x.x`.
|
||
|
|
type instance AppArgs Parse = NonEmpty AST
|
||
|
|
type instance AbsArgs Parse = NonEmpty Text
|
||
|
|
type instance LetArgs Parse = NonEmpty (Def Parse)
|
||
|
|
type instance XExpr Parse = VoidF AST
|
||
|
|
|
||
|
|
type ASTF = ExprF Parse
|
||
|
|
type instance AppArgsF Parse = NonEmpty
|
||
|
|
type instance LetArgsF Parse = NonEmptyDefFs
|
||
|
|
type instance XExprF Parse = VoidF
|
||
|
|
|
||
|
|
instance RecursivePhase Parse where
|
||
|
|
projectLetArgs = NonEmptyDefFs
|
||
|
|
embedLetArgs = getNonEmptyDefFs
|
||
|
|
|
||
|
|
newtype NonEmptyDefFs r = NonEmptyDefFs { getNonEmptyDefFs :: NonEmpty (Text, r) }
|
||
|
|
deriving (Eq, Functor, Foldable, Traversable, Show)
|
||
|
|
|
||
|
|
pattern LetFP :: NonEmpty (Text, r) -> r -> ASTF r
|
||
|
|
pattern LetFP ds e = LetF (NonEmptyDefFs ds) e
|
||
|
|
|
||
|
|
{-# COMPLETE VarF, AppF, AbsF, LetFP, ExprXF #-}
|
||
|
|
|
||
|
|
-- | Combine nested expressions into compound expressions when possible.
|
||
|
|
simplify :: AST -> AST
|
||
|
|
simplify = simplify' . embed . fmap simplify' . project
|
||
|
|
where
|
||
|
|
simplify' (App (App f es1) es2) = simplify' $ App f (es1 <> es2)
|
||
|
|
simplify' (App (Abs (nx :| ns) eb) (ex :| es)) = simplify' $ app' es $ Let ((nx, ex) :| []) $ abs' ns eb
|
||
|
|
where app' [] e = e
|
||
|
|
app' (ex2:es2) e = App e (ex2 :| es2)
|
||
|
|
|
||
|
|
abs' [] e = e
|
||
|
|
abs' (nx2:ns2) e = Abs (nx2 :| ns2) e
|
||
|
|
simplify' (Abs ns1 (Abs ns2 e)) = simplify' $ Abs (ns1 <> ns2) e
|
||
|
|
simplify' (Let ds1 (Let ds2 e)) = simplify' $ Let (ds1 <> ds2) e
|
||
|
|
simplify' e = e
|