Play

Check-in [de94b48dd2]
Login
Overview
Comment:Qualifier now understands unions and multifunctions.
Timelines: family | ancestors | descendants | both | unions
Files: files | file ages | folders
SHA3-256: de94b48dd24f27803767ff21d3561279f58924bd5d8d20640a1919b7e3f278dd
User & Date: robin.hansen on 2020-04-15 17:28:01
Other Links: branch diff | manifest | tags
Context
2020-04-16
18:16
Type checker now mirrors the types it receives from the qualifier, which is a preqrequisite to reaso... check-in: e327cad8b2 user: robin.hansen tags: unions
2020-04-15
17:28
Qualifier now understands unions and multifunctions. check-in: de94b48dd2 user: robin.hansen tags: unions
14:50
Merge in trunk, where the changes that were supposed to happen on this branch are. check-in: 596089c9b6 user: robin.hansen tags: unions
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified src/Play/Qualifier.elm from [b95e559676] to [45f8a7a1f1].

10
11
12
13
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28





29
30
31
32
33
34
35
..
82
83
84
85
86
87
88
89
90
91
92
93
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
...
165
166
167
168
169
170
171











type alias AST =
    { types : Dict String TypeDefinition
    , words : Dict String WordDefinition
    }


type alias TypeDefinition =
    { name : String
    , members : List ( String, Type )
    }



type alias WordDefinition =
    { name : String
    , metadata : Metadata
    , implementation : List Node
    }







type Node
    = Integer Int
    | Word String
    | ConstructType String
    | GetMember String String
    | SetMember String String
................................................................................
    -> Parser.TypeDefinition
    -> ( List (), Dict String TypeDefinition )
    -> ( List (), Dict String TypeDefinition )
qualifyType ast typeDef ( errors, acc ) =
    ( errors
    , case typeDef of
        Parser.CustomTypeDef name members ->
            Dict.insert name { name = name, members = members } acc

        _ ->
            acc
    )


qualifyDefinition :
    Parser.AST
    -> Parser.WordDefinition
    -> ( List (), Dict String WordDefinition )
    -> ( List (), Dict String WordDefinition )
qualifyDefinition ast unqualifiedWord ( errors, acc ) =
    let





        qualifiedImplementationResult =
            unqualifiedWord.implementation
                |> List.map (qualifyNode ast)
                |> Result.combine
    in
    case qualifiedImplementationResult of
        Err () ->
            ( () :: errors
            , acc
            )

        Ok qualifiedImplementation ->
            ( errors
            , Dict.insert unqualifiedWord.name
                { name = unqualifiedWord.name
                , metadata = qualifyMetadata unqualifiedWord.name unqualifiedWord.metadata


                , implementation = qualifiedImplementation



                }
                acc
            )























qualifyNode : Parser.AST -> Parser.AstNode -> Result () Node
qualifyNode ast node =
    case node of
        Parser.Integer value ->
            Ok (Integer value)

................................................................................
qualifyMetadataType baseName type_ =
    case type_ of
        Type.Generic id ->
            Type.Generic (id ++ "_" ++ baseName)

        _ ->
            type_

















|
<
|
<
>





|


>
>
>
>
>







 







|

|
|










>
>
>
>
>





|
<
<
<
<
<
|




>
>
|
>
>
>




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







 







>
>
>
>
>
>
>
>
>
>
10
11
12
13
14
15
16
17

18

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
..
86
87
88
89
90
91
92
93
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
...
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211

type alias AST =
    { types : Dict String TypeDefinition
    , words : Dict String WordDefinition
    }


type TypeDefinition

    = CustomTypeDef String (List ( String, Type ))

    | UnionTypeDef String (List Type)


type alias WordDefinition =
    { name : String
    , metadata : Metadata
    , implementation : WordImplementation
    }


type WordImplementation
    = SoloImpl (List Node)
    | MultiImpl (List ( Type, List Node )) (List Node)


