Stabel

Check-in [a382b579ce]
Login
Overview
Comment:Fix most Elm-based tests.
Timelines: family | ancestors | descendants | both | builtin-rewrite
Files: files | file ages | folders
SHA3-256: a382b579ce588f85d5f8a9263aa14e7a12f9347e299b1077d5a7a30fdda08cad
User & Date: robin.hansen on 2021-09-29 19:50:21
Other Links: branch diff | manifest | tags
Context
2021-09-30
16:52
Fixed remaining Elm tests. check-in: 3dc236ef66 user: robin.hansen tags: builtin-rewrite
2021-09-29
19:50
Fix most Elm-based tests. check-in: a382b579ce user: robin.hansen tags: builtin-rewrite
2021-09-26
10:01
Begin re-write of builtin handling. check-in: cfcc865e48 user: robin.hansen tags: builtin-rewrite
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified src/Stabel/PackageLoader.elm from [f78779f213] to [54ed1d81c2].

570
571
572
573
574
575
576

577
578
579
580
581
582
583

                qualifyAst parsedModInfo ( qast, es ) =
                    let
                        qualifierResult =
                            Qualifier.run
                                { packageName = PackageName.toString parsedModInfo.packageName
                                , modulePath = ModuleName.toString parsedModInfo.modulePath

                                , ast = parsedModInfo.ast
                                , externalModules = parsedModInfo.externalModules
                                , inProgressAST = qast
                                }
                    in
                    case qualifierResult of
                        Err qualifierError ->







>







570
571
572
573
574
575
576
577
578
579
580
581
582
583
584

                qualifyAst parsedModInfo ( qast, es ) =
                    let
                        qualifierResult =
                            Qualifier.run
                                { packageName = PackageName.toString parsedModInfo.packageName
                                , modulePath = ModuleName.toString parsedModInfo.modulePath
                                , mangle = True
                                , ast = parsedModInfo.ast
                                , externalModules = parsedModInfo.externalModules
                                , inProgressAST = qast
                                }
                    in
                    case qualifierResult of
                        Err qualifierError ->

Modified src/Stabel/Qualifier.elm from [2378ef46a7] to [e1f9f695d9].

116
117
118
119
120
121
122

123
124
125
126
127
128
129
...
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
...
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
...
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
...
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
....
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
....
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
....
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
....
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
....
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
        , ( "/stabel/hidden/array/set", Builtin.ArraySet )
        ]


type alias RunConfig =
    { packageName : String
    , modulePath : String

    , ast : Parser.AST
    , externalModules : Dict String String
    , inProgressAST : AST
    }


run : RunConfig -> Result (List Problem) AST
................................................................................
    let
        internalRefLookup path name binds =
            let
                qualifiedName =
                    path
                        ++ [ name ]
                        |> String.join "/"
                        |> qualifyPackageModule config.packageName
            in
            refLookup qualifiedName binds

        refLookup name binds =
            let
                bindResult =
                    binds
................................................................................

                    else
                        let
                            qualifiedName =
                                actualPath
                                    ++ "/"
                                    ++ name
                                    |> qualifyPackageModule config.packageName
                        in
                        qualifiedNameToMatch
                            config
                            qualifiedTypes
                            modRefs
                            (qualifiedRange range)
                            qualifiedName
................................................................................

                Nothing ->
                    let
                        qualifiedName =
                            possibleAlias
                                ++ "/"
                                ++ name
                                |> qualifyPackageModule config.packageName
                    in
                    qualifiedNameToMatch
                        config
                        qualifiedTypes
                        modRefs
                        (qualifiedRange range)
                        qualifiedName
................................................................................

        Parser.TypeMatchType range (Parser.InternalRef path name _) patterns ->
            let
                qualifiedName =
                    path
                        ++ [ name ]
                        |> String.join "/"
                        |> qualifyPackageModule config.packageName
            in
            qualifiedNameToMatch
                config
                qualifiedTypes
                modRefs
                (qualifiedRange range)
                qualifiedName
................................................................................
                            value
                in
                qualifyNode config currentDefName externalFunctionNode acc

            else
                let
                    qualifiedPath =
                        qualifyPackageModule config.packageName normalizedPath

                    qualifiedName =
                        String.join "/" [ qualifiedPath, value ]
                in
                case Dict.get qualifiedName config.inProgressAST.functions of
                    Nothing ->
                        { acc | qualifiedNodes = Err (UnknownFunctionRef qLoc qualifiedName) :: acc.qualifiedNodes }
................................................................................

        Parser.MultiImpl _ _ ->
            True


