diff --git a/README.md b/README.md index e7e2d91..fdb689d 100644 --- a/README.md +++ b/README.md @@ -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 `;`. diff --git a/app/Main.hs b/app/Main.hs index c9f687c..01fb743 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/examples/examples.ivo b/examples/examples.ivo index c809d61..72994ab 100755 --- a/examples/examples.ivo +++ b/examples/examples.ivo @@ -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)); diff --git a/src/Ivo/Expression.hs b/src/Ivo/Expression.hs index f924cc7..a768da4 100644 --- a/src/Ivo/Expression.hs +++ b/src/Ivo/Expression.hs @@ -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 diff --git a/src/Ivo/Expression/Base.hs b/src/Ivo/Expression/Base.hs index 148db23..00235f4 100644 --- a/src/Ivo/Expression/Base.hs +++ b/src/Ivo/Expression/Base.hs @@ -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 diff --git a/src/Ivo/Syntax/Base.hs b/src/Ivo/Syntax/Base.hs index b5f0198..4444088 100644 --- a/src/Ivo/Syntax/Base.hs +++ b/src/Ivo/Syntax/Base.hs @@ -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 diff --git a/src/Ivo/Syntax/Parser.hs b/src/Ivo/Syntax/Parser.hs index 1d21c15..9591131 100644 --- a/src/Ivo/Syntax/Parser.hs +++ b/src/Ivo/Syntax/Parser.hs @@ -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] diff --git a/src/Ivo/Syntax/Printer.hs b/src/Ivo/Syntax/Printer.hs index 3cb3b91..2c47cfe 100644 --- a/src/Ivo/Syntax/Printer.hs +++ b/src/Ivo/Syntax/Printer.hs @@ -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