type Node
    = Integer Int
    | Word String
    | ConstructType String
    | GetMember String String
    | SetMember String String
................................................................................
    -> Parser.TypeDefinition
    -> ( List (), Dict String TypeDefinition )
    -> ( List (), Dict String TypeDefinition )
qualifyType ast typeDef ( errors, acc ) =
    ( errors
    , case typeDef of
        Parser.CustomTypeDef name members ->
            Dict.insert name (CustomTypeDef name members) acc

        Parser.UnionTypeDef name memberTypes ->
            Dict.insert name (UnionTypeDef name memberTypes) acc
    )


qualifyDefinition :
    Parser.AST
    -> Parser.WordDefinition
    -> ( List (), Dict String WordDefinition )
    -> ( List (), Dict String WordDefinition )
qualifyDefinition ast unqualifiedWord ( errors, acc ) =
    let
        qualifiedWhensResult =
            unqualifiedWord.whens
                |> List.map (qualifyWhen ast)
                |> Result.combine

        qualifiedImplementationResult =
            unqualifiedWord.implementation
                |> List.map (qualifyNode ast)
                |> Result.combine
    in
    case ( qualifiedWhensResult, qualifiedImplementationResult ) of





        ( Ok qualifiedWhens, Ok qualifiedImplementation ) ->
            ( errors
            , Dict.insert unqualifiedWord.name
                { name = unqualifiedWord.name
                , metadata = qualifyMetadata unqualifiedWord.name unqualifiedWord.metadata
                , implementation =
                    if List.isEmpty qualifiedWhens then
                        SoloImpl qualifiedImplementation

                    else
                        MultiImpl qualifiedWhens qualifiedImplementation
                }
                acc
            )

        _ ->
            ( () :: errors
            , acc
            )


qualifyWhen : Parser.AST -> ( Type, List Parser.AstNode ) -> Result () ( Type, List Node )
qualifyWhen ast ( type_, impl ) =
    let
        qualifiedImplementationResult =
            impl
                |> List.map (qualifyNode ast)
                |> Result.combine
    in
    case qualifiedImplementationResult of
        Err () ->
            Err ()

        Ok qualifiedImplementation ->
            Ok ( type_, qualifiedImplementation )


qualifyNode : Parser.AST -> Parser.AstNode -> Result () Node
qualifyNode ast node =
    case node of
        Parser.Integer value ->
            Ok (Integer value)

................................................................................
qualifyMetadataType baseName type_ =
    case type_ of
        Type.Generic id ->
            Type.Generic (id ++ "_" ++ baseName)

        _ ->
            type_


typeDefinitionName : TypeDefinition -> String
typeDefinitionName typeDef =
    case typeDef of
        CustomTypeDef name _ ->
            name

        UnionTypeDef name _ ->
            name

Modified src/Play/TypeChecker.elm from [1a594e14f7] to [dd06d5f723].

1
2
3

4
5
6
7
8
9
10
..
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
..
51
52
53
54
55
56
57


58













59
60
61
62
63
64
65
..
73
74
75
76
77
78
79














80
81
82
83
84
85
86
87
88
89
90
..
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
module Play.TypeChecker exposing (..)

import Dict exposing (Dict)

import List.Extra as List
import Play.Data.Builtin as Builtin exposing (Builtin)
import Play.Data.Metadata exposing (Metadata)
import Play.Data.Type as Type exposing (Type, WordType)
import Play.Qualifier as Qualifier
import Set exposing (Set)

................................................................................
    | ConstructType String
    | SetMember String String Type
    | GetMember String String Type
    | Builtin Builtin


type alias Context =
    { types : Dict String Qualifier.TypeDefinition
    , typedWords : Dict String WordDefinition
    , untypedWords : Dict String Qualifier.WordDefinition
    , stackEffects : List StackEffect
    , boundGenerics : Dict String Type
    , errors : List ()
    }

................................................................................
type StackEffect
    = Push Type
    | Pop Type


