Play

Check-in [63296cf7f2]
Login
Overview
Comment:Make use of type annotations when type checking words. This allows for a workaround with stack ranges and generic types.
Timelines: family | ancestors | descendants | both | bugfix-generics-and-quotations
Files: files | file ages | folders
SHA3-256: 63296cf7f240aead4e788c2377a5b50c4c8df221089f7883024660fe9db0411b
User & Date: robin.hansen on 2020-11-19 05:53:00
Other Links: branch diff | manifest | tags
Context
2020-11-19
05:56
Make sure code use to reproduce bug works as expected. Closed-Leaf check-in: af3cd0eeff user: robin.hansen tags: bugfix-generics-and-quotations
05:53
Make use of type annotations when type checking words. This allows for a workaround with stack range... check-in: 63296cf7f2 user: robin.hansen tags: bugfix-generics-and-quotations
2020-11-17
14:42
Add test for compilation failure found in playground. check-in: d4ac6cbece user: robin.hansen tags: bugfix-generics-and-quotations
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified src/Play/Data/Type.elm from [80b184fda8] to [7b6e93ee1b].

1
2
3
4

5
6
7
8
9
10
11
..
25
26
27
28
29
30
31







32
33
34
35
36
37
38
module Play.Data.Type exposing
    ( Type(..)
    , WordType
    , compatibleWords

    , genericName
    , genericlyCompatible
    , isGeneric
    , referencedGenerics
    , toDisplayString
    , wordTypeToString
    )
................................................................................


type alias WordType =
    { input : List Type
    , output : List Type
    }









isGeneric : Type -> Bool
isGeneric t =
    case t of
        Generic _ ->
            True





>







 







>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
..
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
module Play.Data.Type exposing
    ( Type(..)
    , WordType
    , compatibleWords
    , emptyWordType
    , genericName
    , genericlyCompatible
    , isGeneric
    , referencedGenerics
    , toDisplayString
    , wordTypeToString
    )
................................................................................


type alias WordType =
    { input : List Type
    , output : List Type
    }


emptyWordType : WordType
emptyWordType =
    { input = []
    , output = []
    }


isGeneric : Type -> Bool
isGeneric t =
    case t of
        Generic _ ->
            True

Modified src/Play/TypeChecker.elm from [6269134213] to [fec5dbde4e].

219
220
221
222
223
224
225











226
227
228
229
230
231
232
233
234



235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
...
667
668
669
670
671
672
673












674

675


676
677
678
679
680
681
682
683
684






685
686

687
688
689
690
691
692
693
    Context
    -> Qualifier.WordDefinition
    -> List ( Qualifier.TypeMatch, List Qualifier.Node )
    -> List Qualifier.Node
    -> Context
typeCheckMultiImplementation context untypedDef initialWhens defaultImpl =
    let











        whens =
            case defaultImpl of
                [] ->
                    initialWhens

                _ ->
                    let
                        ( inferredDefaultType, _ ) =
                            typeCheckImplementation untypedDef defaultImpl (cleanContext context)



                    in
                    case inferredDefaultType.input of
                        [] ->
                            Debug.todo "Default impl doesn't have an input argument"

                        firstType :: _ ->
                            ( Qualifier.TypeMatch SourceLocation.emptyRange firstType [], defaultImpl ) :: initialWhens

        ( inferredWhenTypes, newContext ) =
            List.foldr (inferWhenTypes untypedDef) ( [], context ) whens
                |> Tuple.mapFirst normalizeWhenTypes
                |> (\( wts, ctx ) -> simplifyWhenWordTypes wts ctx)
                |> Tuple.mapFirst (List.map2 Tuple.pair whenPatterns >> List.map replaceFirstTypeWithPatternMatch)
                |> Tuple.mapFirst equalizeWhenTypes
                |> Tuple.mapFirst (\whenTypes -> List.map (constrainGenerics untypedDef.metadata.type_) whenTypes)

        replaceFirstTypeWithPatternMatch ( Qualifier.TypeMatch _ matchType _, typeSignature ) =
................................................................................
        ( _ :: annotatedRest, inferredEl :: inferredRest ) ->
            constrainGenericsHelper remappedGenerics annotatedRest inferredRest (inferredEl :: acc)


