Replace `fix` builtin with `letrec` syntax.

master
James T. Martin 2021-03-22 17:34:51 -07:00
parent 036c48a902
commit ebf093525e
Signed by: james
GPG Key ID: 4B7F3DA9351E577C
8 changed files with 74 additions and 33 deletions

View File

@ -1,6 +1,6 @@
# Lambda Calculus # Lambda Calculus
This is a simple programming language derived from lambda calculus, This is a simple programming language derived from lambda calculus,
using the Hindley-Milner type system, plus some builtin types, `fix`, and `callcc` using the Hindley-Milner type system, plus `letrec` and `callcc`.
## Usage ## Usage
Run the program using `stack run` (or run the tests with `stack test`). Run the program using `stack run` (or run the tests with `stack test`).
@ -34,11 +34,13 @@ The parser's error messages currently are virtually useless, so be very careful
* Function application: `f x y` * Function application: `f x y`
* Lambda abstraction: `\x y z. E` or `λx y z. E` * Lambda abstraction: `\x y z. E` or `λx y z. E`
* Let expressions: `let x = E; y = F in G` * Let expressions: `let x = E; y = F in G`
* Or letrec expressions, which can only define variable,
but which can be self-referential: `letrec x = ... x ... in E`
* Parenthetical expressions: `(E)` * Parenthetical expressions: `(E)`
* Constructors: `()`, `(x, y)` (or `(,) x y`), `Left x`, `Right y`, `Z`, `S`, `[]`, `(x :: xs)` (or `(:) x xs`), `Char n`. * Constructors: `()`, `(x, y)` (or `(,) x y`), `Left x`, `Right y`, `Z`, `S`, `[]`, `(x :: xs)` (or `(:) x xs`), `Char n`.
* The parentheses around the cons constructor are not optional. * The parentheses around the cons constructor are not optional.
* `Char` takes a natural number and turns it into a character. * `Char` takes a natural number and turns it into a character.
* Pattern matchers: `case { Left a -> e ; Right y -> f }` * Pattern matchers: `{ Left a -> e ; Right y -> f }`
* Pattern matchers can be applied like functions, e.g. `{ Z -> x, S -> y } 10` reduces to `y`. * Pattern matchers can be applied like functions, e.g. `{ Z -> x, S -> y } 10` reduces to `y`.
* Patterns must use the regular form of the constructor, e.g. `(x :: xs)` and not `((::) x xs)`. * Patterns must use the regular form of the constructor, e.g. `(x :: xs)` and not `((::) x xs)`.
* There are no nested patterns or default patterns. * There are no nested patterns or default patterns.
@ -49,9 +51,9 @@ The parser's error messages currently are virtually useless, so be very careful
* Comments: `// line comment`, `/* block comment */` * Comments: `// line comment`, `/* block comment */`
Top-level contexts (e.g. the REPL or a source code file) Top-level contexts (e.g. the REPL or a source code file)
allow declarations (`let` expressions without `in ...`), allow declarations (`let(rec) x = E` without multiple definitions `in ...`),
which make your definitions available for the rest of the program's execution. which make your definitions available for the rest of the program's execution.
You may separate multiple declarations and expressions with `;`. You must separate your declarations and expressions with `;`.
## Types ## Types
Types are checked/inferred using the Hindley-Milner type inference algorithm. Types are checked/inferred using the Hindley-Milner type inference algorithm.
@ -71,7 +73,6 @@ Builtins are variables that correspond with a built-in language feature
that cannot be replicated by user-written code. that cannot be replicated by user-written code.
They still are just variables though; they do not receive special syntactic treatment. They still are just variables though; they do not receive special syntactic treatment.
* `fix : ∀a. ((a -> a) -> a)`: an alias for the strict fixpoint combinator that the typechecker can typecheck.
* `callcc : ∀a b. (((a -> b) -> a) -> a)`: [the call-with-current-continuation control flow operator](https://en.wikipedia.org/wiki/Call-with-current-continuation). * `callcc : ∀a b. (((a -> b) -> a) -> a)`: [the call-with-current-continuation control flow operator](https://en.wikipedia.org/wiki/Call-with-current-continuation).
Continuations are printed as `λ!. ... ! ...`, like a lambda abstraction Continuations are printed as `λ!. ... ! ...`, like a lambda abstraction

View File

@ -1,4 +1,3 @@
{-# OPTIONS_GHC -Wno-unused-do-bind -Wno-monomorphism-restriction #-}
module Main (main) where module Main (main) where
import LambdaCalculus import LambdaCalculus
@ -107,7 +106,9 @@ commandParser = do
load = Load <$> do load = Load <$> do
try $ string "load " try $ string "load "
spaces spaces
many1 anyChar filename <- many1 (noneOf " ")
spaces
pure filename
clear = Clear <$ try (string "clear") clear = Clear <$ try (string "clear")

View File

@ -1,26 +1,44 @@
// Create a list by iterating `f` `n` times: // Create a list by iterating `f` `n` times:
let iterate = fix \iterate f x. { Z -> [] ; S n -> (x :: iterate f (f x) n) }; letrec iterate = \f x.
{ Z -> []
; S n -> (x :: iterate f (f x) n)
};
// Use the iterate function to count to 10: // Use the iterate function to count to 10:
let countTo = iterate S 1 in countTo 10; let countTo = iterate S 1
in countTo 10;
// Append two lists together: // Append two lists together:
let append = fix \append xs ys. { [] -> ys ; (x :: xs) -> (x :: append xs ys) } xs; letrec append = \xs ys.
{ [] -> ys
; (x :: xs) -> (x :: append xs ys)
} xs;
// Reverse a list: // Reverse a list:
let reverse = fix \reverse. { [] -> [] ; (x :: xs) -> append (reverse xs) [x] }; letrec reverse =
{ [] -> []
; (x :: xs) -> append (reverse xs) [x]
};
// Now we can reverse `"reverse"`: // Now we can reverse `"reverse"`:
reverse "reverse"; reverse "reverse";
// Calculating `3 + 2` with the help of Church-encoded numerals: // Calculating `3 + 2` with the help of Church-encoded numerals:
let Sf = \n f x. f (n f x); plus = \x. x Sf in plus (\f x. f (f (f x))) (\f x. f (f x)) S Z; let Sf = \n f x. f (n f x)
; plus = \x. x Sf
in plus (\f x. f (f (f x))) (\f x. f (f x)) S Z;
letrec undefined = undefined;
// This expression would loop forever, but `callcc` saves the day! // This expression would loop forever, but `callcc` saves the day!
S (callcc \k. (fix \x. x) (k Z)); S (callcc \k. undefined (k Z));
// And if it wasn't clear, this is what the `Char` constructor does: // And if it wasn't clear, this is what the `Char` constructor does:
{ Char c -> Char (S c) } 'a; { Char c -> Char (S c) } 'a;
// (it outputs `'b`) // (it outputs `'b`)
// Here are a few expressions which don't typecheck but are handy for debugging the evaluator: // Here are a few expressions which don't typecheck but are handy for debugging the evaluator
// (you can run them using `:check off off`:
/* /*
let D = \x. x x; F = \f. f (f y) in D (F \x. x); let D = \x. x x; F = \f. f (f y) in D (F \x. x);
// y y // y y

View File

@ -71,6 +71,9 @@ executables:
- -threaded - -threaded
- -rtsopts - -rtsopts
- -with-rtsopts=-N - -with-rtsopts=-N
- -Wno-missing-export-lists
- -Wno-monomorphism-restriction
- -Wno-unused-do-bind
dependencies: dependencies:
- jtm-lambda-calculus - jtm-lambda-calculus
- exceptions >= 0.10.4 && < 0.11 - exceptions >= 0.10.4 && < 0.11

View File

@ -27,7 +27,7 @@ import Data.List.NonEmpty (toList)
import Data.Text (unpack) import Data.Text (unpack)
builtins :: HashMap Text CheckExpr builtins :: HashMap Text CheckExpr
builtins = HM.fromList [("callcc", CallCCC), ("fix", FixC)] builtins = HM.fromList [("callcc", CallCCC)]
-- | Convert from an abstract syntax tree to a typechecker expression. -- | Convert from an abstract syntax tree to a typechecker expression.
ast2check :: AST -> CheckExpr ast2check :: AST -> CheckExpr
@ -38,6 +38,7 @@ ast2check = substitute builtins . cata \case
LetF ds e -> LetF ds e ->
let letExpr name val body' = App (Abs name body') val let letExpr name val body' = App (Abs name body') val
in foldr (uncurry letExpr) e $ getNonEmptyDefFs ds in foldr (uncurry letExpr) e $ getNonEmptyDefFs ds
LetRecFP (nx, ex) e -> App (Abs nx e) (App FixC (Abs nx ex))
CtrF ctr es -> foldl' App (CtrC ctr) es CtrF ctr es -> foldl' App (CtrC ctr) es
CaseF ps -> Case ps CaseF ps -> Case ps
PNatF n -> int2ast n PNatF n -> int2ast n

View File

@ -2,8 +2,9 @@ module LambdaCalculus.Syntax.Base
( Expr (..), ExprF (..), Ctr (..), Pat, Def, DefF (..), PatF (..), VoidF, Text, NonEmpty (..) ( Expr (..), ExprF (..), Ctr (..), Pat, Def, DefF (..), PatF (..), VoidF, Text, NonEmpty (..)
, substitute, substitute1, rename, rename1, free, bound, used , substitute, substitute1, rename, rename1, free, bound, used
, Parse, AST, ASTF, ASTX, ASTXF (..), NonEmptyDefFs (..) , Parse, AST, ASTF, ASTX, ASTXF (..), NonEmptyDefFs (..)
, pattern LetFP, pattern PNat, pattern PNatF, pattern PList, pattern PListF , pattern LetFP, pattern LetRecP, pattern LetRecFP
, pattern PChar, pattern PCharF, pattern PStr, pattern PStrF, pattern HoleP, pattern HoleFP , pattern PNat, pattern PNatF, pattern PList, pattern PListF, pattern PChar, pattern PCharF
, pattern PStr, pattern PStrF, pattern HoleP, pattern HoleFP
, simplify , simplify
) where ) where
@ -46,8 +47,10 @@ type instance CtrArgsF Parse = []
type instance XExprF Parse = ASTXF type instance XExprF Parse = ASTXF
data ASTXF r data ASTXF r
-- | A let expression where the definitions may reference each other recursively.
= LetRecP_ !(Text, r) !r
-- | A natural number literal, e.g. `10`. -- | A natural number literal, e.g. `10`.
= PNat_ Int | PNat_ Int
-- | A list literal, e.g. `[x, y, z]`. -- | A list literal, e.g. `[x, y, z]`.
| PList_ [r] | PList_ [r]
-- | A character literal, e.g. `'a`. -- | A character literal, e.g. `'a`.
@ -68,6 +71,12 @@ newtype NonEmptyDefFs r = NonEmptyDefFs { getNonEmptyDefFs :: NonEmpty (Text, r)
pattern LetFP :: NonEmpty (Text, r) -> r -> ASTF r pattern LetFP :: NonEmpty (Text, r) -> r -> ASTF r
pattern LetFP ds e = LetF (NonEmptyDefFs ds) e pattern LetFP ds e = LetF (NonEmptyDefFs ds) e
pattern LetRecP :: (Text, AST) -> AST -> AST
pattern LetRecP d e = ExprX (LetRecP_ d e)
pattern LetRecFP :: (Text, r) -> r -> ASTF r
pattern LetRecFP d e = ExprXF (LetRecP_ d e)
pattern PNat :: Int -> AST pattern PNat :: Int -> AST
pattern PNat n = ExprX (PNat_ n) pattern PNat n = ExprX (PNat_ n)
@ -99,9 +108,9 @@ pattern HoleFP :: ASTF r
pattern HoleFP = ExprXF HoleP_ pattern HoleFP = ExprXF HoleP_
{-# COMPLETE VarF, AppF, AbsF, LetFP, CtrF, CaseF, ExprXF #-} {-# COMPLETE VarF, AppF, AbsF, LetFP, CtrF, CaseF, ExprXF #-}
{-# COMPLETE Var, App, Abs, Let, Ctr, Case, PNat, PList, PChar, PStr, HoleP #-} {-# COMPLETE Var, App, Abs, Let, Ctr, Case, LetRecP, PNat, PList, PChar, PStr, HoleP #-}
{-# COMPLETE VarF, AppF, AbsF, LetF , CtrF, CaseF, PNatF, PListF, PCharF, PStrF, HoleFP #-} {-# COMPLETE VarF, AppF, AbsF, LetF , CtrF, CaseF, LetRecFP, PNatF, PListF, PCharF, PStrF, HoleFP #-}
{-# COMPLETE VarF, AppF, AbsF, LetFP, CtrF, CaseF, PNatF, PListF, PCharF, PStrF, HoleFP #-} {-# COMPLETE VarF, AppF, AbsF, LetFP, CtrF, CaseF, LetRecFP, PNatF, PListF, PCharF, PStrF, HoleFP #-}
-- TODO: Implement Substitutable for AST. -- TODO: Implement Substitutable for AST.

View File

@ -80,10 +80,13 @@ definition = do
pure (name, value) pure (name, value)
let_ :: Parser AST let_ :: Parser AST
let_ = Let <$> between (keyword "let") (keyword "in") (fromList <$> definitions) <*> ambiguous let_ = letrecstar <|> letstar
where where
definitions :: Parser [Def Parse] letrecstar = LetRecP <$> between (try (keyword "letrec")) (keyword "in") definition <*> ambiguous
definitions = sepBy1 definition (token ';') letstar = Let <$> between (keyword "let") (keyword "in") definitions <*> ambiguous
definitions :: Parser (NonEmpty (Def Parse))
definitions = fromList <$> sepBy1 definition (token ';')
ctr :: Parser AST ctr :: Parser AST
ctr = pair <|> unit <|> either <|> nat <|> list <|> str ctr = pair <|> unit <|> either <|> nat <|> list <|> str
@ -187,10 +190,15 @@ parseAST = parse (spaces *> ambiguous <* eof) "input"
type Declaration = (Text, AST) type Declaration = (Text, AST)
declaration :: Parser Declaration declaration :: Parser Declaration
declaration = do declaration = notFollowedBy (try let_) >> (declrec <|> decl)
notFollowedBy (try let_) where
keyword "let" declrec = do
definition try $ keyword "letrec"
(name, expr) <- definition
pure (name, LetRecP (name, expr) (Var name))
decl = do
keyword "let"
definition
-- | A program is a series of declarations and expressions to execute. -- | A program is a series of declarations and expressions to execute.
type ProgramAST = [DeclOrExprAST] type ProgramAST = [DeclOrExprAST]

View File

@ -56,11 +56,8 @@ unparseAST = toStrict . toLazyText . snd . cata \case
AbsF names body -> tag Block $ AbsF names body -> tag Block $
let names' = fromLazyText (unwords $ map fromStrict $ toList names) let names' = fromLazyText (unwords $ map fromStrict $ toList names)
in "λ" <> names' <> ". " <> unambiguous body in "λ" <> names' <> ". " <> unambiguous body
LetFP defs body -> tag Block $ LetFP defs body -> tag Block $ "let " <> unparseDefs defs <> " in " <> unambiguous body
let LetRecFP def body -> tag Block $ "letrec " <> unparseDef def <> " in " <> unambiguous body
unparseDef (name, val) = fromText name <> " = " <> unambiguous val
defs' = fromLazyText (intercalate "; " $ map (toLazyText . unparseDef) $ toList defs)
in "let " <> defs' <> " in " <> unambiguous body
CtrF ctr e -> unparseCtr ctr e CtrF ctr e -> unparseCtr ctr e
CaseF pats -> CaseF pats ->
let pats' = fromLazyText $ intercalate "; " $ map (toLazyText . unparsePat) pats let pats' = fromLazyText $ intercalate "; " $ map (toLazyText . unparsePat) pats
@ -77,6 +74,9 @@ unparseAST = toStrict . toLazyText . snd . cata \case
unparseApp ef (unsnoc -> (exs, efinal)) unparseApp ef (unsnoc -> (exs, efinal))
= tag Ambiguous $ foldr (\e es' -> ambiguous e <> " " <> es') (final efinal) (ef : exs) = tag Ambiguous $ foldr (\e es' -> ambiguous e <> " " <> es') (final efinal) (ef : exs)
unparseDef (name, val) = fromText name <> " = " <> unambiguous val
unparseDefs defs = fromLazyText (intercalate "; " $ map (toLazyText . unparseDef) $ toList defs)
unparseCtr :: Ctr -> [Tagged Builder] -> Tagged Builder unparseCtr :: Ctr -> [Tagged Builder] -> Tagged Builder
-- Fully-applied special syntax forms -- Fully-applied special syntax forms
unparseCtr CPair [x, y] = tag Finite $ "(" <> unambiguous x <> ", " <> unambiguous y <> ")" unparseCtr CPair [x, y] = tag Finite $ "(" <> unambiguous x <> ", " <> unambiguous y <> ")"