initContext : Qualifier.AST -> Context
initContext ast =


    { types = ast.types













    , typedWords = Dict.empty
    , untypedWords = ast.words
    , stackEffects = []
    , boundGenerics = Dict.empty
    , errors = []
    }

................................................................................
typeCheckHelper context ast =
    let
        updatedContext =
            ast
                |> .words
                |> Dict.values
                |> List.foldl typeCheckDefinition context














    in
    if List.isEmpty updatedContext.errors then
        Ok <|
            { types = ast.types
            , words = updatedContext.typedWords
            }

    else
        Err ()


................................................................................
    in
    case Dict.get untypedDef.name context.typedWords of
        Just _ ->
            cleanContext

        Nothing ->
            let








                contextWithStackEffects =
                    List.foldl typeCheckNode cleanContext untypedDef.implementation

                ( contextAfterWordTypeInduction, wordType ) =
                    wordTypeFromStackEffects contextWithStackEffects
                        |> simplifyWordType untypedDef.name

                finalContext =
                    { contextAfterWordTypeInduction
                        | typedWords =
                            Dict.insert untypedDef.name
                                { name = untypedDef.name
                                , type_ = wordType
                                , metadata = untypedDef.metadata
                                , implementation = List.map (untypedToTypedNode contextAfterWordTypeInduction) untypedDef.implementation
                                }
                                contextAfterWordTypeInduction.typedWords
                        , boundGenerics = Dict.empty
                        , stackEffects = []
                    }
            in
            case untypedDef.metadata.type_ of



>







 







|







 







>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>







 







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



|







 







>
>
>
>
>
>
>
>

|












|







1
2
3
4
5
6
7
8
9
10
11
..
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
..
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
..
89
90
91
92
93
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
...
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
module Play.TypeChecker exposing (..)

import Dict exposing (Dict)
import Dict.Extra as Dict
import List.Extra as List
import Play.Data.Builtin as Builtin exposing (Builtin)
import Play.Data.Metadata exposing (Metadata)
import Play.Data.Type as Type exposing (Type, WordType)
import Play.Qualifier as Qualifier
import Set exposing (Set)

................................................................................
    | ConstructType String
    | SetMember String String Type
    | GetMember String String Type
    | Builtin Builtin


type alias Context =
    { types : Dict String TypeDefinition
    , typedWords : Dict String WordDefinition
    , untypedWords : Dict String Qualifier.WordDefinition
    , stackEffects : List StackEffect
    , boundGenerics : Dict String Type
    , errors : List ()
    }

................................................................................
type StackEffect
    = Push Type
    | Pop Type


initContext : Qualifier.AST -> Context
initContext ast =
    let
        concreteTypes =
            ast.types
                |> Dict.values
                |> List.map
                    (\t ->
                        case t of
                            Qualifier.CustomTypeDef name members ->
                                { name = name, members = members }

                            Qualifier.UnionTypeDef name _ ->
                                { name = name, members = [] }
                    )
                |> Dict.fromListBy .name
    in
    { types = concreteTypes
    , typedWords = Dict.empty
    , untypedWords = ast.words
    , stackEffects = []
    , boundGenerics = Dict.empty
    , errors = []
    }

................................................................................
typeCheckHelper context ast =
    let
        updatedContext =
            ast
                |> .words
                |> Dict.values
                |> List.foldl typeCheckDefinition context

        concreteTypes =
            ast.types
                |> Dict.values
                |> List.map
                    (\t ->
                        case t of
                            Qualifier.CustomTypeDef name members ->
                                { name = name, members = members }

                            Qualifier.UnionTypeDef name _ ->
                                { name = name, members = [] }
                    )
                |> Dict.fromListBy .name
    in
    if List.isEmpty updatedContext.errors then
        Ok <|
            { types = concreteTypes
            , words = updatedContext.typedWords
            }

    else
        Err ()