qualifyName : RunConfig -> String -> String
qualifyName config name =
    if config.packageName == "" then
        name

    else
        String.concat
            [ "/"
            , config.packageName
            , "/"
................................................................................
    in
    members
        |> List.indexedMap Tuple.pair
        |> List.find (\( _, ( name, _ ) ) -> name == memberName)
        |> Maybe.map (\( idx, ( _, t ) ) -> ( idx, t ))


qualifyPackageModule : String -> String -> String
qualifyPackageModule packageName path =
    if packageName == "" then
        path

    else
        String.concat
            [ "/"
            , packageName
            , "/"
................................................................................

        resolveMod mod =
            if representsExternalModule mod then
                Dict.get mod config.externalModules
                    |> Maybe.map
                        (\package ->
                            String.dropLeft 1 mod
                                |> qualifyPackageModule package
                        )

            else
                Just <| qualifyPackageModule config.packageName mod
    in
    case explicitImports of
        Just _ ->
            explicitImports

        Nothing ->
            potentialCandidates
................................................................................
                    Just package ->
                        Set.insert (String.concat [ "/", package, mod ]) acc

                    Nothing ->
                        acc

            else
                Set.insert (qualifyPackageModule config.packageName mod) acc
    in
    topLevelAliasTargets
        |> Set.union topLevelImports
        |> Set.union typeRequirements
        |> Set.union functionRequirements
        |> Set.foldl fullyQualify Set.empty








>







 







|







 







|







 







|







 







|







 







|







 







|







 







|
|
|







 







|



|







 







|







116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
...
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
...
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
...
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
...
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
....
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
....
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
....
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
....
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
....
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
        , ( "/stabel/hidden/array/set", Builtin.ArraySet )
        ]


type alias RunConfig =
    { packageName : String
    , modulePath : String
    , mangle : Bool
    , ast : Parser.AST
    , externalModules : Dict String String
    , inProgressAST : AST
    }


run : RunConfig -> Result (List Problem) AST
................................................................................
    let
        internalRefLookup path name binds =
            let
                qualifiedName =
                    path
                        ++ [ name ]
                        |> String.join "/"
                        |> qualifyPackageModule config.mangle config.packageName
            in
            refLookup qualifiedName binds

        refLookup name binds =
            let
                bindResult =
                    binds
................................................................................

                    else
                        let
                            qualifiedName =
                                actualPath
                                    ++ "/"
                                    ++ name
                                    |> qualifyPackageModule config.mangle config.packageName
                        in
                        qualifiedNameToMatch
                            config
                            qualifiedTypes
                            modRefs
                            (qualifiedRange range)
                            qualifiedName
................................................................................

                Nothing ->
                    let
                        qualifiedName =
                            possibleAlias
                                ++ "/"
                                ++ name
                                |> qualifyPackageModule config.mangle config.packageName
                    in
                    qualifiedNameToMatch
                        config
                        qualifiedTypes
                        modRefs
                        (qualifiedRange range)
                        qualifiedName
................................................................................

        Parser.TypeMatchType range (Parser.InternalRef path name _) patterns ->
            let
                qualifiedName =
                    path
                        ++ [ name ]
                        |> String.join "/"
                        |> qualifyPackageModule config.mangle config.packageName
            in
            qualifiedNameToMatch
                config
                qualifiedTypes
                modRefs
                (qualifiedRange range)
                qualifiedName
................................................................................
                            value
                in
                qualifyNode config currentDefName externalFunctionNode acc

            else
                let
                    qualifiedPath =
                        qualifyPackageModule config.mangle config.packageName normalizedPath

                    qualifiedName =
                        String.join "/" [ qualifiedPath, value ]
                in
                case Dict.get qualifiedName config.inProgressAST.functions of
                    Nothing ->
                        { acc | qualifiedNodes = Err (UnknownFunctionRef qLoc qualifiedName) :: acc.qualifiedNodes }
................................................................................

        Parser.MultiImpl _ _ ->
            True


qualifyName : RunConfig -> String -> String
qualifyName config name =
    if not config.mangle then
        name

    else
        String.concat
            [ "/"
            , config.packageName
            , "/"
................................................................................
    in
    members
        |> List.indexedMap Tuple.pair
        |> List.find (\( _, ( name, _ ) ) -> name == memberName)
        |> Maybe.map (\( idx, ( _, t ) ) -> ( idx, t ))


qualifyPackageModule : Bool -> String -> String -> String
qualifyPackageModule mangle packageName path =
    if not mangle then
        path

    else
        String.concat
            [ "/"
            , packageName
            , "/"
................................................................................

        resolveMod mod =
            if representsExternalModule mod then
                Dict.get mod config.externalModules
                    |> Maybe.map
                        (\package ->
                            String.dropLeft 1 mod
                                |> qualifyPackageModule config.mangle package
                        )

            else
                Just <| qualifyPackageModule config.mangle config.packageName mod
    in
    case explicitImports of
        Just _ ->
            explicitImports

        Nothing ->
            potentialCandidates
................................................................................
                    Just package ->
                        Set.insert (String.concat [ "/", package, mod ]) acc

                    Nothing ->
                        acc

            else
                Set.insert (qualifyPackageModule True config.packageName mod) acc
    in
    topLevelAliasTargets
        |> Set.union topLevelImports
        |> Set.union typeRequirements
        |> Set.union functionRequirements
        |> Set.foldl fullyQualify Set.empty

Modified tests/Test/Qualifier.elm from [eb2f930745] to [7adbd47b00].

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
..
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
...
206
207
208
209
210
211
212
213
214
215
216
217
218
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
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
...
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
...
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
        [ test "Recursive function" <|
            \_ ->
                let
                    source =
                        """
                        defmulti: count-down
                        : 0
                          drop 0
                        : Int
                          1 - count-down
                        """
                in
                QualifierUtil.expectQualification source
        , test "Recursive function through inline function" <|
            \_ ->
                let
                    source =
                        """
                        defmulti: count-down
                        : 0
                          drop 0
                        : Int
                          [ count-down ] !
                        """
                in
                QualifierUtil.expectQualification source
        , test "Function cycle" <|
            \_ ->
                let
                    source =
                        """
                        def: dec-down
                        : 1 - count-down 

                        defmulti: count-down
                        : 0
                          drop 0
                        : Int
                          dec-down
                        """
                in
                QualifierUtil.expectQualification source
        , test "Function cycle with inline function" <|
            \_ ->
                let
                    source =
                        """
                        def: dec-down
                        : 1 - count-down 

                        defmulti: count-down
                        : 0
                          drop 0
                        : Int
                          [ dec-down ] !
                        """
                in
                QualifierUtil.expectQualification source
        , test "Name mangling" <|
            \_ ->
                let
                    source =
................................................................................
                        : user-id Int
                        : value USMoney

                        defmulti: into-cents
                        type: USMoney -- Int
                        : Dollar
                          dollar-value>
                          100 *
                        : Cent
                          cent-value>

                        def: add-money
                        type: USMoney USMoney -- USMoney
                        : into-cents
                          swap into-cents
                          +
                          >Cent

                        def: quote-excuse
                        type: Dollar -- Dollar
                        : dollar-value>
                          [ 2 * ] !
                          >Dollar
                        """

                    usMoneyUnion =
                        [ Type.Custom "/stabel/test/some/module/Dollar"
                        , Type.Custom "/stabel/test/some/module/Cent"
                        ]

                    usMoneyUnionType =
                        Type.Union (Just "/stabel/test/some/module/USMoney")
                            usMoneyUnion

                    usMoneyTypeDef =
                        { name = "/stabel/test/some/module/USMoney"
                        , exposed = True
                        , sourceLocation = emptyRange
                        , generics = []
                        , members = UnionMembers usMoneyUnion
                        }

                    dollarTypeDef =
                        { name = "/stabel/test/some/module/Dollar"
                        , exposed = True
                        , sourceLocation = emptyRange
                        , generics = []
                        , members =
                            StructMembers
                                [ ( "dollar-value", Type.Int ) ]
                        }

                    centTypeDef =
                        { name = "/stabel/test/some/module/Cent"
                        , exposed = True
                        , sourceLocation = emptyRange
                        , generics = []
                        , members =
                            StructMembers
                                [ ( "cent-value", Type.Int ) ]
                        }

                    walletTypeDef =
                        { name = "/stabel/test/some/module/Wallet"
                        , exposed = True
                        , sourceLocation = emptyRange
                        , generics = []
                        , members =
                            StructMembers
                                [ ( "user-id", Type.Int )
                                , ( "value", usMoneyUnionType )
                                ]
                        }

                    intoCentsFn =
                        { name = "/stabel/test/some/module/into-cents"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.UserProvided
                                { input = [ usMoneyUnionType ]
                                , output = [ Type.Int ]
                                }
                        , implementation =
                            MultiImpl
                                [ ( TypeMatchType emptyRange (Type.Custom "/stabel/test/some/module/Dollar") []
                                  , [ Function emptyRange dollarValueGetFn
                                    , Integer emptyRange 100
                                    , Builtin emptyRange Builtin.Multiply
                                    ]
                                  )
                                , ( TypeMatchType emptyRange (Type.Custom "/stabel/test/some/module/Cent") []
                                  , [ Function emptyRange centValueGetFn
                                    ]
                                  )
                                ]
                                []
                        }

                    addMoneyFn =
                        { name = "/stabel/test/some/module/add-money"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.UserProvided
                                { input = [ usMoneyUnionType, usMoneyUnionType ]
                                , output = [ usMoneyUnionType ]
                                }
................................................................................
                                , Function emptyRange intoCentsFn
                                , Builtin emptyRange Builtin.Plus
                                , Function emptyRange centCtorFn
                                ]
                        }

                    quoteExcuseFn =
                        { name = "/stabel/test/some/module/quote-excuse"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.UserProvided
                                { input = [ Type.Custom "/stabel/test/some/module/Dollar" ]
                                , output = [ Type.Custom "/stabel/test/some/module/Dollar" ]
                                }
                        , implementation =
                            SoloImpl
                                [ Function emptyRange dollarValueGetFn
                                , FunctionRef emptyRange quoteExcuseIFn1
                                , Builtin emptyRange Builtin.Apply
                                , Function emptyRange dollarCtorFn
                                ]
                        }

                    quoteExcuseIFn1 =
                        { name = "inlinefn:/stabel/test/some/module/quote-excuse/1"
                        , exposed = False
                        , sourceLocation = Nothing
                        , typeSignature = TypeSignature.NotProvided
                        , implementation =
                            SoloImpl
                                [ Integer emptyRange 2
                                , Builtin emptyRange Builtin.Multiply
                                ]
                        }

                    dollarCtorFn =
                        { name = "/stabel/test/some/module/>Dollar"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Int ]
                                , output = [ Type.Custom "/stabel/test/some/module/Dollar" ]
                                }
                        , implementation =
                            SoloImpl [ ConstructType dollarTypeDef ]
                        }

                    centCtorFn =
                        { name = "/stabel/test/some/module/>Cent"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Int ]
                                , output = [ Type.Custom "/stabel/test/some/module/Cent" ]
                                }
                        , implementation =
                            SoloImpl [ ConstructType centTypeDef ]
                        }

                    walletCtorFn =
                        { name = "/stabel/test/some/module/>Wallet"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Int, usMoneyUnionType ]
                                , output = [ Type.Custom "/stabel/test/some/module/Wallet" ]
                                }
                        , implementation =
                            SoloImpl [ ConstructType walletTypeDef ]
                        }

                    dollarValueSetFn =
                        { name = "/stabel/test/some/module/>dollar-value"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/test/some/module/Dollar", Type.Int ]
                                , output = [ Type.Custom "/stabel/test/some/module/Dollar" ]
                                }
                        , implementation =
                            SoloImpl
                                [ SetMember dollarTypeDef "dollar-value" 0 Type.Int ]
                        }

                    centValueSetFn =
                        { name = "/stabel/test/some/module/>cent-value"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/test/some/module/Cent", Type.Int ]
                                , output = [ Type.Custom "/stabel/test/some/module/Cent" ]
                                }
                        , implementation =
                            SoloImpl
                                [ SetMember centTypeDef "cent-value" 0 Type.Int ]
                        }

                    userIdSetFn =
                        { name = "/stabel/test/some/module/>user-id"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/test/some/module/Wallet", Type.Int ]
                                , output = [ Type.Custom "/stabel/test/some/module/Wallet" ]
                                }
                        , implementation =
                            SoloImpl
                                [ SetMember walletTypeDef "user-id" 0 Type.Int ]
                        }

                    valueSetFn =
                        { name = "/stabel/test/some/module/>value"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/test/some/module/Wallet", usMoneyUnionType ]
                                , output = [ Type.Custom "/stabel/test/some/module/Wallet" ]
                                }
                        , implementation =
                            SoloImpl
                                [ SetMember walletTypeDef "value" 1 usMoneyUnionType ]
                        }

                    dollarValueGetFn =
                        { name = "/stabel/test/some/module/dollar-value>"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/test/some/module/Dollar" ]
                                , output = [ Type.Int ]
                                }
                        , implementation =
                            SoloImpl
                                [ GetMember dollarTypeDef "dollar-value" 0 Type.Int ]
                        }

                    centValueGetFn =
                        { name = "/stabel/test/some/module/cent-value>"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/test/some/module/Cent" ]
                                , output = [ Type.Int ]
                                }
                        , implementation =
                            SoloImpl
                                [ GetMember centTypeDef "cent-value" 0 Type.Int ]
                        }

                    userIdGetFn =
                        { name = "/stabel/test/some/module/user-id>"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/test/some/module/Wallet" ]
                                , output = [ Type.Int ]
                                }
                        , implementation =
                            SoloImpl
                                [ GetMember walletTypeDef "user-id" 0 Type.Int ]
                        }

                    valueGetFn =
                        { name = "/stabel/test/some/module/value>"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/test/some/module/Wallet" ]
                                , output = [ usMoneyUnionType ]
                                }
                        , implementation =
                            SoloImpl
                                [ GetMember walletTypeDef "value" 1 usMoneyUnionType ]
                        }

................................................................................
                                , dollarValueGetFn
                                , centValueGetFn
                                , userIdGetFn
                                , valueGetFn
                                ]
                        , referenceableFunctions =
                            Set.fromList
                                [ "inlinefn:/stabel/test/some/module/quote-excuse/1" ]
                        }
                in
                QualifierUtil.expectModuleOutput source expectedAst
        , test "Retrieve dependant modules" <|
            \_ ->
                let
                    source =
................................................................................
                        : value /external/double/Tipe

                        defmulti: call-external
                        type: internal/types/In -- /external/types/Out
                        : Int( value 1 )
                          package/module/when-one
                        : internal/match/Some
                          drop
                        else: package/module/when-other-one

                        def: main
                        alias: internal/alias ali 
                        import: /list/of/names one
                        : html/div
                          call-external







|

|










|

|









|



|











|



|

|







 







|






|
|





|




|
|



|



|







|









|









|











|









|





|








|







 







|




|
|











|











|





|






|





|






|





|






|




|
|







|




|
|







|




|
|







|




|
|







|




|








|




|








|




|








|




|







 







|







 







|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
..
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
...
206
207
208
209
210
211
212
213
214
215
216
217
218
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
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
...
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
...
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
        [ test "Recursive function" <|
            \_ ->
                let
                    source =
                        """
                        defmulti: count-down
                        : 0
                          //stabel/hidden/stack/drop 0
                        : Int
                          1 //stabel/hidden/int/- count-down
                        """
                in
                QualifierUtil.expectQualification source
        , test "Recursive function through inline function" <|
            \_ ->
                let
                    source =
                        """
                        defmulti: count-down
                        : 0
                          //stabel/hidden/stack/drop 0
                        : Int
                          [ count-down ] //stabel/hidden/stack/!
                        """
                in
                QualifierUtil.expectQualification source
        , test "Function cycle" <|
            \_ ->
                let
                    source =
                        """
                        def: dec-down
                        : 1 //stabel/hidden/int/- count-down 

                        defmulti: count-down
                        : 0
                          //stabel/hidden/stack/drop 0
                        : Int
                          dec-down
                        """
                in
                QualifierUtil.expectQualification source
        , test "Function cycle with inline function" <|
            \_ ->
                let
                    source =
                        """
                        def: dec-down
                        : 1 //stabel/hidden/int/- count-down 

                        defmulti: count-down
                        : 0
                          //stabel/hidden/stack/drop 0
                        : Int
                          [ dec-down ] //stabel/hidden/stack/!
                        """
                in
                QualifierUtil.expectQualification source
        , test "Name mangling" <|
            \_ ->
                let
                    source =
................................................................................
                        : user-id Int
                        : value USMoney

                        defmulti: into-cents
                        type: USMoney -- Int
                        : Dollar
                          dollar-value>
                          100 //stabel/hidden/int/*
                        : Cent
                          cent-value>

                        def: add-money
                        type: USMoney USMoney -- USMoney
                        : into-cents
                          //stabel/hidden/stack/swap into-cents
                          //stabel/hidden/int/+
                          >Cent

                        def: quote-excuse
                        type: Dollar -- Dollar
                        : dollar-value>
                          [ 2 //stabel/hidden/int/* ] //stabel/hidden/stack/!
                          >Dollar
                        """

                    usMoneyUnion =
                        [ Type.Custom "/stabel/standard_library/some/module/Dollar"
                        , Type.Custom "/stabel/standard_library/some/module/Cent"
                        ]

                    usMoneyUnionType =
                        Type.Union (Just "/stabel/standard_library/some/module/USMoney")
                            usMoneyUnion

                    usMoneyTypeDef =
                        { name = "/stabel/standard_library/some/module/USMoney"
                        , exposed = True
                        , sourceLocation = emptyRange
                        , generics = []
                        , members = UnionMembers usMoneyUnion
                        }

                    dollarTypeDef =
                        { name = "/stabel/standard_library/some/module/Dollar"
                        , exposed = True
                        , sourceLocation = emptyRange
                        , generics = []
                        , members =
                            StructMembers
                                [ ( "dollar-value", Type.Int ) ]
                        }

                    centTypeDef =
                        { name = "/stabel/standard_library/some/module/Cent"
                        , exposed = True
                        , sourceLocation = emptyRange
                        , generics = []
                        , members =
                            StructMembers
                                [ ( "cent-value", Type.Int ) ]
                        }

                    walletTypeDef =
                        { name = "/stabel/standard_library/some/module/Wallet"
                        , exposed = True
                        , sourceLocation = emptyRange
                        , generics = []
                        , members =
                            StructMembers
                                [ ( "user-id", Type.Int )
                                , ( "value", usMoneyUnionType )
                                ]
                        }

                    intoCentsFn =
                        { name = "/stabel/standard_library/some/module/into-cents"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.UserProvided
                                { input = [ usMoneyUnionType ]
                                , output = [ Type.Int ]
                                }
                        , implementation =
                            MultiImpl
                                [ ( TypeMatchType emptyRange (Type.Custom "/stabel/standard_library/some/module/Dollar") []
                                  , [ Function emptyRange dollarValueGetFn
                                    , Integer emptyRange 100
                                    , Builtin emptyRange Builtin.Multiply
                                    ]
                                  )
                                , ( TypeMatchType emptyRange (Type.Custom "/stabel/standard_library/some/module/Cent") []
                                  , [ Function emptyRange centValueGetFn
                                    ]
                                  )
                                ]
                                []
                        }

                    addMoneyFn =
                        { name = "/stabel/standard_library/some/module/add-money"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.UserProvided
                                { input = [ usMoneyUnionType, usMoneyUnionType ]
                                , output = [ usMoneyUnionType ]
                                }
................................................................................
                                , Function emptyRange intoCentsFn
                                , Builtin emptyRange Builtin.Plus
                                , Function emptyRange centCtorFn
                                ]
                        }

                    quoteExcuseFn =
                        { name = "/stabel/standard_library/some/module/quote-excuse"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.UserProvided
                                { input = [ Type.Custom "/stabel/standard_library/some/module/Dollar" ]
                                , output = [ Type.Custom "/stabel/standard_library/some/module/Dollar" ]
                                }
                        , implementation =
                            SoloImpl
                                [ Function emptyRange dollarValueGetFn
                                , FunctionRef emptyRange quoteExcuseIFn1
                                , Builtin emptyRange Builtin.Apply
                                , Function emptyRange dollarCtorFn
                                ]
                        }

                    quoteExcuseIFn1 =
                        { name = "inlinefn:/stabel/standard_library/some/module/quote-excuse/1"
                        , exposed = False
                        , sourceLocation = Nothing
                        , typeSignature = TypeSignature.NotProvided
                        , implementation =
                            SoloImpl
                                [ Integer emptyRange 2
                                , Builtin emptyRange Builtin.Multiply
                                ]
                        }

                    dollarCtorFn =
                        { name = "/stabel/standard_library/some/module/>Dollar"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Int ]
                                , output = [ Type.Custom "/stabel/standard_library/some/module/Dollar" ]
                                }
                        , implementation =
                            SoloImpl [ ConstructType dollarTypeDef ]
                        }

                    centCtorFn =
                        { name = "/stabel/standard_library/some/module/>Cent"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Int ]
                                , output = [ Type.Custom "/stabel/standard_library/some/module/Cent" ]
                                }
                        , implementation =
                            SoloImpl [ ConstructType centTypeDef ]
                        }

                    walletCtorFn =
                        { name = "/stabel/standard_library/some/module/>Wallet"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Int, usMoneyUnionType ]
                                , output = [ Type.Custom "/stabel/standard_library/some/module/Wallet" ]
                                }
                        , implementation =
                            SoloImpl [ ConstructType walletTypeDef ]
                        }

                    dollarValueSetFn =
                        { name = "/stabel/standard_library/some/module/>dollar-value"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/standard_library/some/module/Dollar", Type.Int ]
                                , output = [ Type.Custom "/stabel/standard_library/some/module/Dollar" ]
                                }
                        , implementation =
                            SoloImpl
                                [ SetMember dollarTypeDef "dollar-value" 0 Type.Int ]
                        }

                    centValueSetFn =
                        { name = "/stabel/standard_library/some/module/>cent-value"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/standard_library/some/module/Cent", Type.Int ]
                                , output = [ Type.Custom "/stabel/standard_library/some/module/Cent" ]
                                }
                        , implementation =
                            SoloImpl
                                [ SetMember centTypeDef "cent-value" 0 Type.Int ]
                        }

                    userIdSetFn =
                        { name = "/stabel/standard_library/some/module/>user-id"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/standard_library/some/module/Wallet", Type.Int ]
                                , output = [ Type.Custom "/stabel/standard_library/some/module/Wallet" ]
                                }
                        , implementation =
                            SoloImpl
                                [ SetMember walletTypeDef "user-id" 0 Type.Int ]
                        }

                    valueSetFn =
                        { name = "/stabel/standard_library/some/module/>value"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/standard_library/some/module/Wallet", usMoneyUnionType ]
                                , output = [ Type.Custom "/stabel/standard_library/some/module/Wallet" ]
                                }
                        , implementation =
                            SoloImpl
                                [ SetMember walletTypeDef "value" 1 usMoneyUnionType ]
                        }

                    dollarValueGetFn =
                        { name = "/stabel/standard_library/some/module/dollar-value>"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/standard_library/some/module/Dollar" ]
                                , output = [ Type.Int ]
                                }
                        , implementation =
                            SoloImpl
                                [ GetMember dollarTypeDef "dollar-value" 0 Type.Int ]
                        }

                    centValueGetFn =
                        { name = "/stabel/standard_library/some/module/cent-value>"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/standard_library/some/module/Cent" ]
                                , output = [ Type.Int ]
                                }
                        , implementation =
                            SoloImpl
                                [ GetMember centTypeDef "cent-value" 0 Type.Int ]
                        }

                    userIdGetFn =
                        { name = "/stabel/standard_library/some/module/user-id>"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/standard_library/some/module/Wallet" ]
                                , output = [ Type.Int ]
                                }
                        , implementation =
                            SoloImpl
                                [ GetMember walletTypeDef "user-id" 0 Type.Int ]
                        }

                    valueGetFn =
                        { name = "/stabel/standard_library/some/module/value>"
                        , exposed = True
                        , sourceLocation = Nothing
                        , typeSignature =
                            TypeSignature.CompilerProvided
                                { input = [ Type.Custom "/stabel/standard_library/some/module/Wallet" ]
                                , output = [ usMoneyUnionType ]
                                }
                        , implementation =
                            SoloImpl
                                [ GetMember walletTypeDef "value" 1 usMoneyUnionType ]
                        }

