Skip to content

Commit

Permalink
Get letrec bindings working in functions
Browse files Browse the repository at this point in the history
  • Loading branch information
ChrisPenner committed Jun 14, 2024
1 parent 21e4959 commit 50382b8
Showing 1 changed file with 7 additions and 3 deletions.
10 changes: 7 additions & 3 deletions parser-typechecker/src/Unison/Typechecker/Context.hs
Original file line number Diff line number Diff line change
Expand Up @@ -105,6 +105,7 @@ import Unison.Typechecker.TypeLookup qualified as TL
import Unison.Typechecker.TypeVar qualified as TypeVar
import Unison.Var (Var)
import Unison.Var qualified as Var
import qualified Unison.Debug as Debug

type TypeVar v loc = TypeVar.TypeVar (B.Blank loc) v

Expand Down Expand Up @@ -1922,6 +1923,8 @@ annotateLetRecBindings span isTop letrec =
gen bindingType _arity = generalizeExistentials ctx2 bindingType
bindingTypesGeneralized = zipWith gen bindingTypes bindingArities
annotations = zipWith Ann vs bindingTypesGeneralized
-- for_ (zip3 vs bindings bindingTypesGeneralized) \(v, b, t) -> do
-- noteBinding v (loc b) (TypeVar.lowerType t)
appendContext annotations
pure (body, vs `zip` bindingTypesGeneralized)

Expand Down Expand Up @@ -2460,7 +2463,7 @@ checkWanted want (Term.Lam' body) (Type.Arrow'' i es o) = do
body <- pure $ ABT.bindInheritAnnotation body (Term.var () x)
checkWithAbilities es body o
pure want
checkWanted want (Term.Let1Top' top binding m) t = do
checkWanted want abt@(Term.Let1Top' top binding m) t = do
(tbinding, wbinding) <- synthesizeBinding top binding
want <- coalesceWanted wbinding want
v <- ABT.freshen m freshenVar
Expand All @@ -2469,14 +2472,15 @@ checkWanted want (Term.Let1Top' top binding m) t = do
-- enforce that actions in a block have type ()
subtype tbinding (DDB.unitType (ABT.annotation binding))
extendContext (Ann v tbinding)
-- Need to somehow fix the annotation on these
Debug.debugM Debug.Temp "checkWanted" $ (v, binding)
noteBinding v (ABT.annotation abt) (TypeVar.lowerType tbinding)
checkWanted want (ABT.bindInheritAnnotation m (Term.var () v)) t
checkWanted want (Term.LetRecNamed' [] m) t =
checkWanted want m t
-- letrec can't have effects, so it doesn't extend the wanted set
checkWanted want abt@(Term.LetRecTop' isTop lr) t =
markThenRetractWanted (Var.named "let-rec-marker") $ do
-- TODO: I don't think we want to emit types for local bindings from here, but will need
-- to refactor to do that properly
e <- annotateLetRecBindings (ABT.annotation abt) isTop lr
checkWanted want e t
checkWanted want e@(Term.Match' scrut cases) t = do
Expand Down

0 comments on commit 50382b8

Please sign in to comment.