................................................................................
    in
    case Dict.get untypedDef.name context.typedWords of
        Just _ ->
            cleanContext

        Nothing ->
            let
                impl =
                    case untypedDef.implementation of
                        Qualifier.SoloImpl impl_ ->
                            impl_

                        Qualifier.MultiImpl _ impl_ ->
                            impl_

                contextWithStackEffects =
                    List.foldl typeCheckNode cleanContext impl

                ( contextAfterWordTypeInduction, wordType ) =
                    wordTypeFromStackEffects contextWithStackEffects
                        |> simplifyWordType untypedDef.name

                finalContext =
                    { contextAfterWordTypeInduction
                        | typedWords =
                            Dict.insert untypedDef.name
                                { name = untypedDef.name
                                , type_ = wordType
                                , metadata = untypedDef.metadata
                                , implementation = List.map (untypedToTypedNode contextAfterWordTypeInduction) impl
                                }
                                contextAfterWordTypeInduction.typedWords
                        , boundGenerics = Dict.empty
                        , stackEffects = []
                    }
            in
            case untypedDef.metadata.type_ of

Modified tests/Test/Qualifier.elm from [f3a1b75cbc] to [e201a0ca8e].

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
86
87
88
89
90
91
92
93
...
127
128
129
130
131
132
133

134
135
136
137




























































































138
139
140
141
142
143
144
145
146
147
148
                    expectedAst =
                        { types = Dict.empty
                        , words =
                            Dict.fromListBy .name
                                [ { name = "inc"
                                  , metadata = Metadata.default
                                  , implementation =

                                        [ Integer 1
                                        , Builtin Builtin.Plus
                                        ]
                                  }
                                , { name = "dec"
                                  , metadata = Metadata.default
                                  , implementation =

                                        [ Integer 1
                                        , Builtin Builtin.Minus
                                        ]
                                  }
                                , { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.asEntryPoint
                                  , implementation =

                                        [ Integer 1
                                        , Word "inc"
                                        , Word "inc"
                                        , Word "dec"
                                        , Integer 2
                                        , Builtin Builtin.Equal
                                        ]
                                  }
                                ]
                        }
                in
                case qualify unqualifiedAst of
                    Err () ->
                        Expect.fail "Did not expect qualification to fail"
................................................................................
                                            |> Metadata.withType
                                                [ Type.Generic "a_over", Type.Generic "b_over" ]
                                                [ Type.Generic "a_over"
                                                , Type.Generic "b_over"
                                                , Type.Generic "a_over"
                                                ]
                                  , implementation =

                                        [ Builtin Builtin.StackSwap
                                        , Builtin Builtin.StackDuplicate
                                        , Builtin Builtin.StackRightRotate
                                        ]




























































































                                  }
                                ]
                        }
                in
                case qualify unqualifiedAst of
                    Err () ->
                        Expect.fail "Did not expect qualification to fail"

                    Ok qualifiedAst ->
                        Expect.equal expectedAst qualifiedAst
        ]







>
|
|
|




>
|
|
|






>
|
|
|
|
|
|
|







 







>
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>











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
86
87
88
89
90
91
92
93
94
95
96
...
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
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
                    expectedAst =
                        { types = Dict.empty
                        , words =
                            Dict.fromListBy .name
                                [ { name = "inc"
                                  , metadata = Metadata.default
                                  , implementation =
                                        SoloImpl
                                            [ Integer 1
                                            , Builtin Builtin.Plus
                                            ]
                                  }
                                , { name = "dec"
                                  , metadata = Metadata.default
                                  , implementation =
                                        SoloImpl
                                            [ Integer 1
                                            , Builtin Builtin.Minus
                                            ]
                                  }
                                , { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.asEntryPoint
                                  , implementation =
                                        SoloImpl
                                            [ Integer 1
                                            , Word "inc"
                                            , Word "inc"
                                            , Word "dec"
                                            , Integer 2
                                            , Builtin Builtin.Equal
                                            ]
                                  }
                                ]
                        }
                in
                case qualify unqualifiedAst of
                    Err () ->
                        Expect.fail "Did not expect qualification to fail"