................................................................................
                                , dollarValueGetFn
                                , centValueGetFn
                                , userIdGetFn
                                , valueGetFn
                                ]
                        , referenceableFunctions =
                            Set.fromList
                                [ "inlinefn:/stabel/standard_library/some/module/quote-excuse/1" ]
                        }
                in
                QualifierUtil.expectModuleOutput source expectedAst
        , test "Retrieve dependant modules" <|
            \_ ->
                let
                    source =
................................................................................
                        : value /external/double/Tipe

                        defmulti: call-external
                        type: internal/types/In -- /external/types/Out
                        : Int( value 1 )
                          package/module/when-one
                        : internal/match/Some
                          //stabel/hidden/stack/drop
                        else: package/module/when-other-one

                        def: main
                        alias: internal/alias ali 
                        import: /list/of/names one
                        : html/div
                          call-external

Modified tests/Test/Qualifier/Errors.elm from [5ffe1b5acb] to [b6ce273b5a].

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
..
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
...
174
175
176
177
178
179
180
181
182

183
184
185
186
187
188
189
        [ describe "No such reference" <|
            [ test "Word" <|
                \_ ->
                    let
                        source =
                            """
                            def: inc
                            : 1 +

                            def: main
                            : 1 inc inc dec 2 =
                            """
                    in
                    checkForError (noSuchWordReferenceError "dec") source
            , test "External" <|
                \_ ->
                    let
                        source =
................................................................................
            , test "Type" <|
                \_ ->
                    let
                        source =
                            """
                            def: inc
                            type: Ints -- Int
                            : 1 +

                            def: main
                            : 1 inc 2 =
                            """
                    in
                    checkForError (noSuchTypeReferenceError "Ints") source
            , test "Wrong reference within union definition" <|
                \_ ->
                    let
                        source =
................................................................................
        Err errors ->
            Expect.fail <| "Parser error: " ++ Debug.toString errors

        Ok parserAst ->
            let
                result =
                    Qualifier.run
                        { packageName = ""
                        , modulePath = ""

                        , ast = parserAst
                        , externalModules = Dict.empty
                        , inProgressAST =
                            { types = Dict.empty
                            , functions = Dict.empty
                            , referenceableFunctions = Set.empty
                            }







|


|







 







|


|







 







|
|
>







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
..
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
...
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
        [ describe "No such reference" <|
            [ test "Word" <|
                \_ ->
                    let
                        source =
                            """
                            def: inc
                            : 1 //stabel/hidden/int/+

                            def: main
                            : 1 inc inc dec 2 //stabel/hidden/int/=
                            """
                    in
                    checkForError (noSuchWordReferenceError "dec") source
            , test "External" <|
                \_ ->
                    let
                        source =
................................................................................
            , test "Type" <|
                \_ ->
                    let
                        source =
                            """
                            def: inc
                            type: Ints -- Int
                            : 1 //stabel/hidden/int/+

                            def: main
                            : 1 inc 2 //stabel/hidden/int/=
                            """
                    in
                    checkForError (noSuchTypeReferenceError "Ints") source
            , test "Wrong reference within union definition" <|
                \_ ->
                    let
                        source =
................................................................................
        Err errors ->
            Expect.fail <| "Parser error: " ++ Debug.toString errors

        Ok parserAst ->
            let
                result =
                    Qualifier.run
                        { packageName = "stabel/standard_library"
                        , modulePath = "core"
                        , mangle = False
                        , ast = parserAst
                        , externalModules = Dict.empty
                        , inProgressAST =
                            { types = Dict.empty
                            , functions = Dict.empty
                            , referenceableFunctions = Set.empty
                            }

Modified tests/Test/Qualifier/ModuleResolution.elm from [3a57acc6b9] to [55937b5145].

107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
...
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
...
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
...
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
...
325
326
327
328
329
330
331

332
333
334
335
336
337
338

                            defstruct: Tipe

                            def: dummy
                            : 1
                            """
                          )
                        , ( "stabel/test"
                          , "core"
                          , """
                            def: main
                            type: /mod/Tipe --
                            : drop
                            """
                          )
                        ]

                    findError err =
                        case err of
                            Problem.TypeNotExposed _ "/stabel/external/mod/Tipe" ->
................................................................................
                            exposing: Dummy
                            :

                            defstruct: Tipe
                            defstruct: Dummy
                            """
                          )
                        , ( "stabel/test"
                          , "core"
                          , """
                            defmulti: call
                            : /mod/Tipe
                              drop
                            else: drop
                            """
                          )
                        ]

                    findError err =
                        case err of
                            Problem.TypeNotExposed _ "/stabel/external/mod/Tipe" ->
................................................................................
                                False
                in
                checkForError findError sources
        , test "Referencing a type in a type signature from an internal module which isn't exposed ends in a error" <|
            \_ ->
                let
                    sources =
                        [ ( "stabel/test"
                          , "mod"
                          , """
                            defmodule:
                            exposing: Dummy
                            :

                            defstruct: Tipe
                            defstruct: Dummy
                            """
                          )
                        , ( "stabel/test"
                          , "core"
                          , """
                            def: call
                            type: mod/Tipe --
                            : drop
                            """
                          )
                        ]

                    findError err =
                        case err of
                            Problem.TypeNotExposed _ "/stabel/test/mod/Tipe" ->
                                True

                            _ ->
                                False
                in
                checkForError findError sources
        , test "Referencing a type in a type definition from an internal module which isn't exposed ends in a error" <|
................................................................................
                                False
                in
                checkForError findError sources
        , test "Referencing a type in a type match from an internal module which isn't exposed ends in a error" <|
            \_ ->
                let
                    sources =
                        [ ( "stabel/test"
                          , "mod"
                          , """
                            defmodule:
                            exposing: TipeUnion
                            :

                            defunion: TipeUnion
                            : Tipe
                            : a

                            defstruct: Tipe
                            """
                          )
                        , ( "stabel/test"
                          , "core"
                          , """
                            defmulti: call
                            : mod/Tipe
                              drop
                            else: drop
                            """
                          )
                        ]

                    findError err =
                        case err of
                            Problem.TypeNotExposed _ "/stabel/test/mod/Tipe" ->
                                True

                            _ ->
                                False
                in
                checkForError findError sources
        ]
................................................................................
            Expect.fail <| "Parse error: " ++ Debug.toString errs

        Ok withAst ->
            let
                initialConfig =
                    { packageName = ""
                    , modulePath = ""

                    , ast =
                        { sourceReference = "test"
                        , moduleDefinition = ModuleDefinition.Undefined
                        , types = Dict.empty
                        , functions = Dict.empty
                        }
                    , externalModules = Dict.empty







|




|







 







|




|
|







 







|










|




|






|







 







|













|




|
|






|







 







>







107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
...
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
...
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
...
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
...
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339

                            defstruct: Tipe

                            def: dummy
                            : 1
                            """
                          )
                        , ( "stabel/standard_library"
                          , "core"
                          , """
                            def: main
                            type: /mod/Tipe --
                            : //stabel/hidden/stack/drop
                            """
                          )
                        ]

                    findError err =
                        case err of
                            Problem.TypeNotExposed _ "/stabel/external/mod/Tipe" ->
................................................................................
                            exposing: Dummy
                            :

                            defstruct: Tipe
                            defstruct: Dummy
                            """
                          )
                        , ( "stabel/standard_library"
                          , "core"
                          , """
                            defmulti: call
                            : /mod/Tipe
                              //stabel/hidden/stack/drop
                            else: //stabel/hidden/stack/drop
                            """
                          )
                        ]

                    findError err =
                        case err of
                            Problem.TypeNotExposed _ "/stabel/external/mod/Tipe" ->
................................................................................
                                False
                in
                checkForError findError sources
        , test "Referencing a type in a type signature from an internal module which isn't exposed ends in a error" <|
            \_ ->
                let
                    sources =
                        [ ( "stabel/standard_library"
                          , "mod"
                          , """
                            defmodule:
                            exposing: Dummy
                            :

                            defstruct: Tipe
                            defstruct: Dummy
                            """
                          )
                        , ( "stabel/standard_library"
                          , "core"
                          , """
                            def: call
                            type: mod/Tipe --
                            : //stabel/hidden/stack/drop
                            """
                          )
                        ]

                    findError err =
                        case err of
                            Problem.TypeNotExposed _ "/stabel/standard_library/mod/Tipe" ->
                                True

                            _ ->
                                False
                in
                checkForError findError sources
        , test "Referencing a type in a type definition from an internal module which isn't exposed ends in a error" <|
................................................................................
                                False
                in
                checkForError findError sources
        , test "Referencing a type in a type match from an internal module which isn't exposed ends in a error" <|
            \_ ->
                let
                    sources =
                        [ ( "stabel/standard_library"
                          , "mod"
                          , """
                            defmodule:
                            exposing: TipeUnion
                            :

                            defunion: TipeUnion
                            : Tipe
                            : a

                            defstruct: Tipe
                            """
                          )
                        , ( "stabel/standard_library"
                          , "core"
                          , """
                            defmulti: call
                            : mod/Tipe
                              //stabel/hidden/stack/drop
                            else: //stabel/hidden/stack/drop
                            """
                          )
                        ]

                    findError err =
                        case err of
                            Problem.TypeNotExposed _ "/stabel/standard_library/mod/Tipe" ->
                                True

                            _ ->
                                False
                in
                checkForError findError sources
        ]
................................................................................
            Expect.fail <| "Parse error: " ++ Debug.toString errs

        Ok withAst ->
            let
                initialConfig =
                    { packageName = ""
                    , modulePath = ""
                    , mangle = True
                    , ast =
                        { sourceReference = "test"
                        , moduleDefinition = ModuleDefinition.Undefined
                        , types = Dict.empty
                        , functions = Dict.empty
                        }
                    , externalModules = Dict.empty

Modified tests/Test/Qualifier/Util.elm from [ae4998edee] to [2da9db3db6].

36
37
38
39
40
41
42
43
44

45
46
47
48
49
50
51
..
61
62
63
64
65
66
67
68
69

70
71
72
73
74
75
76
        Err errors ->
            Expect.fail <| "Parser error: " ++ Debug.toString errors

        Ok parserAst ->
            let
                result =
                    AST.run
                        { packageName = "stabel/test"
                        , modulePath = "some/module"

                        , ast = parserAst
                        , externalModules = Dict.empty
                        , inProgressAST = emptyAst
                        }
            in
            case result of
                Err errors ->
................................................................................
        Err errors ->
            Expect.fail <| "Parser error: " ++ Debug.toString errors

        Ok parserAst ->
            let
                result =
                    AST.run
                        { packageName = "stabel/test"
                        , modulePath = "some/module"

                        , ast = parserAst
                        , externalModules = Dict.empty
                        , inProgressAST = emptyAst
                        }
            in
            case result of
                Err errors ->







|
|
>







 







|

>







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
..
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
        Err errors ->
            Expect.fail <| "Parser error: " ++ Debug.toString errors

        Ok parserAst ->
            let
                result =
                    AST.run
                        { packageName = "stabel/standard_library"
                        , modulePath = "core"
                        , mangle = False
                        , ast = parserAst
                        , externalModules = Dict.empty
                        , inProgressAST = emptyAst
                        }
            in
            case result of
                Err errors ->
................................................................................
        Err errors ->
            Expect.fail <| "Parser error: " ++ Debug.toString errors

        Ok parserAst ->
            let
                result =
                    AST.run
                        { packageName = "stabel/standard_library"
                        , modulePath = "some/module"
                        , mangle = True
                        , ast = parserAst
                        , externalModules = Dict.empty
                        , inProgressAST = emptyAst
                        }
            in
            case result of
                Err errors ->

Modified tests/Test/TypeChecker.elm from [32cda2342c] to [fba971ab6e].

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38



39
40
41
42


43
44
45
46
47
48
49
..
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
..
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
..
82
83
84
85
86
87
88
89
90
91
92
93
94
95

96
97
98
99
100
101
102
...
115
116
117
118
119
120
121
122
123
124
125
126
127


128
129

130
131
132
133




134
135
136
137
138
139
140

141
142

143



144
145
146
147
148
149
150
...
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
...
238
239
240
241
242
243
244
245

246
247
248
249
250
251
252
253
254
255
256
257
...
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
...
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
        [ test "Bad type annotation" <|
            \_ ->
                let
                    input =
                        """
                        def: main
                        type: Int --
                        : 1 2 =
                        """
                in
                expectTypeCheckFailure input
        , test "Generic types" <|
            \_ ->
                let
                    input =
                        """
                        def: main
                        type: -- Int
                        : 1 2 over + - 2 =




                        def: over
                        type: b c -- b c b
                        : swap dup rotate


                        """
                in
                expectTypeCheck input
        , test "Generic types with type annotation" <|
            \_ ->
                let
                    input =
................................................................................
                        """
                        def: main
                        type: -- Int
                        : 5 square

                        def: square
                        type: Int -- Int
                        : dup *
                        """
                in
                expectTypeCheck input
        , test "Generic custom type" <|
            \_ ->
                let
                    input =
................................................................................
                        """
                        defstruct: Box a
                        : element a

                        def: main
                        type: -- Int
                        : 5 >Box element>
                          10 +
                          15 =
                        """
                in
                expectTypeCheck input
        , test "Generic types with rotations and quotations" <|
            \_ ->
                let
                    input =
................................................................................
                        defstruct: Coordinate
                        : x Int
                        : y Int

                        def: main
                        type: -- Int
                        : 1 2 >Coordinate
                          [ 1 + ] update-x
                          x>

                        def: update-x
                        type: Coordinate [ Int -- Int ] -- Coordinate
                        : swap dup x> # [ Int -- Int] Coordinate x
                          -rotate !

                          >x
                        """
                in
                expectTypeCheck input
        , test "Generic types with generic quotations" <|
            \_ ->
                let
................................................................................
                        : rest (List a)

                        defstruct: Empty

                        def: main
                        type: -- Int
                        : 1 2 3 Empty> >NonEmpty >NonEmpty >NonEmpty
                          0 [ + ] fold

                        defmulti: fold
                        type: (List a) b [ a b -- b ] -- b
                        : Empty
                          drop swap drop


                        : NonEmpty
                          >Pair swap

                          [ head> ] [ rest> ] split
                          rotate swap dup 
                          rotate
                          spill !




                          swap second>
                          fold

                        def: split
                        type: a [ a -- b ] [ a -- c ] -- b c
                        : -rotate dup -rotate
                          !

                          swap -rotate
                          !

                          swap




                        def: spill
                        type: (Pair a b) -- a b
                        : [ first> ] [ second> ] split
                        """
                in
                expectTypeCheck input
................................................................................
            [ test "Simple example" <|
                \_ ->
                    let
                        input =
                            """
                            def: main
                            : 1
                              [ 1 + ] apply-to-num
                              [ 1 - ] apply-to-num

                            def: apply-to-num
                            : !
                            """
                    in
                    expectTypeCheck input
            , test "With type annotation" <|
                \_ ->
                    let
                        input =
                            """
                            def: main
                            : 1
                              [ 1 + ] apply-to-num
                              [ 1 - ] apply-to-num

                            def: apply-to-num
                            type: Int [ Int -- Int ] -- Int
                            : !
                            """
                    in
                    expectTypeCheck input
            , test "Typechecking involving a multi-arity quotation is fine _if_ arity info is in type annotation" <|
                \_ ->
                    let
                        input =
                            """
                            def: main
                            : [ + ] apply-to-nums

                            def: apply-to-nums
                            type: [ Int Int -- Int ] -- Int
                            : 1 2 -rotate !
                            """
                    in
                    expectTypeCheck input
            , test "With generics" <|
                \_ ->
                    let
                        input =
                            """
                            def: main
                            : 1 [ 1 - ] map

                            def: map
                            type: a [ a -- b ] -- b
                            : !
                            """
                    in
                    expectTypeCheck input
            , test "Within multiwords" <|
                \_ ->
                    let
                        input =
................................................................................
                            : Nil

                            defstruct: Nil

                            defmulti: map
                            type: (Maybe a) [ a -- b ] -- (Maybe b)
                            : a
                              !

                            : Nil
                              drop

                            def: main
                            : Nil> [ 1 - ] map
                            """
                    in
                    expectTypeCheck input
            ]
        , describe "Recursive word definitions"
            [ test "With type annotation" <|
                \_ ->
................................................................................

                            def: sum
                            : 0 sum-helper

                            defmulti: sum-helper
                            type: (List a) Int -- Int
                            : NonEmptyList
                              swap rest> swap 
                              1 +
                              sum-helper
                            : EmptyList
                              swap drop

                            def: main
                            : 1 2 3 EmptyList> >NonEmptyList >NonEmptyList >NonEmptyList
                              sum
                            """
                    in
                    expectTypeCheck input
................................................................................
                    input =
                        """
                        def: main
                        : 1 2 drop-first

                        def: drop-first
                        type: a b -- b
                        : swap drop
                        """

                    dropFirstFn =
                        { name = "drop-first"
                        , type_ =
                            { input = [ Type.Generic "a", Type.Generic "b" ]
                            , output = [ Type.Generic "b" ]







|










|
>
>
>



|
>
>







 







|







 







|
|







 







|




|
|
>







 







|




|
>
>

<
>

<
<
|
>
>
>
>
|




|
<
>
|
<
>
|
>
>
>







 







|
|


|










|
|



|









|



|









|



|







 







<
>

|


|







 







|
|


|







 







|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
..
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
..
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
..
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
...
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136

137
138


139
140
141
142
143
144
145
146
147
148
149

150
151

152
153
154
155
156
157
158
159
160
161
162
163
...
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
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
...
251
252
253
254
255
256
257

258
259
260
261
262
263
264
265
266
267
268
269
270
...
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
...
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
        [ test "Bad type annotation" <|
            \_ ->
                let
                    input =
                        """
                        def: main
                        type: Int --
                        : 1 2 //stabel/hidden/int/=
                        """
                in
                expectTypeCheckFailure input
        , test "Generic types" <|
            \_ ->
                let
                    input =
                        """
                        def: main
                        type: -- Int
                        : 1 2 over 
                          //stabel/hidden/int/+ 
                          //stabel/hidden/int/- 
                          2 //stabel/hidden/int/=

                        def: over
                        type: b c -- b c b
                        : //stabel/hidden/stack/swap 
                          //stabel/hidden/stack/dup 
                          //stabel/hidden/stack/rotate
                        """
                in
                expectTypeCheck input
        , test "Generic types with type annotation" <|
            \_ ->
                let
                    input =
................................................................................
                        """
                        def: main
                        type: -- Int
                        : 5 square

                        def: square
                        type: Int -- Int
                        : //stabel/hidden/stack/dup //stabel/hidden/int/*
                        """
                in
                expectTypeCheck input
        , test "Generic custom type" <|
            \_ ->
                let
                    input =
................................................................................
                        """
                        defstruct: Box a
                        : element a

                        def: main
                        type: -- Int
                        : 5 >Box element>
                          10 //stabel/hidden/int/+
                          15 //stabel/hidden/int/=
                        """
                in
                expectTypeCheck input
        , test "Generic types with rotations and quotations" <|
            \_ ->
                let
                    input =
................................................................................
                        defstruct: Coordinate
                        : x Int
                        : y Int

                        def: main
                        type: -- Int
                        : 1 2 >Coordinate
                          [ 1 //stabel/hidden/int/+ ] update-x
                          x>

                        def: update-x
                        type: Coordinate [ Int -- Int ] -- Coordinate
                        : //stabel/hidden/stack/swap 
                          //stabel/hidden/stack/dup x> # [ Int -- Int] Coordinate x
                          //stabel/hidden/stack/-rotate //stabel/hidden/stack/!
                          >x
                        """
                in
                expectTypeCheck input
        , test "Generic types with generic quotations" <|
            \_ ->
                let
................................................................................
                        : rest (List a)

                        defstruct: Empty

                        def: main
                        type: -- Int
                        : 1 2 3 Empty> >NonEmpty >NonEmpty >NonEmpty
                          0 [ //stabel/hidden/int/+ ] fold

                        defmulti: fold
                        type: (List a) b [ a b -- b ] -- b
                        : Empty
                          //stabel/hidden/stack/drop 
                          //stabel/hidden/stack/swap 
                          //stabel/hidden/stack/drop
                        : NonEmpty

                          >Pair //stabel/hidden/stack/swap
                          [ head> ] [ rest> ] split


                          //stabel/hidden/stack/rotate 
                          //stabel/hidden/stack/swap 
                          //stabel/hidden/stack/dup 
                          //stabel/hidden/stack/rotate
                          spill //stabel/hidden/stack/!
                          //stabel/hidden/stack/swap second>
                          fold

                        def: split
                        type: a [ a -- b ] [ a -- c ] -- b c
                        : //stabel/hidden/stack/-rotate 

                          //stabel/hidden/stack/dup 
                          //stabel/hidden/stack/-rotate

                          //stabel/hidden/stack/!
                          //stabel/hidden/stack/swap 
                          //stabel/hidden/stack/-rotate
                          //stabel/hidden/stack/!
                          //stabel/hidden/stack/swap

                        def: spill
                        type: (Pair a b) -- a b
                        : [ first> ] [ second> ] split
                        """
                in
                expectTypeCheck input
................................................................................
            [ test "Simple example" <|
                \_ ->
                    let
                        input =
                            """
                            def: main
                            : 1
                              [ 1 //stabel/hidden/int/+ ] apply-to-num
                              [ 1 //stabel/hidden/int/- ] apply-to-num

                            def: apply-to-num
                            : //stabel/hidden/stack/!
                            """
                    in
                    expectTypeCheck input
            , test "With type annotation" <|
                \_ ->
                    let
                        input =
                            """
                            def: main
                            : 1
                              [ 1 //stabel/hidden/int/+ ] apply-to-num
                              [ 1 //stabel/hidden/int/- ] apply-to-num

                            def: apply-to-num
                            type: Int [ Int -- Int ] -- Int
                            : //stabel/hidden/stack/!
                            """
                    in
                    expectTypeCheck input
            , test "Typechecking involving a multi-arity quotation is fine _if_ arity info is in type annotation" <|
                \_ ->
                    let
                        input =
                            """
                            def: main
                            : [ //stabel/hidden/int/+ ] apply-to-nums

                            def: apply-to-nums
                            type: [ Int Int -- Int ] -- Int
                            : 1 2 //stabel/hidden/stack/-rotate //stabel/hidden/stack/!
                            """
                    in
                    expectTypeCheck input
            , test "With generics" <|
                \_ ->
                    let
                        input =
                            """
                            def: main
                            : 1 [ 1 //stabel/hidden/int/- ] map

                            def: map
                            type: a [ a -- b ] -- b
                            : //stabel/hidden/stack/!
                            """
                    in
                    expectTypeCheck input
            , test "Within multiwords" <|
                \_ ->
                    let
                        input =
................................................................................
                            : Nil

                            defstruct: Nil

                            defmulti: map
                            type: (Maybe a) [ a -- b ] -- (Maybe b)
                            : a

                              //stabel/hidden/stack/!
                            : Nil
                              //stabel/hidden/stack/drop

                            def: main
                            : Nil> [ 1 //stabel/hidden/int/- ] map
                            """
                    in
                    expectTypeCheck input
            ]
        , describe "Recursive word definitions"
            [ test "With type annotation" <|
                \_ ->
................................................................................

                            def: sum
                            : 0 sum-helper

                            defmulti: sum-helper
                            type: (List a) Int -- Int
                            : NonEmptyList
                              //stabel/hidden/stack/swap rest> //stabel/hidden/stack/swap 
                              1 //stabel/hidden/int/+
                              sum-helper
                            : EmptyList
                              //stabel/hidden/stack/swap //stabel/hidden/stack/drop

                            def: main
                            : 1 2 3 EmptyList> >NonEmptyList >NonEmptyList >NonEmptyList
                              sum
                            """
                    in
                    expectTypeCheck input
................................................................................
                    input =
                        """
                        def: main
                        : 1 2 drop-first

                        def: drop-first
                        type: a b -- b
                        : //stabel/hidden/stack/swap //stabel/hidden/stack/drop
                        """

                    dropFirstFn =
                        { name = "drop-first"
                        , type_ =
                            { input = [ Type.Generic "a", Type.Generic "b" ]
                            , output = [ Type.Generic "b" ]

Modified tests/Test/TypeChecker/Errors.elm from [92b4c5c362] to [895fa5cf85].

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
...
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
...
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
...
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
...
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
...
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
...
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
...
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
...
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
...
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
        , test "An inferred concrete output type should not successfully type check against a generic variable" <|
            \_ ->
                let
                    input =
                        """
                        def: main
                        type: in -- out
                        : 1 +
                        """

                    typeError problem =
                        case problem of
                            Problem.TypeError _ "main" _ _ ->
                                True

................................................................................
        , test "An inferred concrete input type should not successfully type check against a generic variable" <|
            \_ ->
                let
                    input =
                        """
                        def: main
                        type: in -- Int
                        : 1 +
                        """

                    typeError problem =
                        case problem of
                            Problem.TypeError _ "main" _ _ ->
                                True

................................................................................
                    input =
                        """
                        defstruct: Box a
                        : value a

                        def: box-inc
                        type: (Box a) -- Int
                        : value> 1 +

                        def: main
                        : 1 >Box box-inc
                        """

                    typeError problem =
                        case problem of
................................................................................
                        : Nothing

                        defstruct: Nothing

                        defmulti: maybe-inc
                        type: (Maybe a) -- Int
                        : a
                          1 +
                        : Nothing
                          drop 0

                        def: main
                        : 1 maybe-inc
                        """

                    typeError problem =
                        case problem of
................................................................................
                        def: main
                        type: -- out
                        : 0 true-or-false

                        defmulti: true-or-false
                        type: Int -- (Tmp a b)
                        : 0
                          drop False>
                        : Int
                          drop True>
                        """
                in
                Expect.equalLists
                    [ Problem.TypeError emptyRange
                        "main"
                        { input = [], output = [ Type.Generic "a" ] }
                        { input = []
................................................................................
                        input =
                            """
                            def: main
                            : 2 mword

                            defmulti: mword
                            : 1
                              1 +
                            """

                        inexhaustiveError problem =
                            case problem of
                                Problem.InexhaustiveMultiFunction _ [ [ Type.Int ] ] ->
                                    True

................................................................................
                        input =
                            """
                            def: main
                            : 2 mword

                            defmulti: mword
                            : 1
                              1 +
                            else: 
                              0 +
                            """
                    in
                    Util.expectTypeCheck input
            , test "Nested" <|
                \_ ->
                    let
                        input =
................................................................................

                            def: main
                            type: -- Int
                            : 1 >IntBox mword value>

                            defmulti: mword
                            : IntBox( value 1 )
                              value> 1 + >IntBox
                            """

                        inexhaustiveError problem =
                            case problem of
                                Problem.InexhaustiveMultiFunction _ [ [ Type.Custom "IntBox", Type.Int ] ] ->
                                    True

................................................................................
                            : value Int

                            def: main
                            : 2 >Box mword

                            defmulti: mword
                            : Box( value 1 )
                              drop 1
                            else: 
                              drop 0
                            """
                    in
                    Util.expectTypeCheck input
            , test "A total branch should remove any earlier seen branch" <|
                \_ ->
                    let
                        input =
                            """
                            def: main
                            : 2 mword

                            defmulti: mword
                            : 1
                              1 +
                            : Int
                              dup +
                            """
                    in
                    Util.expectTypeCheck input
            , test "A total branch should prevent addition of later partial branch" <|
                \_ ->
                    let
                        input =
                            """
                            def: main
                            : 2 mword

                            defmulti: mword
                            : Int
                              dup +
                            : 1
                              1 +
                            """
                    in
                    Util.expectTypeCheck input
            , test "Test with non-int type as pattern" <|
                \_ ->
                    let
                        input =
................................................................................
                            : value Int

                            defstruct: Nil

                            defmulti: with-default
                            type: (Maybe IntBox) Int -- Int
                            : IntBox( value 0 )
                              drop value>
                            : Nil
                              swap drop

                            def: main
                            : Nil> 1 with-default
                            """

                        inexhaustiveError problem =
                            case problem of







|







 







|







 







|







 







|

|







 







|

|







 







|







 







|

|







 







|







 







|

|













|

|













|

|







 







|

|







102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
...
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
...
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
...
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
...
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
...
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
...
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
...
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
...
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
...
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
        , test "An inferred concrete output type should not successfully type check against a generic variable" <|
            \_ ->
                let
                    input =
                        """
                        def: main
                        type: in -- out
                        : 1 //stabel/hidden/int/+
                        """

                    typeError problem =
                        case problem of
                            Problem.TypeError _ "main" _ _ ->
                                True

................................................................................
        , test "An inferred concrete input type should not successfully type check against a generic variable" <|
            \_ ->
                let
                    input =
                        """
                        def: main
                        type: in -- Int
                        : 1 //stabel/hidden/int/+
                        """

                    typeError problem =
                        case problem of
                            Problem.TypeError _ "main" _ _ ->
                                True

................................................................................
                    input =
                        """
                        defstruct: Box a
                        : value a

                        def: box-inc
                        type: (Box a) -- Int
                        : value> 1 //stabel/hidden/int/+

                        def: main
                        : 1 >Box box-inc
                        """

                    typeError problem =
                        case problem of
................................................................................
                        : Nothing

                        defstruct: Nothing

                        defmulti: maybe-inc
                        type: (Maybe a) -- Int
                        : a
                          1 //stabel/hidden/int/+
                        : Nothing
                          //stabel/hidden/stack/drop 0

                        def: main
                        : 1 maybe-inc
                        """

                    typeError problem =
                        case problem of
................................................................................
                        def: main
                        type: -- out
                        : 0 true-or-false

                        defmulti: true-or-false
                        type: Int -- (Tmp a b)
                        : 0
                          //stabel/hidden/stack/drop False>
                        : Int
                          //stabel/hidden/stack/drop True>
                        """
                in
                Expect.equalLists
                    [ Problem.TypeError emptyRange
                        "main"
                        { input = [], output = [ Type.Generic "a" ] }
                        { input = []
................................................................................
                        input =
                            """
                            def: main
                            : 2 mword

                            defmulti: mword
                            : 1
                              1 //stabel/hidden/int/+
                            """

                        inexhaustiveError problem =
                            case problem of
                                Problem.InexhaustiveMultiFunction _ [ [ Type.Int ] ] ->
                                    True

................................................................................
                        input =
                            """
                            def: main
                            : 2 mword

                            defmulti: mword
                            : 1
                              1 //stabel/hidden/int/+
                            else: 
                              0 //stabel/hidden/int/+
                            """
                    in
                    Util.expectTypeCheck input
            , test "Nested" <|
                \_ ->
                    let
                        input =
................................................................................

                            def: main
                            type: -- Int
                            : 1 >IntBox mword value>

                            defmulti: mword
                            : IntBox( value 1 )
                              value> 1 //stabel/hidden/int/+ >IntBox
                            """

                        inexhaustiveError problem =
                            case problem of
                                Problem.InexhaustiveMultiFunction _ [ [ Type.Custom "IntBox", Type.Int ] ] ->
                                    True

................................................................................
                            : value Int

                            def: main
                            : 2 >Box mword

                            defmulti: mword
                            : Box( value 1 )
                              //stabel/hidden/stack/drop 1
                            else: 
                              //stabel/hidden/stack/drop 0
                            """
                    in
                    Util.expectTypeCheck input
            , test "A total branch should remove any earlier seen branch" <|
                \_ ->
                    let
                        input =
                            """
                            def: main
                            : 2 mword

                            defmulti: mword
                            : 1
                              1 //stabel/hidden/int/+
                            : Int
                              //stabel/hidden/stack/dup //stabel/hidden/int/+
                            """
                    in
                    Util.expectTypeCheck input
            , test "A total branch should prevent addition of later partial branch" <|
                \_ ->
                    let
                        input =
                            """
                            def: main
                            : 2 mword

                            defmulti: mword
                            : Int
                              //stabel/hidden/stack/dup //stabel/hidden/int/+
                            : 1
                              1 //stabel/hidden/int/+
                            """
                    in
                    Util.expectTypeCheck input
            , test "Test with non-int type as pattern" <|
                \_ ->
                    let
                        input =
................................................................................
                            : value Int

                            defstruct: Nil

                            defmulti: with-default
                            type: (Maybe IntBox) Int -- Int
                            : IntBox( value 0 )
                              //stabel/hidden/stack/drop value>
                            : Nil
                              //stabel/hidden/stack/swap //stabel/hidden/stack/drop

                            def: main
                            : Nil> 1 with-default
                            """

                        inexhaustiveError problem =
                            case problem of

Modified tests/Test/TypeChecker/Unions.elm from [9a884413e9] to [637aadcad8].

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
..
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
...
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
...
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
...
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
...
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
...
291
292
293
294
295
296
297
298

299
        [ test "Simplest case" <|
            \_ ->
                let
                    input =
                        template ++ """
                        defmulti: to-int
                        : False
                          drop 0
                        : True
                          drop 1
                        """
                in
                expectTypeCheck input
        , test "With type signature" <|
            \_ ->
                let
                    input =
                        template ++ """
                        defmulti: to-int
                        type: Bool -- Int
                        : False
                          drop 0
                        : True
                          drop 1
                        """
                in
                expectTypeCheck input
        , test "With default branch" <|
            \_ ->
                let
                    input =
                        template ++ """
                        defmulti: to-int
                        type: Bool -- Int
                        : False
                          drop 0
                        else:
                          drop 1
                        """
                in
                expectTypeCheck input
        , test "With default branch (no type meta)" <|
            \_ ->
                let
                    input =
                        template ++ """
                        defmulti: to-int
                        : False
                          drop 0
                        else:
                          drop 1
                        """
                in
                expectTypeCheck input
        , test "When returning union" <|
            \_ ->
                let
                    input =
................................................................................
                        defstruct: Dog
                        : man-years Int

                        defmulti: add-to-age
                        : Person
                          >age
                        : Dog
                          4 * >man-years

                        defmulti: get-man-age
                        : Person
                          age>
                        : Dog
                          man-years>

................................................................................
                        : 18 >Person
                          10 add-to-age

                          0 >Dog
                          2 add-to-age

                          get-man-age
                          swap get-man-age
                          -
                        """
                in
                expectTypeCheck input
        , test "Function requiring a concrete type should not accept an union with that type" <|
            \_ ->
                let
                    input =
................................................................................
                        : False

                        defstruct: True
                        defstruct: False

                        defmulti: not
                        : True
                          drop False>
                        : False
                          drop True>

                        def: true-to-int
                        type: True -- Int
                        : drop 1

                        def: main
                        : True> not true-to-int
                        """
                in
                expectTypeCheckFailure input
        , test "Generic union" <|
................................................................................
                        : rest (List a)
                        
                        defstruct: EmptyList

                        defmulti: first-or-default
                        type: (List a) a -- a
                        : NonEmptyList
                          drop first>
                        : EmptyList
                          swap drop

                        def: main
                        : 1 EmptyList> >NonEmptyList
                          0 first-or-default
                          1 =
                        """
                in
                expectTypeCheck input
        , test "Union with generic branch" <|
            \_ ->
                let
                    input =
................................................................................
                        : Nil

                        defstruct: Nil

                        defmulti: with-default
                        type: (Maybe a) a -- a
                        : a
                          drop
                        : Nil
                          swap drop

                        def: main
                        : Nil> 1 with-default
                        """

                    nilTypeDef =
                        { name = "Nil"
................................................................................

    defstruct: True
    defstruct: False

    def: main
    : True> to-int
      False> to-int
      =

    """







|

|











|

|











|

|










|

|







 







|







 







|
|







 







|

|



|







 







|

|




|







 







|

|







 







<
>

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
..
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
...
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
...
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
...
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
...
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
...
291
292
293
294
295
296
297

298
299
        [ test "Simplest case" <|
            \_ ->
                let
                    input =
                        template ++ """
                        defmulti: to-int
                        : False
                          //stabel/hidden/stack/drop 0
                        : True
                          //stabel/hidden/stack/drop 1
                        """
                in
                expectTypeCheck input
        , test "With type signature" <|
            \_ ->
                let
                    input =
                        template ++ """
                        defmulti: to-int
                        type: Bool -- Int
                        : False
                          //stabel/hidden/stack/drop 0
                        : True
                          //stabel/hidden/stack/drop 1
                        """
                in
                expectTypeCheck input
        , test "With default branch" <|
            \_ ->
                let
                    input =
                        template ++ """
                        defmulti: to-int
                        type: Bool -- Int
                        : False
                          //stabel/hidden/stack/drop 0
                        else:
                          //stabel/hidden/stack/drop 1
                        """
                in
                expectTypeCheck input
        , test "With default branch (no type meta)" <|
            \_ ->
                let
                    input =
                        template ++ """
                        defmulti: to-int
                        : False
                          //stabel/hidden/stack/drop 0
                        else:
                          //stabel/hidden/stack/drop 1
                        """
                in
                expectTypeCheck input
        , test "When returning union" <|
            \_ ->
                let
                    input =
................................................................................
                        defstruct: Dog
                        : man-years Int

                        defmulti: add-to-age
                        : Person
                          >age
                        : Dog
                          4 //stabel/hidden/int/* >man-years

                        defmulti: get-man-age
                        : Person
                          age>
                        : Dog
                          man-years>

................................................................................
                        : 18 >Person
                          10 add-to-age

                          0 >Dog
                          2 add-to-age

                          get-man-age
                          //stabel/hidden/stack/swap get-man-age
                          //stabel/hidden/int/-
                        """
                in
                expectTypeCheck input
        , test "Function requiring a concrete type should not accept an union with that type" <|
            \_ ->
                let
                    input =
................................................................................
                        : False

                        defstruct: True
                        defstruct: False

                        defmulti: not
                        : True
                          //stabel/hidden/stack/drop False>
                        : False
                          //stabel/hidden/stack/drop True>

                        def: true-to-int
                        type: True -- Int
                        : //stabel/hidden/stack/drop 1

                        def: main
                        : True> not true-to-int
                        """
                in
                expectTypeCheckFailure input
        , test "Generic union" <|
................................................................................
                        : rest (List a)
                        
                        defstruct: EmptyList

                        defmulti: first-or-default
                        type: (List a) a -- a
                        : NonEmptyList
                          //stabel/hidden/stack/drop first>
                        : EmptyList
                          //stabel/hidden/stack/swap //stabel/hidden/stack/drop

                        def: main
                        : 1 EmptyList> >NonEmptyList
                          0 first-or-default
                          1 //stabel/hidden/int/=
                        """
                in
                expectTypeCheck input
        , test "Union with generic branch" <|
            \_ ->
                let
                    input =
................................................................................
                        : Nil

                        defstruct: Nil

                        defmulti: with-default
                        type: (Maybe a) a -- a
                        : a
                          //stabel/hidden/stack/drop
                        : Nil
                          //stabel/hidden/stack/swap //stabel/hidden/stack/drop

                        def: main
                        : Nil> 1 with-default
                        """

                    nilTypeDef =
                        { name = "Nil"
................................................................................

    defstruct: True
    defstruct: False

    def: main
    : True> to-int
      False> to-int

      //stabel/hidden/int/=
    """

Modified tests/Test/TypeChecker/Util.elm from [8681f7b1fd] to [657b64e217].

100
101
102
103
104
105
106
107
108

109
110
111
112
113
114
115
116
117
118
119
        Err err ->
            Err <| "Parse error: " ++ Debug.toString err

        Ok parserAst ->
            let
                qualifierResult =
                    Qualifier.run
                        { packageName = ""
                        , modulePath = ""

                        , ast = parserAst
                        , externalModules = Dict.empty
                        , inProgressAST = QualifierUtil.emptyAst
                        }
            in
            case qualifierResult of
                Err err ->
                    Err <| "Qualifier error: " ++ Debug.toString err

                Ok qualifiedAst ->
                    Ok <| QualifierUtil.stripLocations qualifiedAst







|
|
>











100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
        Err err ->
            Err <| "Parse error: " ++ Debug.toString err

        Ok parserAst ->
            let
                qualifierResult =
                    Qualifier.run
                        { packageName = "stabel/standard_library"
                        , modulePath = "core"
                        , mangle = False
                        , ast = parserAst
                        , externalModules = Dict.empty
                        , inProgressAST = QualifierUtil.emptyAst
                        }
            in
            case qualifierResult of
                Err err ->
                    Err <| "Qualifier error: " ++ Debug.toString err

                Ok qualifiedAst ->
                    Ok <| QualifierUtil.stripLocations qualifiedAst