Name the language Ivo.

master
James T. Martin 2021-03-26 12:31:55 -07:00
parent ebf093525e
commit 960297e3b5
Signed by: james
GPG Key ID: 4B7F3DA9351E577C
18 changed files with 101 additions and 74 deletions

View File

@ -1,33 +1,59 @@
# Lambda Calculus # The Ivo Programming Language
This is a simple programming language derived from lambda calculus, Ivo (IPA: /aɪvoʊ/) is a programming language intended
using the Hindley-Milner type system, plus `letrec` and `callcc`. as a tool for its author to explore interesting programming language features.
## Usage Ivo is currently in a very early stage of development
Run the program using `stack run` (or run the tests with `stack test`). and most likely is not of any practical or academic interest;
however, that may change in the future.
This README serves to document the language as it currently stands,
not what the language one day hopes to be.
Type in your expression at the prompt: `>> `. ## Using the Ivo interpreter
Yourexpression will be evaluated to normal form using the call-by-value evaluation strategy and then printed. You may run the Ivo interpreter using `stack run`;
the interpreter does not take any arguments.
Type in your command, definition, or expression at the prompt: `>> `.
Expressions will be typechecked, evaluated using call-by-value, and then printed.
Exit the prompt with `Ctrl-d` (or equivalent). Exit the prompt with `Ctrl-d` (or equivalent).
## Commands ### Interpreter commands
Instead of entering an expression in the REPL, you may enter a command.
These commands are available: These commands are available:
* `:load <filename>`: Execute a program in the interpreter, importing all definitions.
* `:clear`: Clear all of your variable definitions. * `:clear`: Clear all of your variable definitions.
* `:load <filename>`:
Execute a file containing Ivo definitions and expressions in the interpreter.
Variables already defined in the interpreter will be defined in the file;
variables defined by the file will be defined in the interpreter.
The filename may contain spaces, but trailing whitespace will be trimmed.
* `:check <on/off> <always/decls/off>`: * `:check <on/off> <always/decls/off>`:
* If the first argument is `off`, then expressions will be evaluated even if they do not typecheck.
* If the second argument is `always`, inferred types will always be printed. * If the first argument is `on`,
If it is `decls`, then only declarations will have their inferred types printed. then expressions will only be evaluated and definitions will only be added
Otherwise, the type of expressions is never printed. only if typechecking succeeds.
* If the second argument is `always`, then inferred types will always be printed;
if it is `decls`, then only the inferred types of declarations will be printed;
otherwise, the type of expressions are never printed.'
* The default values are `on` `decls`. * The default values are `on` `decls`.
* `:trace <off/local/global>`: * `:trace <off/local/global>`:
* If the argument is `local`, intermediate expressions will be printed as the evaluator evaluates them.
* If the argument is `global`, the *entire* expression will be printed each evaluator step. * If the argument is `local`, intermediate expressions will be printed
as they are evaluated;
* If the argument is `global`, the *entire* expression will be printed
with each evaluation step.
* The default value is `off`. * The default value is `off`.
## Syntax ## The Ivo language
### Syntax
The parser's error messages currently are virtually useless, so be very careful with your syntax. The parser's error messages currently are virtually useless, so be very careful with your syntax.
* Variable names: any sequence of letters. * Variable names: any sequence of letters.
@ -55,7 +81,7 @@ 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 must separate your 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.
* Functions: `a -> b` (constructed by `\x. e`) * Functions: `a -> b` (constructed by `\x. e`)
@ -68,18 +94,19 @@ Types are checked/inferred using the Hindley-Milner type inference algorithm.
* Characters: `Char` (constructed by `Char`, which takes a `Nat`) * Characters: `Char` (constructed by `Char`, which takes a `Nat`)
* Universal quantification (forall): `∀a b. t` * Universal quantification (forall): `∀a b. t`
## Builtins ### Builtins
Builtins are variables that correspond with a built-in language feature 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.
* `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
with an argument named `!` which is used exactly once; with an argument named `!` which is used exactly once;
however, continuations are *not* the same as lambda abstractions however, continuations are *not* the same as lambda abstractions
because they perform the side effect of modifying the current continuation, because they perform the side effect of modifying the current continuation,
and this is *not* valid syntax you can input into the REPL. and this is *not* valid syntax you can enter into the REPL.
## Example code ### Example code
You can see some example code in `examples.lc`. You can see some example code in `examples/examples.ivo`.

View File

@ -1,6 +1,6 @@
module Main (main) where module Main (main) where
import LambdaCalculus import Ivo
import Control.Exception (IOException, catch) import Control.Exception (IOException, catch)
import Data.Maybe (isJust) import Data.Maybe (isJust)

View File

@ -1,13 +1,13 @@
name: jtm-lambda-calculus name: ivo
version: 0.1.0.0 version: 0.1.0.0
github: "jamestmartin/lambda-calculus" github: "ivolang/ivo"
license: GPL-3 license: GPL-3
author: "James Martin" author: "James Martin"
maintainer: "james@jtmar.me" maintainer: "james@jtmar.me"
copyright: "2019-2020 James Martin" copyright: "2019-2021 James Martin"
synopsis: "A simple implementation of the lambda calculus." synopsis: "A useless programming language for useless people."
category: LambdaCalculus category: Language
description: Please see the README on GitHub at <https://github.com/jamestmartin/lambda-calculus#readme> description: Please see the README on GitHub at <https://github.com/ivolang/ivo#readme>
extra-source-files: extra-source-files:
- README.md - README.md
@ -63,7 +63,7 @@ library:
- -Wno-missing-import-lists - -Wno-missing-import-lists
executables: executables:
jtm-lambda-calculus: ivo:
main: Main.hs main: Main.hs
source-dirs: app source-dirs: app
ghc-options: ghc-options:
@ -75,12 +75,12 @@ executables:
- -Wno-monomorphism-restriction - -Wno-monomorphism-restriction
- -Wno-unused-do-bind - -Wno-unused-do-bind
dependencies: dependencies:
- jtm-lambda-calculus - ivo
- exceptions >= 0.10.4 && < 0.11 - exceptions >= 0.10.4 && < 0.11
- haskeline >= 0.8 && < 1 - haskeline >= 0.8 && < 1
tests: tests:
jtm-lambda-calculus-test: ivo-test:
main: Spec.hs main: Spec.hs
source-dirs: test source-dirs: test
ghc-options: ghc-options:
@ -89,6 +89,6 @@ tests:
- -rtsopts - -rtsopts
- -with-rtsopts=-N - -with-rtsopts=-N
dependencies: dependencies:
- jtm-lambda-calculus - ivo
- tasty >= 1.2 && < 2 - tasty >= 1.2 && < 2
- tasty-hunit >= 0.10 && < 0.11 - tasty-hunit >= 0.10 && < 0.11

View File

@ -1,15 +1,15 @@
module LambdaCalculus module Ivo
( module LambdaCalculus.Evaluator ( module Ivo.Evaluator
, module LambdaCalculus.Expression , module Ivo.Expression
, module LambdaCalculus.Syntax , module Ivo.Syntax
, module LambdaCalculus.Types , module Ivo.Types
, parseCheck, parseEval, unparseCheck, unparseEval , parseCheck, parseEval, unparseCheck, unparseEval
) where ) where
import LambdaCalculus.Evaluator import Ivo.Evaluator
import LambdaCalculus.Expression import Ivo.Expression
import LambdaCalculus.Syntax import Ivo.Syntax
import LambdaCalculus.Types import Ivo.Types
parseCheck :: Text -> Either ParseError CheckExpr parseCheck :: Text -> Either ParseError CheckExpr
parseCheck = fmap ast2check . parseAST parseCheck = fmap ast2check . parseAST

View File

@ -1,4 +1,4 @@
module LambdaCalculus.Evaluator module Ivo.Evaluator
( Expr (..), Ctr (..), Pat, ExprF (..), PatF (..), VoidF, UnitF (..), Text ( Expr (..), Ctr (..), Pat, ExprF (..), PatF (..), VoidF, UnitF (..), Text
, Eval, EvalExpr, EvalX, EvalXF (..) , Eval, EvalExpr, EvalX, EvalXF (..)
, pattern AppFE, pattern CtrE, pattern CtrFE , pattern AppFE, pattern CtrE, pattern CtrFE
@ -6,8 +6,8 @@ module LambdaCalculus.Evaluator
, eval, evalTrace, evalTraceGlobal , eval, evalTrace, evalTraceGlobal
) where ) where
import LambdaCalculus.Evaluator.Base import Ivo.Evaluator.Base
import LambdaCalculus.Evaluator.Continuation import Ivo.Evaluator.Continuation
import Control.Monad.Except (MonadError, ExceptT, throwError, runExceptT) import Control.Monad.Except (MonadError, ExceptT, throwError, runExceptT)
import Control.Monad.Loops (iterateM_) import Control.Monad.Loops (iterateM_)

View File

@ -1,4 +1,4 @@
module LambdaCalculus.Evaluator.Base module Ivo.Evaluator.Base
( Identity (..) ( Identity (..)
, Expr (..), Ctr (..), Pat, ExprF (..), PatF (..), VoidF, UnitF (..), Text , Expr (..), Ctr (..), Pat, ExprF (..), PatF (..), VoidF, UnitF (..), Text
, substitute, substitute1, rename, rename1, free, bound, used , substitute, substitute1, rename, rename1, free, bound, used
@ -7,7 +7,7 @@ module LambdaCalculus.Evaluator.Base
, pattern ContE, pattern ContFE, pattern CallCCE, pattern CallCCFE , pattern ContE, pattern ContFE, pattern CallCCE, pattern CallCCFE
) where ) where
import LambdaCalculus.Expression.Base import Ivo.Expression.Base
import Control.Monad (forM) import Control.Monad (forM)
import Control.Monad.Reader (asks) import Control.Monad.Reader (asks)

View File

@ -1,9 +1,9 @@
module LambdaCalculus.Evaluator.Continuation module Ivo.Evaluator.Continuation
( Continuation, continue, continue1 ( Continuation, continue, continue1
, ContinuationCrumb (..) , ContinuationCrumb (..)
) where ) where
import LambdaCalculus.Evaluator.Base import Ivo.Evaluator.Base
import Data.List (foldl') import Data.List (foldl')

View File

@ -1,4 +1,4 @@
module LambdaCalculus.Expression module Ivo.Expression
( Expr (..), Ctr (..), Pat, ExprF (..), PatF (..), DefF (..), VoidF, UnitF (..), Text ( Expr (..), Ctr (..), Pat, ExprF (..), PatF (..), DefF (..), VoidF, UnitF (..), Text
, substitute, substitute1, rename, free, bound, used , substitute, substitute1, rename, free, bound, used
, Eval, EvalExpr, EvalX, EvalXF (..), Identity (..) , Eval, EvalExpr, EvalX, EvalXF (..), Identity (..)
@ -15,9 +15,9 @@ module LambdaCalculus.Expression
, builtins , builtins
) where ) where
import LambdaCalculus.Evaluator.Base import Ivo.Evaluator.Base
import LambdaCalculus.Syntax.Base import Ivo.Syntax.Base
import LambdaCalculus.Types.Base import Ivo.Types.Base
import Data.Functor.Foldable (cata, hoist) import Data.Functor.Foldable (cata, hoist)
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)

View File

@ -1,6 +1,6 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
module LambdaCalculus.Expression.Base module Ivo.Expression.Base
( Text, VoidF, UnitF (..), absurd' ( Text, VoidF, UnitF (..), absurd'
, Expr (..), Ctr (..), Pat, Def, AppArgs, AbsArgs, LetArgs, CtrArgs, XExpr , Expr (..), Ctr (..), Pat, Def, AppArgs, AbsArgs, LetArgs, CtrArgs, XExpr
, ExprF (..), PatF (..), DefF (..), AppArgsF, LetArgsF, CtrArgsF, XExprF , ExprF (..), PatF (..), DefF (..), AppArgsF, LetArgsF, CtrArgsF, XExprF

7
src/Ivo/Syntax.hs Normal file
View File

@ -0,0 +1,7 @@
module Ivo.Syntax
( module Ivo.Syntax.Parser
, module Ivo.Syntax.Printer
) where
import Ivo.Syntax.Parser
import Ivo.Syntax.Printer

View File

@ -1,4 +1,4 @@
module LambdaCalculus.Syntax.Base module Ivo.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 (..)
@ -8,7 +8,7 @@ module LambdaCalculus.Syntax.Base
, simplify , simplify
) where ) where
import LambdaCalculus.Expression.Base import Ivo.Expression.Base
import Data.Functor.Foldable (embed, project) import Data.Functor.Foldable (embed, project)
import Data.List.NonEmpty (NonEmpty (..), toList) import Data.List.NonEmpty (NonEmpty (..), toList)

View File

@ -1,11 +1,11 @@
module LambdaCalculus.Syntax.Parser module Ivo.Syntax.Parser
( ParseError, parse ( ParseError, parse
, DeclOrExprAST, ProgramAST , DeclOrExprAST, ProgramAST
, parseAST, parseDeclOrExpr, parseProgram , parseAST, parseDeclOrExpr, parseProgram
, astParser, declOrExprParser, programParser , astParser, declOrExprParser, programParser
) where ) where
import LambdaCalculus.Syntax.Base import Ivo.Syntax.Base
import Data.List.NonEmpty (fromList) import Data.List.NonEmpty (fromList)
import Data.Text qualified as T import Data.Text qualified as T

View File

@ -1,6 +1,6 @@
module LambdaCalculus.Syntax.Printer (unparseAST) where module Ivo.Syntax.Printer (unparseAST) where
import LambdaCalculus.Syntax.Base import Ivo.Syntax.Base
import Data.Functor.Base (NonEmptyF (NonEmptyF)) import Data.Functor.Base (NonEmptyF (NonEmptyF))
import Data.Functor.Foldable (cata) import Data.Functor.Foldable (cata)

View File

@ -1,9 +1,9 @@
module LambdaCalculus.Types module Ivo.Types
( module LambdaCalculus.Types.Base ( module Ivo.Types.Base
, infer , infer
) where ) where
import LambdaCalculus.Types.Base import Ivo.Types.Base
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Control.Monad (when) import Control.Monad (when)

View File

@ -1,5 +1,5 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module LambdaCalculus.Types.Base module Ivo.Types.Base
( Identity (..) ( Identity (..)
, Expr (..), Ctr (..), Pat, ExprF (..), PatF (..), VoidF, UnitF (..), Text , Expr (..), Ctr (..), Pat, ExprF (..), PatF (..), VoidF, UnitF (..), Text
, substitute, substitute1, rename, rename1, free, bound, used , substitute, substitute1, rename, rename1, free, bound, used
@ -24,7 +24,7 @@ import Data.HashMap.Strict qualified as HM
import Data.List (foldl1') import Data.List (foldl1')
import Data.Text qualified as T import Data.Text qualified as T
import Data.Traversable (for) import Data.Traversable (for)
import LambdaCalculus.Expression.Base import Ivo.Expression.Base
data Check data Check
type CheckExpr = Expr Check type CheckExpr = Expr Check

View File

@ -1,7 +0,0 @@
module LambdaCalculus.Syntax
( module LambdaCalculus.Syntax.Parser
, module LambdaCalculus.Syntax.Printer
) where
import LambdaCalculus.Syntax.Parser
import LambdaCalculus.Syntax.Printer

View File

@ -1,4 +1,4 @@
import LambdaCalculus import Ivo
import Test.Tasty import Test.Tasty
import Test.Tasty.HUnit import Test.Tasty.HUnit