Remove `letrec` in favor of allowing any `let` expression to be recursive.
parent
b337ecb094
commit
e49be205f2
GPG Key ID:
4B7F3DA9351E577C
|
|
@ -59,8 +59,8 @@ The parser's error messages currently are virtually useless, so be very careful
|
|||
* Function application: `f x y`
|
||||
* Lambda abstraction: `\x y z. E` or `λx y z. E`
|
||||
* 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`
|
||||
* The definitions of let expessions may be recursive:
|
||||
`let undefined = undefined in undefined`.
|
||||
* Parenthetical expressions: `(E)`
|
||||
* 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.
|
||||
|
|
@ -76,7 +76,7 @@ The parser's error messages currently are virtually useless, so be very careful
|
|||
* Comments: `// line comment`, `/* block comment */`
|
||||
|
||||
Top-level contexts (e.g. the REPL or a source code file)
|
||||
allow declarations (`let(rec) x = E` without multiple definitions `in ...`),
|
||||
allow declarations (`let x = E` without multiple definitions `in ...`),
|
||||
which make your definitions available for the rest of the program's execution.
|
||||
You must separate your declarations and expressions with `;`.
|
||||
|
||||
|
|
|
|||
|
|
@ -81,15 +81,15 @@ runProgram program = do
|
|||
runDeclOrExpr (Right (Var "main"))
|
||||
|
||||
loadFile :: ProgramAST -> AppM ()
|
||||
loadFile = mapM_ (\(name, ty, e) -> define name ty $ ast2check e)
|
||||
loadFile = mapM_ (\(name, ty, e) -> define name ty $ decl2check name e)
|
||||
|
||||
runTopLevel :: TopLevelAST -> AppM ()
|
||||
runTopLevel = mapM_ runDeclOrExpr
|
||||
|
||||
runDeclOrExpr :: Either Declaration AST -> AppM ()
|
||||
runDeclOrExpr (Left (name, ty, exprAST)) = do
|
||||
runDeclOrExpr (Left (name, ty, body)) = do
|
||||
defs <- gets definitions
|
||||
let expr = substitute defs $ ast2check exprAST
|
||||
let expr = substitute defs $ decl2check name body
|
||||
_ <- typecheckDecl ty name expr
|
||||
define name ty expr
|
||||
runDeclOrExpr (Right exprAST) = do
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#!/usr/bin/env -S ivo -c
|
||||
// Create a list by iterating `f` `n` times:
|
||||
letrec iterate = \f x.
|
||||
let iterate = \f x.
|
||||
{ Z -> []
|
||||
; S n -> (x :: iterate f (f x) n)
|
||||
};
|
||||
|
|
@ -11,13 +11,13 @@ let countToTen : [Nat] =
|
|||
in countTo 10;
|
||||
|
||||
// Append two lists together:
|
||||
letrec append = \xs ys.
|
||||
let append = \xs ys.
|
||||
{ [] -> ys
|
||||
; (x :: xs) -> (x :: append xs ys)
|
||||
} xs;
|
||||
|
||||
// Reverse a list:
|
||||
letrec reverse =
|
||||
let reverse =
|
||||
{ [] -> []
|
||||
; (x :: xs) -> append (reverse xs) [x]
|
||||
};
|
||||
|
|
@ -31,7 +31,7 @@ let threePlusTwo : Nat =
|
|||
; plus = \x. x Sf
|
||||
in plus (\f x. f (f (f x))) (\f x. f (f x)) S Z;
|
||||
|
||||
letrec undefined = undefined;
|
||||
let undefined = undefined;
|
||||
|
||||
// This expression would loop forever, but `callcc` saves the day!
|
||||
let callccSaves : Nat = S (callcc \k. undefined (k Z));
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
module Ivo.Expression
|
||||
( Expr (..), Ctr (..), Pat, ExprF (..), PatF (..), DefF (..), VoidF, UnitF (..), Text
|
||||
, Type (..), TypeF (..), Scheme (..), tapp
|
||||
, substitute, substitute1, rename, free, bound, used
|
||||
, substitute, substitute1, rename, free, freeIn, bound, used
|
||||
, Eval, EvalExpr, EvalX, EvalXF (..), Identity (..)
|
||||
, pattern AppFE, pattern CtrE, pattern CtrFE,
|
||||
pattern ContE, pattern ContFE, pattern CallCCE, pattern CallCCFE
|
||||
|
|
@ -11,7 +11,7 @@ module Ivo.Expression
|
|||
, Check, CheckExpr, CheckExprF, CheckX, CheckXF (..)
|
||||
, pattern AppFC, pattern CtrC, pattern CtrFC, pattern CallCCC, pattern CallCCFC
|
||||
, pattern FixC, pattern FixFC, pattern HoleC, pattern HoleFC
|
||||
, ast2check, ast2eval, check2eval, check2ast, eval2ast
|
||||
, ast2check, decl2check, ast2eval, check2eval, check2ast, eval2ast
|
||||
, builtins
|
||||
) where
|
||||
|
||||
|
|
@ -36,9 +36,18 @@ ast2check = substitute builtins . cata \case
|
|||
AppF ef exs -> foldl' App ef $ toList exs
|
||||
AbsF ns e -> foldr Abs e $ toList ns
|
||||
LetF ds e ->
|
||||
let letExpr name val body' = App (Abs name body') val
|
||||
let
|
||||
letExpr, letPlainExpr, letRecExpr
|
||||
:: Text -> CheckExpr -> CheckExpr -> CheckExpr
|
||||
-- | A let expression binding a non-recursive value.
|
||||
letPlainExpr name val body' = App (Abs name body') val
|
||||
-- | A let expression binding a recursive value.
|
||||
letRecExpr name val body' = letExpr name (App FixC $ Abs name val) body'
|
||||
-- | Choose whether or not the let expression needs to be recursive.
|
||||
letExpr name val body'
|
||||
| name `freeIn` val = letRecExpr name val body'
|
||||
| otherwise = letPlainExpr name val body'
|
||||
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
|
||||
CaseF ps -> Case ps
|
||||
AnnF () e t -> Ann () e t
|
||||
|
|
@ -55,6 +64,13 @@ ast2check = substitute builtins . cata \case
|
|||
mkList :: [CheckExpr] -> CheckExpr
|
||||
mkList = foldr (App . App (CtrC CCons)) (CtrC CNil)
|
||||
|
||||
-- | Convert from declaration abstract syntax to a typechecker expression.
|
||||
decl2check :: Text -> AST -> CheckExpr
|
||||
decl2check name ast
|
||||
| name `freeIn` ast = App FixC $ Abs name expr
|
||||
| otherwise = expr
|
||||
where expr = ast2check ast
|
||||
|
||||
-- | Convert from a typechecker expression to an evaluator expression.
|
||||
check2eval :: CheckExpr -> EvalExpr
|
||||
check2eval = cata \case
|
||||
|
|
|
|||
|
|
@ -8,9 +8,10 @@ module Ivo.Expression.Base
|
|||
, Type (..), TypeF (..), Scheme (..), tapp
|
||||
, RecursivePhase, projectAppArgs, projectLetArgs, projectCtrArgs, projectXExpr, projectDef
|
||||
, embedAppArgs, embedLetArgs, embedCtrArgs, embedXExpr, embedDef
|
||||
, Substitutable, free, bound, used, collectVars, rename, rename1
|
||||
, Substitutable, free, freeIn, bound, used, collectVars, rename, rename1
|
||||
, substitute, substitute1, unsafeSubstitute, unsafeSubstitute1
|
||||
, runRenamer, freshVar, replaceNames, runSubstituter, maySubstitute
|
||||
, compose, composeMap
|
||||
) where
|
||||
|
||||
import Control.Monad.Reader (MonadReader, Reader, runReader, asks, local)
|
||||
|
|
@ -307,6 +308,10 @@ class Substitutable e where
|
|||
free :: e -> HashSet Text
|
||||
free = collectVars HS.singleton HS.delete
|
||||
|
||||
-- | Is the given name a member of the expression's free variables?
|
||||
freeIn :: Text -> e -> Bool
|
||||
freeIn name = HS.member name . free
|
||||
|
||||
-- | Bound variables are variables which are abstracted over anywhere in an expression.
|
||||
bound :: e -> HashSet Text
|
||||
bound = collectVars (const HS.empty) HS.insert
|
||||
|
|
@ -430,11 +435,14 @@ maySubstitute :: ( MonadReader (HashMap Text b) m
|
|||
)
|
||||
=> t Text -> (a, m a) -> m a
|
||||
maySubstitute ns (unmodified, substituted) =
|
||||
local (compose $ fmap HM.delete ns) do
|
||||
local (composeMap HM.delete ns) do
|
||||
noMoreSubsts <- asks HM.null
|
||||
if noMoreSubsts
|
||||
then pure unmodified
|
||||
else substituted
|
||||
|
||||
compose :: Foldable t => t (a -> a) -> a -> a
|
||||
compose :: Foldable t => t (a -> a) -> (a -> a)
|
||||
compose = foldr (.) id
|
||||
|
||||
composeMap :: (Functor t, Foldable t) => (a -> (b -> b)) -> t a -> (b -> b)
|
||||
composeMap f = compose . fmap f
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
module Ivo.Syntax.Base
|
||||
( Expr (..), ExprF (..), Ctr (..), Pat, Def, DefF (..), PatF (..), VoidF, Text, NonEmpty (..)
|
||||
, Type (..), TypeF (..), Scheme (..), tapp
|
||||
, substitute, substitute1, rename, rename1, free, bound, used
|
||||
, substitute, substitute1, rename, rename1, free, freeIn, bound, used
|
||||
, Parse, AST, ASTF, ASTX, ASTXF (..), NonEmptyDefFs (..)
|
||||
, pattern LetFP, pattern LetRecP, pattern LetRecFP
|
||||
, pattern LetFP
|
||||
, pattern PNat, pattern PNatF, pattern PList, pattern PListF, pattern PChar, pattern PCharF
|
||||
, pattern PStr, pattern PStrF, pattern HoleP, pattern HoleFP
|
||||
, simplify
|
||||
|
|
@ -11,7 +11,8 @@ module Ivo.Syntax.Base
|
|||
|
||||
import Ivo.Expression.Base
|
||||
|
||||
import Data.Functor.Foldable (embed, project)
|
||||
import Data.Foldable (fold)
|
||||
import Data.Functor.Foldable (embed, project, cata)
|
||||
import Data.List.NonEmpty (NonEmpty (..), toList)
|
||||
import Data.Text qualified as T
|
||||
|
||||
|
|
@ -49,10 +50,8 @@ type instance CtrArgsF Parse = []
|
|||
type instance XExprF Parse = ASTXF
|
||||
|
||||
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`.
|
||||
| PNat_ Int
|
||||
= PNat_ Int
|
||||
-- | A list literal, e.g. `[x, y, z]`.
|
||||
| PList_ [r]
|
||||
-- | A character literal, e.g. `'a`.
|
||||
|
|
@ -73,12 +72,6 @@ newtype NonEmptyDefFs r = NonEmptyDefFs { getNonEmptyDefFs :: NonEmpty (Text, r)
|
|||
pattern LetFP :: NonEmpty (Text, r) -> r -> ASTF r
|
||||
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 n = ExprX (PNat_ n)
|
||||
|
||||
|
|
@ -110,11 +103,26 @@ pattern HoleFP :: ASTF r
|
|||
pattern HoleFP = ExprXF HoleP_
|
||||
|
||||
{-# COMPLETE VarF, AppF, AbsF, LetFP, CtrF, CaseF, AnnF, ExprXF #-}
|
||||
{-# COMPLETE Var, App, Abs, Let, Ctr, Case, Ann, LetRecP, PNat, PList, PChar, PStr, HoleP #-}
|
||||
{-# COMPLETE VarF, AppF, AbsF, LetF , CtrF, CaseF, AnnF, LetRecFP, PNatF, PListF, PCharF, PStrF, HoleFP #-}
|
||||
{-# COMPLETE VarF, AppF, AbsF, LetFP, CtrF, CaseF, AnnF, LetRecFP, PNatF, PListF, PCharF, PStrF, HoleFP #-}
|
||||
{-# COMPLETE Var, App, Abs, Let, Ctr, Case, Ann, PNat, PList, PChar, PStr, HoleP #-}
|
||||
{-# COMPLETE VarF, AppF, AbsF, LetF , CtrF, CaseF, AnnF, PNatF, PListF, PCharF, PStrF, HoleFP #-}
|
||||
{-# COMPLETE VarF, AppF, AbsF, LetFP, CtrF, CaseF, AnnF, PNatF, PListF, PCharF, PStrF, HoleFP #-}
|
||||
|
||||
-- TODO: Implement Substitutable for AST.
|
||||
instance Substitutable AST where
|
||||
collectVars withVar withBinder = cata \case
|
||||
VarF name -> withVar name
|
||||
AbsF names body -> compose (fmap withBinder names) body
|
||||
LetFP defs body ->
|
||||
composeMap (\(name, def) body' ->
|
||||
withBinder name def <> withBinder name body'
|
||||
) defs body
|
||||
CaseF pats -> foldMap (\(Pat _ ns e) -> foldr withBinder e ns) pats
|
||||
e -> fold e
|
||||
|
||||
-- TODO
|
||||
rename = error "rename not yet implemented for AST"
|
||||
|
||||
-- TODO
|
||||
unsafeSubstitute = error "unsafeSubstitute not yet implemented for AST"
|
||||
|
||||
-- | Combine nested expressions into compound expressions or literals when possible.
|
||||
simplify :: AST -> AST
|
||||
|
|
|
|||
|
|
@ -92,11 +92,9 @@ definition = label "definition" $ do
|
|||
pure (name, value)
|
||||
|
||||
let_ :: Parser AST
|
||||
let_ = label "let expression" $ letrecstar <|> letstar
|
||||
let_ = label "let expression" $
|
||||
Let <$> between (keyword "let") (keyword "in") definitions <*> ambiguous
|
||||
where
|
||||
letrecstar = LetRecP <$> between (try (keyword "letrec")) (keyword "in") definition <*> ambiguous
|
||||
letstar = Let <$> between (keyword "let") (keyword "in") definitions <*> ambiguous
|
||||
|
||||
definitions :: Parser (NonEmpty (Def Parse))
|
||||
definitions = fromList <$> sepBy1 definition (token ';')
|
||||
|
||||
|
|
@ -269,15 +267,9 @@ definitionAnn = do
|
|||
pure (name, ty, e)
|
||||
|
||||
declaration :: Parser Declaration
|
||||
declaration = notFollowedBy (try let_) >> (declrec <|> decl)
|
||||
where
|
||||
declrec = do
|
||||
try $ keyword "letrec"
|
||||
(name, ty, expr) <- definitionAnn
|
||||
pure (name, ty, LetRecP (name, expr) (Var name))
|
||||
decl = do
|
||||
keyword "let"
|
||||
definitionAnn
|
||||
declaration = notFollowedBy (try let_) >> do
|
||||
keyword "let"
|
||||
definitionAnn
|
||||
|
||||
-- | A program is a series of declarations and expressions to execute.
|
||||
type ProgramAST = [Declaration]
|
||||
|
|
|
|||
|
|
@ -58,7 +58,6 @@ unparseAST = toStrict . toLazyText . snd . cata \case
|
|||
let names' = fromLazyText (unwords $ map fromStrict $ toList names)
|
||||
in "λ" <> names' <> ". " <> unambiguous body
|
||||
LetFP defs body -> tag Block $ "let " <> unparseDefs defs <> " in " <> unambiguous body
|
||||
LetRecFP def body -> tag Block $ "letrec " <> unparseDef def <> " in " <> unambiguous body
|
||||
CtrF ctr e -> unparseCtr ctr e
|
||||
CaseF pats ->
|
||||
let pats' = fromLazyText $ intercalate "; " $ map (toLazyText . unparsePat) pats
|
||||
|
|
|
|||
Loading…
Reference in New Issue