................................................................................
                                            |> Metadata.withType
                                                [ Type.Generic "a_over", Type.Generic "b_over" ]
                                                [ Type.Generic "a_over"
                                                , Type.Generic "b_over"
                                                , Type.Generic "a_over"
                                                ]
                                  , implementation =
                                        SoloImpl
                                            [ Builtin Builtin.StackSwap
                                            , Builtin Builtin.StackDuplicate
                                            , Builtin Builtin.StackRightRotate
                                            ]
                                  }
                                ]
                        }
                in
                case qualify unqualifiedAst of
                    Err () ->
                        Expect.fail "Did not expect qualification to fail"

                    Ok qualifiedAst ->
                        Expect.equal expectedAst qualifiedAst
        , test "Union types and multifunctions" <|
            \_ ->
                let
                    unqualifiedAst =
                        { types =
                            Dict.fromListBy AST.typeDefinitionName
                                [ AST.UnionTypeDef "Bool"
                                    [ Type.Custom "True"
                                    , Type.Custom "False"
                                    ]
                                , AST.CustomTypeDef "True" []
                                , AST.CustomTypeDef "False" []
                                ]
                        , words =
                            Dict.fromListBy .name
                                [ { name = ">True"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [] [ Type.Custom "True" ]
                                  , whens = []
                                  , implementation =
                                        [ AST.ConstructType "True"
                                        ]
                                  }
                                , { name = ">False"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [] [ Type.Custom "False" ]
                                  , whens = []
                                  , implementation =
                                        [ AST.ConstructType "False"
                                        ]
                                  }
                                , { name = "to-int"
                                  , metadata = Metadata.default
                                  , whens =
                                        [ ( Type.Custom "False", [ AST.Integer 0 ] )
                                        , ( Type.Custom "True", [ AST.Integer 1 ] )
                                        ]
                                  , implementation = []
                                  }
                                ]
                        }

                    expectedAst =
                        { types =
                            Dict.fromListBy typeDefinitionName
                                [ UnionTypeDef "Bool"
                                    [ Type.Custom "True"
                                    , Type.Custom "False"
                                    ]
                                , CustomTypeDef "True" []
                                , CustomTypeDef "False" []
                                ]
                        , words =
                            Dict.fromListBy .name
                                [ { name = ">True"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [] [ Type.Custom "True" ]
                                  , implementation =
                                        SoloImpl
                                            [ ConstructType "True"
                                            ]
                                  }
                                , { name = ">False"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [] [ Type.Custom "False" ]
                                  , implementation =
                                        SoloImpl
                                            [ ConstructType "False"
                                            ]
                                  }
                                , { name = "to-int"
                                  , metadata = Metadata.default
                                  , implementation =
                                        MultiImpl
                                            [ ( Type.Custom "False", [ Integer 0 ] )
                                            , ( Type.Custom "True", [ Integer 1 ] )
                                            ]
                                            []
                                  }
                                ]
                        }
                in
                case qualify unqualifiedAst of
                    Err () ->
                        Expect.fail "Did not expect qualification to fail"

                    Ok qualifiedAst ->
                        Expect.equal expectedAst qualifiedAst
        ]

Modified tests/Test/TypeChecker.elm from [d1288728ad] to [60913b19eb].

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
...
102
103
104
105
106
107
108

