Skip to content

Fix overly general typeclass in generated type annotations #133

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
dillonkearns wants to merge 1 commit into
base: main
Choose a base branch
from
+180 −12
Open

Fix overly general typeclass in generated type annotations #133

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
124 changes: 112 additions & 12 deletions src/Internal/Compiler.elm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1020,7 +1020,7 @@ resolve index cache annotation =
getRestrictions annotation cache
in
newAnnotation
|> rewriteTypeVariables
|> rewriteTypeVariables cache
|> checkRestrictions restrictions

Err err ->
Expand Down Expand Up @@ -1286,30 +1286,130 @@ getRestrictionsHelper existingRestrictions notation cache =
existingRestrictions


rewriteTypeVariables : Annotation.TypeAnnotation -> Annotation.TypeAnnotation
rewriteTypeVariables type_ =
{-| Rewrite type variable names to clean forms, preserving typeclass
constraint names.

When a constrained type variable (like `number_0`) gets resolved to
another generic variable (like `arg_0`), the constraint name is lost.
This function builds a mapping from resolved variable names back to
their constraint names, so `arg_0` gets renamed to `number` instead
of `a`.
-}
rewriteTypeVariables :
VariableCache
-> Annotation.TypeAnnotation
-> Annotation.TypeAnnotation
rewriteTypeVariables cache resolvedAnnotation =
let
-- Build a map from resolved generic names to constraint names.
-- Check BOTH directions:
-- 1. Forward: a constrained name (number_0) maps to a generic (arg_0)
-- 2. Reverse: a generic (arg_0) maps to a constrained name (comparable)
-- Case 2 happens with applyInfix operators that use fixed names
-- like "comparable" which then get unified with arg variables.
constraintOverrides : Dict String String
constraintOverrides =
Dict.foldl
(\key value acc ->
case value of
Annotation.GenericType resolvedName ->
let
keyRestriction =
nameToRestrictions key
in
case keyRestriction of
NoRestrictions ->
-- Key has no constraint, but maybe the
-- resolved name does (reverse direction)
let
resolvedRestriction =
nameToRestrictions resolvedName
in
case resolvedRestriction of
NoRestrictions ->
acc

_ ->
-- The target has a constraint — propagate
-- it to the key name
Dict.insert key
(restrictionToName resolvedRestriction)
acc

_ ->
-- Key has a constraint — propagate to resolved name
Dict.insert resolvedName
(restrictionToName keyRestriction)
acc

_ ->
acc
)
Dict.empty
cache

existing : Set String
existing =
getGenericsHelper type_
getGenericsHelper resolvedAnnotation
|> Set.fromList
in
Tuple.second (rewriteTypeVariablesHelper existing Dict.empty type_)
Tuple.second
(rewriteTypeVariablesHelper
constraintOverrides
existing
Dict.empty
resolvedAnnotation
)


restrictionToName : Restrictions -> String
restrictionToName restriction =
case restriction of
IsNumber ->
"number"

IsComparable ->
"comparable"

IsAppendable ->
"appendable"

IsAppendableComparable ->
"compappend"

rewriteTypeVariablesHelper : Set String -> Dict String String -> Annotation.TypeAnnotation -> ( Dict String String, Annotation.TypeAnnotation )
rewriteTypeVariablesHelper existing renames type_ =
_ ->
"a"


{-| Rewrite type variable names to clean, simplified forms.

The `overrides` dict maps variable names to constraint names
(e.g., "arg\_0" → "number") so that typeclass constraints are
preserved through the renaming process. Pass `Dict.empty` when
no constraint preservation is needed.
-}
rewriteTypeVariablesHelper :
Dict String String
-> Set String
-> Dict String String
-> Annotation.TypeAnnotation
-> ( Dict String String, Annotation.TypeAnnotation )
rewriteTypeVariablesHelper overrides existing renames type_ =
case type_ of
Annotation.GenericType varName ->
case Dict.get varName renames of
Nothing ->
let
simplified : String
simplified =
simplify varName
case Dict.get varName overrides of
Just constraintName ->
constraintName

Nothing ->
simplify varName
in
if Set.member simplified existing && varName /= simplified then
-- We would have collided with an existing generic name
( renames, Annotation.GenericType simplified )

else
Expand All @@ -1326,7 +1426,7 @@ rewriteTypeVariablesHelper existing renames type_ =
(\(Node _ typevar) ( varUsed, varList ) ->
let
( oneUsed, oneType ) =
rewriteTypeVariablesHelper existing varUsed typevar
rewriteTypeVariablesHelper overrides existing varUsed typevar
in
( oneUsed, nodify oneType :: varList )
)
Expand All @@ -1351,10 +1451,10 @@ rewriteTypeVariablesHelper existing renames type_ =
Annotation.FunctionTypeAnnotation (Node _ one) (Node _ two) ->
let
( oneUsed, oneType ) =
rewriteTypeVariablesHelper existing renames one
rewriteTypeVariablesHelper overrides existing renames one

( twoUsed, twoType ) =
rewriteTypeVariablesHelper existing oneUsed two
rewriteTypeVariablesHelper overrides existing oneUsed two
in
( twoUsed
, Annotation.FunctionTypeAnnotation
Expand Down
68 changes: 68 additions & 0 deletions tests/TypeChecking.elm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -271,6 +271,74 @@ generatedCode =
( 1 + 2, x )
"""
]
, describe "Typeclass constraints preserved in polymorphic annotations"
[ test "number constraint: polymorphic plus produces number annotation" <|
\_ ->
Elm.Declare.fn2 "addBoth"
(Arg.var "a")
(Arg.var "b")
(\a b -> Elm.Op.plus a b)
|> .declaration
|> Elm.Expect.declarationAs
"""
addBoth : number -> number -> number
addBoth a b =
a + b
"""
, test "comparable constraint: polymorphic compare produces comparable annotation" <|
\_ ->
Elm.Declare.fn2 "compareBoth"
(Arg.var "a")
(Arg.var "b")
(\a b -> Elm.Op.lt a b)
|> .declaration
|> Elm.Expect.declarationAs
"""
compareBoth : comparable -> comparable -> Bool
compareBoth a b =
a < b
"""
, test "appendable constraint: polymorphic append produces appendable annotation" <|
\_ ->
Elm.Declare.fn2 "appendBoth"
(Arg.var "a")
(Arg.var "b")
(\a b -> Elm.Op.append a b)
|> .declaration
|> Elm.Expect.declarationAs
"""
appendBoth : appendable -> appendable -> appendable
appendBoth a b =
a ++ b
"""
, test "number constraint narrows to Float via nested arithmetic" <|
-- Both polymorphic args flow through arithmetic with a
-- Float literal, so both narrow to Float.
\_ ->
Elm.Declare.fn2 "addToFloat"
(Arg.var "a")
(Arg.var "b")
(\a b -> Elm.Op.plus a (Elm.Op.plus b (Elm.float 1.0)))
|> .declaration
|> Elm.Expect.declarationAs
"""
addToFloat : Float -> Float -> Float
addToFloat a b =
a + (b + 1)
"""
, test "comparable used with concrete Char" <|
\_ ->
Elm.Declare.fn "isLessThanZ"
(Arg.var "c")
(\c -> Elm.Op.lt c (Elm.char 'z'))
|> .declaration
|> Elm.Expect.declarationAs
"""
isLessThanZ : Char.Char -> Bool
isLessThanZ c =
c < 'z'
"""
]
, test "Triple with mixed Float and Int infers correct types" <|
\_ ->
Elm.declaration "myTriple"
Expand Down
Loading