91dca53274
There is no reason for having `MonadIO` anymore. The `MonadLift` type
class is well behaved in the new frontend, the `MonadFinally` solves
the problem at monad stacks such as `ExcepT e IO`.
This commit also changes the type of the IO printing functions.
For example, the type of `IO.println` was
```
def IO.println {m} [MonadIO m] {α} [ToString α] (s : α) : m Unit
```
and now it is just
```
def IO.println {α} [ToString α] (s : α) : IO Unit
```
We rely on the new frontend auto-lifting feature.
That is, if there is an instance `[MonadLiftT IO m]`, then
a term of type `IO a` is automatically coerced to `m a`
We also want a simpler `IO.println` for writing tests.
For example,
```
```
doesn't work because there isn't sufficient information for inferring
the parameter `m` in the previous `IO.println`.
The shortest workaround looked very weird
```
```
I considered adding `IO` as a default value for `m` when we have
`MonadIO m`, as we use `Nat` as the default for `ofNat a`, but it felt
like uncessary complexity.
@Kha The commit seems to work well. The auto-lifting featuring has
been working great for me. There is still room for improvement.
For example, given `MonadLiftT m n`, it doesn't automatically lift
`a -> m b` into `a -> n b`. So, code such as
`foo >>= IO.println`
had to be rewritten as
`foo >>= fun x => IO.println x`
I will add this feature later.
If you have time, please try to play with this feature and figure out
if it is stable enough for making it the default.
That is, if it roboust enough, we can stop using the following idiom
for writing functions that can be lifted automatically.
```
def instantiateLevelMVarsImp (u : Level) : MetaM Level :=
...
def instantiateLevelMVars {m} [MonadLiftT MetaM m] (u : Level) : m Level :=
liftMetaM $ instantiateLevelMVarsImp u
```
I think we only need this idiom when using `MonadControlT` which is
not as common as `MonadLiftT`.
80 lines
2.1 KiB
Text
80 lines
2.1 KiB
Text
import Lean
|
|
|
|
open Lean
|
|
open Lean.Elab
|
|
|
|
def runCore (input : String) (failIff : Bool := true) : CoreM Unit := do
|
|
let env ← getEnv;
|
|
let opts ← getOptions;
|
|
let (env, messages) ← process input env opts;
|
|
messages.toList.forM fun msg => do IO.println (← msg.toString)
|
|
when (failIff && messages.hasErrors) $ throwError "errors have been found";
|
|
when (!failIff && !messages.hasErrors) $ throwError "there are no errors";
|
|
pure ()
|
|
|
|
open Lean.Parser
|
|
|
|
@[termParser] def tst := parser! "(|" >> termParser >> Parser.optional (symbol ", " >> termParser) >> "|)"
|
|
|
|
def tst2 : Parser := symbol "(||" >> termParser >> symbol "||)"
|
|
|
|
@[termParser] def boo : ParserDescr :=
|
|
ParserDescr.node `boo 10
|
|
(ParserDescr.binary `andthen
|
|
(ParserDescr.symbol "[|")
|
|
(ParserDescr.binary `andthen
|
|
(ParserDescr.cat `term 0)
|
|
(ParserDescr.symbol "|]")))
|
|
|
|
@[termParser] def boo2 : ParserDescr :=
|
|
ParserDescr.node `boo2 10 (ParserDescr.parser `tst2)
|
|
|
|
open Lean.Elab.Term
|
|
|
|
@[termElab tst] def elabTst : TermElab :=
|
|
adaptExpander $ fun stx => match_syntax stx with
|
|
| `((| $e |)) => pure e
|
|
| _ => throwUnsupportedSyntax
|
|
|
|
@[termElab boo] def elabBoo : TermElab :=
|
|
fun stx expected? =>
|
|
elabTerm (stx.getArg 1) expected?
|
|
|
|
@[termElab boo2] def elabBool2 : TermElab :=
|
|
adaptExpander $ fun stx => match_syntax stx with
|
|
| `((|| $e ||)) => `($e + 1)
|
|
| _ => throwUnsupportedSyntax
|
|
|
|
#eval runCore "#check [| @id.{1} Nat |]"
|
|
#eval runCore "#check (| id 1 |)"
|
|
#eval runCore "#check (|| id 1 ||)"
|
|
|
|
|
|
-- #eval run "#check (| id 1, id 1 |)" -- it will fail
|
|
|
|
@[termElab tst] def elabTst2 : TermElab :=
|
|
adaptExpander $ fun stx => match_syntax stx with
|
|
| `((| $e1, $e2 |)) => `(($e1, $e2))
|
|
| _ => throwUnsupportedSyntax
|
|
|
|
-- Now both work
|
|
|
|
#eval runCore "#check (| id 1 |)"
|
|
#eval runCore "#check (| id 1, id 2 |)"
|
|
|
|
declare_syntax_cat foo
|
|
|
|
syntax "⟨|" term "|⟩" : foo
|
|
syntax term : foo
|
|
syntax term ">>>" term : foo
|
|
|
|
syntax [tst3] "FOO " foo : term
|
|
|
|
macro_rules
|
|
| `(FOO ⟨| $t |⟩) => `($t+1)
|
|
| `(FOO $t:term) => `($t)
|
|
| `(FOO $t:term >>> $r) => `($t * $r)
|
|
|
|
#check FOO ⟨| id 1 |⟩
|
|
#check FOO 1
|
|
#check FOO 1 >>> 2
|