109
110
111
112
113
114
115
116
117
118
119
...
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


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
...
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
...
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
                    input =
                        { types = Dict.empty
                        , words =
                            Dict.fromListBy .name
                                [ { name = "inc"
                                  , metadata = Metadata.default
                                  , implementation =

                                        [ QAST.Integer 1
                                        , QAST.Builtin Builtin.Plus
                                        ]
                                  }
                                , { name = "dec"
                                  , metadata = Metadata.default
                                  , implementation =

                                        [ QAST.Integer 1
                                        , QAST.Builtin Builtin.Minus
                                        ]
                                  }
                                , { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.asEntryPoint
                                  , implementation =

                                        [ QAST.Integer 1
                                        , QAST.Word "inc"
                                        , QAST.Word "inc"
                                        , QAST.Word "dec"
                                        , QAST.Integer 2
                                        , QAST.Builtin Builtin.Equal
                                        ]
                                  }
                                ]
                        }

                    expectedResult =
                        { types = Dict.empty
                        , words =
................................................................................
                        , words =
                            Dict.fromListBy .name
                                [ { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Int ] []
                                  , implementation =

                                        [ QAST.Integer 1
                                        , QAST.Integer 2
                                        , QAST.Builtin Builtin.Equal
                                        ]
                                  }
                                ]
                        }
                in
                case typeCheck input of
                    Err () ->
                        Expect.pass
................................................................................
                    Ok _ ->
                        Expect.fail "Did not expect type check to succeed."
        , test "Custom data structure without fields" <|
            \_ ->
                let
                    source =
                        { types =
                            Dict.fromList
                                [ ( "True"
                                  , { name = "True"
                                    , members = []
                                    }
                                  )
                                ]
                        , words =
                            Dict.fromList
                                [ ( ">True"
                                  , { name = ">True"
                                    , metadata =
                                        Metadata.default
                                            |> Metadata.withType [] [ Type.Custom "True" ]


                                    , implementation = [ QAST.ConstructType "True" ]
                                    }
                                  )
                                , ( "as-int"
                                  , { name = "as-int"
                                    , metadata =
                                        Metadata.default
                                            |> Metadata.withType [] [ Type.Int ]
                                    , implementation =

                                        [ QAST.Integer 1
                                        ]
                                    }
                                  )
                                , ( "main"
                                  , { name = "main"
                                    , metadata =
                                        Metadata.default
                                            |> Metadata.asEntryPoint
                                    , implementation =

                                        [ QAST.Word ">True"
                                        , QAST.Word "as-int"
                                        ]
                                    }
                                  )
                                ]
                        }
                in
                case typeCheck source of
                    Err () ->
                        Expect.fail "Did not expect type check to fail"

................................................................................
                    Ok _ ->
                        Expect.pass
        , test "Custom data structure with fields" <|
            \_ ->
                let
                    source =
                        { types =
                            Dict.fromList
                                [ ( "Person"
                                  , { name = "Person"
                                    , members = [ ( "age", Type.Int ) ]
                                    }
                                  )
                                ]
                        , words =
                            Dict.fromList
                                [ ( ">Person"
                                  , { name = ">Person"
                                    , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Int ] [ Type.Custom "Person" ]


                                    , implementation = [ QAST.ConstructType "Person" ]
                                    }
                                  )
                                , ( ">age"
                                  , { name = ">age"
                                    , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Custom "Person", Type.Int ] [ Type.Custom "Person" ]


                                    , implementation = [ QAST.SetMember "Person" "age" ]
                                    }
                                  )
                                , ( "age>"
                                  , { name = "age>"
                                    , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Custom "Person" ] [ Type.Int ]


                                    , implementation = [ QAST.GetMember "Person" "age" ]
                                    }
                                  )
                                , ( "inc-age"
                                  , { name = "inc-age"
                                    , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Custom "Person" ] [ Type.Custom "Person" ]
                                    , implementation =

                                        [ QAST.Word "age>"
                                        , QAST.Integer 1
                                        , QAST.Builtin Builtin.Plus
                                        , QAST.Word ">Person"
                                        ]
                                    }
                                  )
                                , ( "main"
                                  , { name = "main"
                                    , metadata =
                                        Metadata.default
                                            |> Metadata.asEntryPoint
                                    , implementation =

                                        [ QAST.Integer 1
                                        , QAST.Word ">Person"
                                        , QAST.Word "inc-age"
                                        , QAST.Word "age>"
                                        ]
                                    }
                                  )
                                ]
                        }
                in
                case typeCheck source of
                    Err () ->
                        Expect.fail "Did not expect type check to fail"

