Fix inference for empty ado blocks

This fixes inference by using `pure` for empty ado blocks; no other
change is required for the non-empty case as inference can be done
through `map` and `apply`

Author: purefunctor

compiler-bin/src/lsp/event.rs

@@ -128,6 +128,7 @@ fn lowered_error(context: &DiagnosticsContext<'_>, error: &LoweringError) -> Opt
                     match kind {
                         lowering::AdoFn::Map => Some("map"),
                         lowering::AdoFn::Apply => Some("apply"),
+                        lowering::AdoFn::Pure => Some("pure"),
                     },
                 ),
                 lowering::NotInScope::TermOperator { id } => {

compiler-core/checking/src/algorithm/term.rs

@@ -382,10 +382,11 @@ where
             infer_do(state, context, *bind, *discard, statements)
         }
 
-        lowering::ExpressionKind::Ado { map, apply, statements, expression } => {
+        lowering::ExpressionKind::Ado { map, apply, pure, statements, expression } => {
             let Some(map) = map else { return Ok(unknown) };
             let Some(apply) = apply else { return Ok(unknown) };
-            infer_ado(state, context, *map, *apply, statements, *expression)
+            let Some(pure) = pure else { return Ok(unknown) };
+            infer_ado(state, context, *map, *apply, *pure, statements, *expression)
         }
 
         lowering::ExpressionKind::Constructor { resolution } => {
@@ -658,6 +659,7 @@ fn infer_ado<Q>(
     context: &CheckContext<Q>,
     map: lowering::TermVariableResolution,
     apply: lowering::TermVariableResolution,
+    pure: lowering::TermVariableResolution,
     statements: &[lowering::DoStatement],
     expression: Option<lowering::ExpressionId>,
 ) -> QueryResult<TypeId>
@@ -666,6 +668,7 @@ where
 {
     let map_type = lookup_term_variable(state, context, map)?;
     let apply_type = lookup_term_variable(state, context, apply)?;
+    let pure_type = lookup_term_variable(state, context, pure)?;
 
     // First, perform a forward pass where variable bindings are
     // bound to unification variables and let bindings are checked.
@@ -698,7 +701,7 @@ where
 
     let [head_statement, tail_statements @ ..] = &ado_statements[..] else {
         return if let Some(expression) = expression {
-            infer_expression(state, context, expression)
+            check_function_term_application(state, context, pure_type, expression)
         } else {
             state.insert_error(ErrorKind::EmptyAdoBlock);
             Ok(context.prim.unknown)

compiler-core/lowering/src/algorithm/recursive.rs

@@ -313,6 +313,7 @@ fn lower_expression_kind(
 
             let map = state.resolve_term_full(context, qualifier.as_deref(), "map");
             let apply = state.resolve_term_full(context, qualifier.as_deref(), "apply");
+            let pure = state.resolve_term_full(context, qualifier.as_deref(), "pure");
 
             if map.is_none() {
                 let id = context.stabilized.lookup_cst(cst).expect_id();
@@ -328,6 +329,13 @@ fn lower_expression_kind(
                     .push(LoweringError::NotInScope(NotInScope::AdoFn { kind: AdoFn::Apply, id }));
             }
 
+            if pure.is_none() {
+                let id = context.stabilized.lookup_cst(cst).expect_id();
+                state
+                    .errors
+                    .push(LoweringError::NotInScope(NotInScope::AdoFn { kind: AdoFn::Pure, id }));
+            }
+
             let statements = recover! {
                 cst.statements()?
                     .children()
@@ -336,7 +344,7 @@ fn lower_expression_kind(
             };
             let expression = cst.expression().map(|cst| lower_expression(state, context, &cst));
 
-            ExpressionKind::Ado { map, apply, statements, expression }
+            ExpressionKind::Ado { map, apply, pure, statements, expression }
         }),
         cst::Expression::ExpressionConstructor(cst) => {
             let resolution = cst.name().and_then(|cst| {

compiler-core/lowering/src/error.rs

@@ -36,6 +36,7 @@ pub enum DoFn {
 pub enum AdoFn {
     Map,
     Apply,
+    Pure,
 }
 
 #[derive(Debug, PartialEq, Eq)]

compiler-core/lowering/src/intermediate.rs

@@ -118,6 +118,7 @@ pub enum ExpressionKind {
     Ado {
         map: Option<TermVariableResolution>,
         apply: Option<TermVariableResolution>,
+        pure: Option<TermVariableResolution>,
         statements: Arc<[DoStatement]>,
         expression: Option<ExpressionId>,
     },

tests-integration/fixtures/checking/051_ado_non_applicative/Main.purs

@@ -2,11 +2,11 @@ module Main where
 
 data Tuple a b = Tuple a b
 
-map :: forall a b. (a -> b) -> a -> b
-map f x = f x
+foreign import pure :: forall a b. a -> b
 
-apply :: forall a b. (a -> b) -> a -> b
-apply f x = f x
+foreign import map :: forall a b. (a -> b) -> a -> b
+
+foreign import apply :: forall a b. (a -> b) -> a -> b
 
 test :: Tuple Int String
 test = ado

tests-integration/fixtures/checking/051_ado_non_applicative/Main.snap

@@ -4,6 +4,7 @@ expression: report
 ---
 Terms
 Tuple :: forall (a :: Type) (b :: Type). a -> b -> Tuple a b
+pure :: forall (a :: Type) (b :: Type). a -> b
 map :: forall (a :: Type) (b :: Type). (a -> b) -> a -> b
 apply :: forall (a :: Type) (b :: Type). (a -> b) -> a -> b
 test :: Tuple Int String

tests-integration/fixtures/checking/052_ado_non_applicative_discard/Main.purs

@@ -1,10 +1,10 @@
 module Main where
 
-map :: forall a b. (a -> b) -> a -> b
-map f x = f x
+foreign import pure :: forall a b. a -> b
 
-apply :: forall a b. (a -> b) -> a -> b
-apply f x = f x
+foreign import map :: forall a b. (a -> b) -> a -> b
+
+foreign import apply :: forall a b. (a -> b) -> a -> b
 
 test :: Int
 test = ado

tests-integration/fixtures/checking/052_ado_non_applicative_discard/Main.snap

@@ -3,6 +3,7 @@ source: tests-integration/tests/checking/generated.rs
 expression: report
 ---
 Terms
+pure :: forall (a :: Type) (b :: Type). a -> b
 map :: forall (a :: Type) (b :: Type). (a -> b) -> a -> b
 apply :: forall (a :: Type) (b :: Type). (a -> b) -> a -> b
 test :: Int

tests-integration/fixtures/checking/116_empty_ado_block/Main.snap

@@ -7,7 +7,7 @@ pure :: forall (a :: Type). a -> Effect a
 map :: forall (a :: Type) (b :: Type). (a -> b) -> Effect a -> Effect b
 apply :: forall (a :: Type) (b :: Type). Effect (a -> b) -> Effect a -> Effect b
 test1 :: ???
-test2 :: Int
+test2 :: Effect Int
 
 Types
 Effect :: Type -> Type