typeCheckImplementation : Qualifier.WordDefinition -> List Qualifier.Node -> Context -> ( WordType, Context )
typeCheckImplementation untypedDef impl context =
    let












        contextWithCall =

            { context | callStack = Set.insert untypedDef.name context.callStack }



        ( _, contextWithStackEffects ) =
            List.foldl
                (\node ( idx, ctx ) -> ( idx + 1, typeCheckNode idx node ctx ))
                ( 0, contextWithCall )
                impl

        contextWithoutCall =
            { contextWithStackEffects | callStack = Set.remove untypedDef.name contextWithStackEffects.callStack }






    in
    wordTypeFromStackEffects untypedDef contextWithoutCall

        |> simplifyWordType
        |> (\( a, b ) -> ( b, a ))


extractTypeFromTypeMatch : Qualifier.TypeMatch -> Type
extractTypeFromTypeMatch (Qualifier.TypeMatch _ t_ _) =
    t_







>
>
>
>
>
>
>
>
>
>
>








|
>
>
>









|







 







>
>
>
>
>
>
>
>
>
>
>
>

>
|
>
>









>
>
>
>
>
>


>







219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
...
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
    Context
    -> Qualifier.WordDefinition
    -> List ( Qualifier.TypeMatch, List Qualifier.Node )
    -> List Qualifier.Node
    -> Context
typeCheckMultiImplementation context untypedDef initialWhens defaultImpl =
    let
        untypedDefMetadata =
            untypedDef.metadata

        untypedDefNoTypeAnnotation =
            { untypedDef
                | metadata =
                    { untypedDefMetadata
                        | type_ = TypeSignature.NotProvided
                    }
            }

        whens =
            case defaultImpl of
                [] ->
                    initialWhens

                _ ->
                    let
                        ( inferredDefaultType, _ ) =
                            typeCheckImplementation
                                untypedDefNoTypeAnnotation
                                defaultImpl
                                (cleanContext context)
                    in
                    case inferredDefaultType.input of
                        [] ->
                            Debug.todo "Default impl doesn't have an input argument"

                        firstType :: _ ->
                            ( Qualifier.TypeMatch SourceLocation.emptyRange firstType [], defaultImpl ) :: initialWhens

        ( inferredWhenTypes, newContext ) =
            List.foldr (inferWhenTypes untypedDefNoTypeAnnotation) ( [], context ) whens
                |> Tuple.mapFirst normalizeWhenTypes
                |> (\( wts, ctx ) -> simplifyWhenWordTypes wts ctx)
                |> Tuple.mapFirst (List.map2 Tuple.pair whenPatterns >> List.map replaceFirstTypeWithPatternMatch)
                |> Tuple.mapFirst equalizeWhenTypes
                |> Tuple.mapFirst (\whenTypes -> List.map (constrainGenerics untypedDef.metadata.type_) whenTypes)

        replaceFirstTypeWithPatternMatch ( Qualifier.TypeMatch _ matchType _, typeSignature ) =
................................................................................
        ( _ :: annotatedRest, inferredEl :: inferredRest ) ->
            constrainGenericsHelper remappedGenerics annotatedRest inferredRest (inferredEl :: acc)


typeCheckImplementation : Qualifier.WordDefinition -> List Qualifier.Node -> Context -> ( WordType, Context )
typeCheckImplementation untypedDef impl context =
    let
        startingStackEffects =
            untypedDef.metadata.type_
                |> TypeSignature.toMaybe
                |> Maybe.map reverseWordType
                |> Maybe.withDefault Type.emptyWordType
                |> wordTypeToStackEffects

        reverseWordType wt =
            { input = []
            , output = wt.input
            }

        contextWithCall =
            { context
                | callStack = Set.insert untypedDef.name context.callStack
                , stackEffects = startingStackEffects
            }

        ( _, contextWithStackEffects ) =
            List.foldl
                (\node ( idx, ctx ) -> ( idx + 1, typeCheckNode idx node ctx ))
                ( 0, contextWithCall )
                impl

        contextWithoutCall =
            { contextWithStackEffects | callStack = Set.remove untypedDef.name contextWithStackEffects.callStack }

        annotatedInput =
            untypedDef.metadata.type_
                |> TypeSignature.toMaybe
                |> Maybe.map .input
                |> Maybe.withDefault []
    in
    wordTypeFromStackEffects untypedDef contextWithoutCall
        |> (\( ctx, wt ) -> ( ctx, { wt | input = wt.input ++ annotatedInput } ))
        |> simplifyWordType
        |> (\( a, b ) -> ( b, a ))


extractTypeFromTypeMatch : Qualifier.TypeMatch -> Type
extractTypeFromTypeMatch (Qualifier.TypeMatch _ t_ _) =
    t_