................................................................................
                        , words =
                            Dict.fromListBy .name
                                [ { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [] [ Type.Int ]
                                  , implementation =

                                        [ QAST.Integer 1
                                        , QAST.Integer 2
                                        , QAST.Word "over"
                                        , QAST.Builtin Builtin.Plus
                                        , QAST.Builtin Builtin.Minus
                                        , QAST.Integer 2
                                        , QAST.Builtin Builtin.Equal
                                        ]
                                  }
                                , { name = "over"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType
                                                -- Most would start at a and increment, but we need to check that
                                                -- the typechecker cares about the relationship between these generic
                                                -- variables, not the names themselves
                                                [ Type.Generic "b_over", Type.Generic "c_over" ]
                                                [ Type.Generic "b_over", Type.Generic "c_over", Type.Generic "b_over" ]
                                  , implementation =

                                        [ QAST.Builtin Builtin.StackSwap
                                        , QAST.Builtin Builtin.StackDuplicate
                                        , QAST.Builtin Builtin.StackRightRotate
                                        ]
                                  }
                                ]
                        }
                in
                case typeCheck input of
                    Err () ->
                        Expect.fail "Did not expect type check to fail."
................................................................................
                        , words =
                            Dict.fromListBy .name
                                [ { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [] [ Type.Int ]
                                  , implementation =

                                        [ QAST.Integer 5
                                        , QAST.Word "square"
                                        ]
                                  }
                                , { name = "square"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Int ] [ Type.Int ]
                                  , implementation =

                                        [ QAST.Builtin Builtin.StackDuplicate
                                        , QAST.Builtin Builtin.Multiply
                                        ]
                                  }
                                ]
                        }
                in
                case typeCheck input of
                    Err () ->
                        Expect.fail "Did not expect type check to fail."

                    Ok _ ->
                        Expect.pass
        ]







>
|
|
|




>
|
|
|






>
|
|
|
|
|
|
|







 







>
|
|
|
|







 







|
|
<
<
<
<


|
<
|
|


>
>
|
|
<
<
|
|


|
>
|
|
|
<
<
|
|


|
>
|
|
|
|
<







 







|
<
<
|
<
<


|
<
|
|


>
>
|
|
<
<
|
|


>
>
|
|
<
<
|
|


>
>
|
|
<
<
|
|


|
>
|
|
|
|
|
|
<
<
|
|


|
>
|
|
|
|
|
|
<







 







>
|
|
|
|
|
|
|
|











>
|
|
|
|







 







>
|
|
|






>
|
|
|











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
...
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
...
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
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
...
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
...
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
                    input =
                        { types = Dict.empty
                        , words =
                            Dict.fromListBy .name
                                [ { name = "inc"
                                  , metadata = Metadata.default
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.Integer 1
                                            , QAST.Builtin Builtin.Plus
                                            ]
                                  }
                                , { name = "dec"
                                  , metadata = Metadata.default
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.Integer 1
                                            , QAST.Builtin Builtin.Minus
                                            ]
                                  }
                                , { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.asEntryPoint
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.Integer 1
                                            , QAST.Word "inc"
                                            , QAST.Word "inc"
                                            , QAST.Word "dec"
                                            , QAST.Integer 2
                                            , QAST.Builtin Builtin.Equal
                                            ]
                                  }
                                ]
                        }

                    expectedResult =
                        { types = Dict.empty
                        , words =
................................................................................
                        , words =
                            Dict.fromListBy .name
                                [ { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Int ] []
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.Integer 1
                                            , QAST.Integer 2
                                            , QAST.Builtin Builtin.Equal
                                            ]
                                  }
                                ]
                        }
                in
                case typeCheck input of
                    Err () ->
                        Expect.pass
................................................................................
                    Ok _ ->
                        Expect.fail "Did not expect type check to succeed."
        , test "Custom data structure without fields" <|
            \_ ->
                let
                    source =
                        { types =
                            Dict.fromListBy QAST.typeDefinitionName
                                [ QAST.CustomTypeDef "True" []




                                ]
                        , words =
                            Dict.fromListBy .name

                                [ { name = ">True"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [] [ Type.Custom "True" ]
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.ConstructType "True" ]
                                  }


                                , { name = "as-int"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [] [ Type.Int ]
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.Integer 1
                                            ]
                                  }


                                , { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.asEntryPoint
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.Word ">True"
                                            , QAST.Word "as-int"
                                            ]
                                  }

                                ]
                        }
                in
                case typeCheck source of
                    Err () ->
                        Expect.fail "Did not expect type check to fail"

................................................................................
                    Ok _ ->
                        Expect.pass
        , test "Custom data structure with fields" <|
            \_ ->
                let
                    source =
                        { types =
                            Dict.fromListBy QAST.typeDefinitionName


                                [ QAST.CustomTypeDef "Person" [ ( "age", Type.Int ) ]


                                ]
                        , words =
                            Dict.fromListBy .name

                                [ { name = ">Person"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Int ] [ Type.Custom "Person" ]
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.ConstructType "Person" ]
                                  }


                                , { name = ">age"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Custom "Person", Type.Int ] [ Type.Custom "Person" ]
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.SetMember "Person" "age" ]
                                  }


                                , { name = "age>"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Custom "Person" ] [ Type.Int ]
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.GetMember "Person" "age" ]
                                  }


                                , { name = "inc-age"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Custom "Person" ] [ Type.Custom "Person" ]
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.Word "age>"
                                            , QAST.Integer 1
                                            , QAST.Builtin Builtin.Plus
                                            , QAST.Word ">Person"
                                            ]
                                  }


                                , { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.asEntryPoint
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.Integer 1
                                            , QAST.Word ">Person"
                                            , QAST.Word "inc-age"
                                            , QAST.Word "age>"
                                            ]
                                  }

                                ]
                        }
                in
                case typeCheck source of
                    Err () ->
                        Expect.fail "Did not expect type check to fail"

................................................................................
                        , words =
                            Dict.fromListBy .name
                                [ { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [] [ Type.Int ]
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.Integer 1
                                            , QAST.Integer 2
                                            , QAST.Word "over"
                                            , QAST.Builtin Builtin.Plus
                                            , QAST.Builtin Builtin.Minus
                                            , QAST.Integer 2
                                            , QAST.Builtin Builtin.Equal
                                            ]
                                  }
                                , { name = "over"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType
                                                -- Most would start at a and increment, but we need to check that
                                                -- the typechecker cares about the relationship between these generic
                                                -- variables, not the names themselves
                                                [ Type.Generic "b_over", Type.Generic "c_over" ]
                                                [ Type.Generic "b_over", Type.Generic "c_over", Type.Generic "b_over" ]
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.Builtin Builtin.StackSwap
                                            , QAST.Builtin Builtin.StackDuplicate
                                            , QAST.Builtin Builtin.StackRightRotate
                                            ]
                                  }
                                ]
                        }
                in
                case typeCheck input of
                    Err () ->
                        Expect.fail "Did not expect type check to fail."
................................................................................
                        , words =
                            Dict.fromListBy .name
                                [ { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [] [ Type.Int ]
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.Integer 5
                                            , QAST.Word "square"
                                            ]
                                  }
                                , { name = "square"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Int ] [ Type.Int ]
                                  , implementation =
                                        QAST.SoloImpl
                                            [ QAST.Builtin Builtin.StackDuplicate
                                            , QAST.Builtin Builtin.Multiply
                                            ]
                                  }
                                ]
                        }
                in
                case typeCheck input of
                    Err () ->
                        Expect.fail "Did not expect type check to fail."

                    Ok _ ->
                        Expect.pass
        ]