Stabel

Check-in [d3329c2b01]
Login
Overview
Comment:Play now supports compund types.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: d3329c2b01989256e74b0a475e808ddecad0ffe0b84d924ec5f99454bfe08f6f
User & Date: robin.hansen on 2020-04-05 16:06:11
Other Links: manifest | tags
Context
2020-04-10
12:21
Add support for stack manipulation functions and generic function types. check-in: 32f58d1269 user: robin.hansen tags: trunk
2020-04-07
08:38
Create new branch named "stack-manipulation" check-in: 4c2f5c9ed9 user: robin.hansen tags: stack-manipulation
2020-04-05
16:06
Play now supports compund types. check-in: d3329c2b01 user: robin.hansen tags: trunk
16:03
Setters now creates a copy of a struct before modifying. Closed-Leaf check-in: e34021aa10 user: robin.hansen tags: user-defined-types
2020-03-26
17:24
Type check now fails if user provided type annotation doesn't match the inferred type. check-in: c9642fb514 user: robin.hansen tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified elm.json from [76c092f4ff] to [13869794f7].

4
5
6
7
8
9
10

11
12
13
14
15
16
17
        "src"
    ],
    "elm-version": "0.19.1",
    "dependencies": {
        "direct": {
            "elm/core": "1.0.5",
            "elm/html": "1.0.0",

            "elm-community/list-extra": "8.2.3",
            "elm-community/result-extra": "2.4.0"
        },
        "indirect": {
            "elm/json": "1.1.3",
            "elm/virtual-dom": "1.0.2"
        }







>







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
        "src"
    ],
    "elm-version": "0.19.1",
    "dependencies": {
        "direct": {
            "elm/core": "1.0.5",
            "elm/html": "1.0.0",
            "elm-community/dict-extra": "2.4.0",
            "elm-community/list-extra": "8.2.3",
            "elm-community/result-extra": "2.4.0"
        },
        "indirect": {
            "elm/json": "1.1.3",
            "elm/virtual-dom": "1.0.2"
        }

Modified src/Play/Codegen.elm from [b656d9e0b0] to [aec5a26ca2].

1
2

3

4
5
6






7
8
9
10
11
12
13
14
15
16


17


















18
19










20
21
22
23
24
25
26
..
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
97
98
99
100
101
102
103
104
105
106
107
108

109
110

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








module Play.Codegen exposing (..)


import List.Extra as List

import Play.TypeChecker as AST
import Wasm









-- Constants


wasmPtrSize : Int
wasmPtrSize =
    4























-- Bultin function names












stackPushFn : String
stackPushFn =
    "__stack_push"


stackPopFn : String
................................................................................
        |> Wasm.withStartFunction
            { name = "__initialize"
            , exported = False
            , args = []
            , results = []
            , locals = []
            , instructions =

                [ Wasm.I32_Const 0


















                , Wasm.I32_Const 0



                , Wasm.I32_Store




































                ]
            }
        |> Wasm.withFunction
            { name = stackPushFn
            , exported = False
            , args = [ Wasm.Int32 ]
            , results = []
            , locals = [ Wasm.Int32 ]
            , instructions =
                [ Wasm.I32_Const 0
                , Wasm.I32_Load -- Get current stack position
                , Wasm.I32_Const wasmPtrSize
                , Wasm.I32_Add -- Bump stack size
                , Wasm.Local_Set 1 -- Store new stack size
                , Wasm.I32_Const 0
                , Wasm.Local_Get 1
                , Wasm.I32_Store -- Store new stack size
                , Wasm.Local_Get 1
                , Wasm.Local_Get 0
                , Wasm.I32_Store -- Store input value in new stack position
                ]
            }
        |> Wasm.withFunction
            { name = stackPopFn
            , exported = False
            , args = []
            , results = [ Wasm.Int32 ]
            , locals = [ Wasm.Int32, Wasm.Int32 ]
            , instructions =
                [ Wasm.I32_Const 0
                , Wasm.I32_Load -- Get current stack position
                , Wasm.Local_Tee 0
                , Wasm.I32_Load
                , Wasm.Local_Set 1 -- Store item at top of stack in local 1
                , Wasm.Local_Get 0 -- Get stack position again
                , Wasm.I32_Const wasmPtrSize
                , Wasm.I32_Sub
                , Wasm.Local_Set 0 -- Store decreased stack position
                , Wasm.I32_Const 0
                , Wasm.Local_Get 0

                , Wasm.I32_Store
                , Wasm.Local_Get 1

                ]
            }
        |> Wasm.withFunction
            { name = swapFn
            , exported = False
            , args = []
            , results = []
................................................................................
            }



-- Codegen


codegen : List AST.TypedDefinition -> Result () Wasm.Module
codegen ast =


    ast





        |> List.map toWasmFuncDef
        |> List.foldl Wasm.withFunction baseModule
        |> Ok
















toWasmFuncDef : AST.TypedDefinition -> Wasm.FunctionDef
toWasmFuncDef def =
    let
        wasmImplementation =
            List.map nodeToInstruction def.implementation







    in
    { name = def.name
    , exported = def.metadata.isEntryPoint
    , args = []
    , results = []
    , locals = []
    , instructions = wasmImplementation
    }


nodeToInstruction : AST.AstNode -> Wasm.Instruction
nodeToInstruction node =
    case node of
        AST.IntLiteral value ->
            Wasm.Batch
                [ Wasm.I32_Const value
                , Wasm.Call stackPushFn
                ]

        AST.Word value _ ->
            Wasm.Call value



























































































        AST.BuiltinPlus ->
            Wasm.Call addIntFn

        AST.BuiltinMinus ->
            Wasm.Call subIntFn

        AST.BuiltinEqual ->
            Wasm.Call eqIntFn










>

>
|


>
>
>
>
>
>










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


>
>
>
>
>
>
>
>
>
>







 







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

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









|

|
|
|
|

|
|
<
|







|

|
|
<

<
<


<
<
<
>
|
|
>







 







|

>
>
|
>
>
>
>
>
|




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


<
>
>
>
>
>
>
>





|




|
|










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








>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
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
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
..
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
202
203
204
205
206
207
208
...
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
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
module Play.Codegen exposing (..)

import Dict exposing (Dict)
import List.Extra as List
import Play.Data.Type exposing (Type)
import Play.TypeChecker as AST exposing (AST)
import Wasm


type alias TypeInformation =
    { id : Int
    , members : List ( String, Type )
    }



-- Constants


wasmPtrSize : Int
wasmPtrSize =
    4


stackCapacityOffset : Int
stackCapacityOffset =
    0


stackPositionOffset : Int
stackPositionOffset =
    wasmPtrSize


defaultStackSize : Int
defaultStackSize =
    1024


initialHeapPositionOffset : Int
initialHeapPositionOffset =
    stackPositionOffset + wasmPtrSize



-- Bultin function names


allocFn : String
allocFn =
    "__alloc"


copyStructFn : String
copyStructFn =
    "__copy_str"


stackPushFn : String
stackPushFn =
    "__stack_push"


stackPopFn : String
................................................................................
        |> Wasm.withStartFunction
            { name = "__initialize"
            , exported = False
            , args = []
            , results = []
            , locals = []
            , instructions =
                [ Wasm.I32_Const stackCapacityOffset
                , Wasm.I32_Const defaultStackSize
                , Wasm.I32_Store
                , Wasm.I32_Const stackPositionOffset
                , Wasm.I32_Const (wasmPtrSize * 3)
                , Wasm.I32_Store
                , Wasm.I32_Const initialHeapPositionOffset
                , Wasm.I32_Const (defaultStackSize + wasmPtrSize)
                , Wasm.I32_Store
                ]
            }
        |> Wasm.withFunction
            { name = allocFn
            , exported = False
            , args = [ Wasm.Int32 ]
            , results = [ Wasm.Int32 ]
            , locals = [ Wasm.Int32 ]
            , instructions =
                [ Wasm.I32_Const initialHeapPositionOffset
                , Wasm.I32_Const initialHeapPositionOffset
                , Wasm.I32_Load
                , Wasm.Local_Tee 1
                , Wasm.Local_Get 0
                , Wasm.I32_Add
                , Wasm.I32_Store
                , Wasm.Local_Get 1
                ]
            }
        |> Wasm.withFunction
            { name = copyStructFn
            , exported = False
            , args = [ Wasm.Int32, Wasm.Int32 ]
            , results = [ Wasm.Int32 ]
            , locals = [ Wasm.Int32, Wasm.Int32 ]
            , instructions =
                [ Wasm.Local_Get 1 -- Size in bytes
                , Wasm.Call allocFn
                , Wasm.Local_Set 2 -- Save output instance
                , Wasm.Block
                    [ Wasm.Loop
                        [ Wasm.Local_Get 1
                        , Wasm.I32_EqZero
                        , Wasm.BreakIf 1 -- break out of loop
                        , Wasm.Local_Get 1
                        , Wasm.I32_Const wasmPtrSize
                        , Wasm.I32_Sub
                        , Wasm.Local_Set 1 -- Decreased pointer size
                        , Wasm.Local_Get 0 -- Source struct
                        , Wasm.Local_Get 1
                        , Wasm.I32_Add
                        , Wasm.I32_Load -- Get a byte from source struct
                        , Wasm.Local_Set 3 -- Save byte to copy
                        , Wasm.Local_Get 2 -- Dest struct
                        , Wasm.Local_Get 1
                        , Wasm.I32_Add
                        , Wasm.Local_Get 3
                        , Wasm.I32_Store -- Copy byte from source to dest struct
                        , Wasm.Break 0 -- loop
                        ]
                    ]
                , Wasm.Local_Get 2
                ]
            }
        |> Wasm.withFunction
            { name = stackPushFn
            , exported = False
            , args = [ Wasm.Int32 ]
            , results = []
            , locals = [ Wasm.Int32 ]
            , instructions =
                [ Wasm.I32_Const stackPositionOffset
                , Wasm.I32_Load -- Get current stack position
                , Wasm.Local_Tee 1
                , Wasm.Local_Get 0
                , Wasm.I32_Store -- Store input value in stack
                , Wasm.I32_Const stackPositionOffset
                , Wasm.Local_Get 1
                , Wasm.I32_Const wasmPtrSize
                , Wasm.I32_Add -- Bump stack size

                , Wasm.I32_Store -- Save new stack position
                ]
            }
        |> Wasm.withFunction
            { name = stackPopFn
            , exported = False
            , args = []
            , results = [ Wasm.Int32 ]
            , locals = [ Wasm.Int32 ]
            , instructions =
                [ Wasm.I32_Const stackPositionOffset
                , Wasm.I32_Const stackPositionOffset

                , Wasm.I32_Load


                , Wasm.I32_Const wasmPtrSize
                , Wasm.I32_Sub



                , Wasm.Local_Tee 0 -- Save new stack position in local register
                , Wasm.I32_Store -- save new stack position in global variable
                , Wasm.Local_Get 0
                , Wasm.I32_Load -- Load element at top of the stack
                ]
            }
        |> Wasm.withFunction
            { name = swapFn
            , exported = False
            , args = []
            , results = []
................................................................................
            }



-- Codegen


codegen : AST -> Result () Wasm.Module
codegen ast =
    let
        typeMetaDict =
            ast.types
                |> Dict.values
                |> typeMeta
    in
    ast.words
        |> Dict.values
        |> List.map (toWasmFuncDef typeMetaDict)
        |> List.foldl Wasm.withFunction baseModule
        |> Ok


typeMeta : List AST.TypeDefinition -> Dict String TypeInformation
typeMeta types =
    types
        |> List.indexedMap
            (\idx typeDef ->
                ( typeDef.name
                , { id = idx
                  , members = typeDef.members
                  }
                )
            )
        |> Dict.fromList


toWasmFuncDef : Dict String TypeInformation -> AST.WordDefinition -> Wasm.FunctionDef
toWasmFuncDef typeInfo def =
    let
        wasmImplementation =

            List.map (nodeToInstruction typeInfo) def.implementation

        numberOfLocals =
            List.filterMap Wasm.maximumLocalIndex wasmImplementation
                |> List.maximum
                |> Maybe.map ((+) 1)
                |> Maybe.withDefault 0
    in
    { name = def.name
    , exported = def.metadata.isEntryPoint
    , args = []
    , results = []
    , locals = List.repeat numberOfLocals Wasm.Int32
    , instructions = wasmImplementation
    }


nodeToInstruction : Dict String TypeInformation -> AST.AstNode -> Wasm.Instruction
nodeToInstruction typeInfo node =
    case node of
        AST.IntLiteral value ->
            Wasm.Batch
                [ Wasm.I32_Const value
                , Wasm.Call stackPushFn
                ]

        AST.Word value _ ->
            Wasm.Call value

        AST.ConstructType typeName ->
            case Dict.get typeName typeInfo of
                Just type_ ->
                    let
                        typeSize =
                            wasmPtrSize + (memberSize * wasmPtrSize)

                        memberSize =
                            List.length type_.members
                    in
                    Wasm.Batch
                        [ Wasm.I32_Const typeSize
                        , Wasm.Call allocFn
                        , Wasm.Local_Tee 0
                        , Wasm.I32_Const type_.id
                        , Wasm.I32_Store
                        , Wasm.I32_Const memberSize
                        , Wasm.Local_Set 1
                        , Wasm.Block
                            [ Wasm.Loop
                                [ Wasm.Local_Get 1
                                , Wasm.I32_EqZero
                                , Wasm.BreakIf 1
                                , Wasm.Local_Get 0
                                , Wasm.I32_Const wasmPtrSize
                                , Wasm.Local_Get 1
                                , Wasm.I32_Mul
                                , Wasm.I32_Add
                                , Wasm.Call stackPopFn
                                , Wasm.I32_Store
                                , Wasm.Local_Get 1
                                , Wasm.I32_Const 1
                                , Wasm.I32_Sub
                                , Wasm.Local_Set 1
                                , Wasm.Break 0
                                ]
                            ]
                        , Wasm.Local_Get 0
                        , Wasm.Call stackPushFn
                        ]

                Nothing ->
                    Debug.todo "This cannot happen."

        AST.SetMember typeName memberName memberType ->
            case Dict.get typeName typeInfo of
                Just type_ ->
                    let
                        typeSize =
                            wasmPtrSize + (memberSize * wasmPtrSize)

                        memberSize =
                            List.length type_.members
                    in
                    case getMemberType typeInfo typeName memberName of
                        Just memberIndex ->
                            Wasm.Batch
                                [ Wasm.Call swapFn -- Instance should now be at top of stack
                                , Wasm.Call stackPopFn
                                , Wasm.I32_Const typeSize
                                , Wasm.Call copyStructFn -- Return copy of instance
                                , Wasm.Local_Tee 0
                                , Wasm.I32_Const ((memberIndex + 1) * wasmPtrSize) -- Calculate member offset
                                , Wasm.I32_Add -- Calculate member address
                                , Wasm.Call stackPopFn -- Retrieve new value
                                , Wasm.I32_Store
                                , Wasm.Local_Get 0 -- Return instance
                                , Wasm.Call stackPushFn
                                ]

                        Nothing ->
                            Debug.todo "NOOOOO!"

                Nothing ->
                    Debug.todo "This cannot happen!"

        AST.GetMember typeName memberName memberType ->
            case getMemberType typeInfo typeName memberName of
                Just memberIndex ->
                    Wasm.Batch
                        [ Wasm.Call stackPopFn -- Get instance address
                        , Wasm.I32_Const ((memberIndex + 1) * wasmPtrSize) -- Calculate member offset
                        , Wasm.I32_Add -- Calculate member address
                        , Wasm.I32_Load -- Retrieve member
                        , Wasm.Call stackPushFn -- Push member onto stack
                        ]

                Nothing ->
                    Debug.todo "This cannot happen!"

        AST.BuiltinPlus ->
            Wasm.Call addIntFn

        AST.BuiltinMinus ->
            Wasm.Call subIntFn

        AST.BuiltinEqual ->
            Wasm.Call eqIntFn


getMemberType : Dict String TypeInformation -> String -> String -> Maybe Int
getMemberType typeInfoDict typeName memberName =
    Dict.get typeName typeInfoDict
        |> Maybe.map (List.indexedMap (\idx ( name, _ ) -> ( idx, name )) << .members)
        |> Maybe.andThen (List.find (\( _, name ) -> name == memberName))
        |> Maybe.map Tuple.first

Modified src/Play/Data/Metadata.elm from [96da4e9d62] to [7e328d42eb].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16










module Play.Data.Metadata exposing (..)

import Play.Data.Type exposing (WordType)


type alias Metadata =
    { isEntryPoint : Bool
    , type_ : Maybe WordType
    }


default : Metadata
default =
    { isEntryPoint = False
    , type_ = Nothing
    }












|













>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
module Play.Data.Metadata exposing (..)

import Play.Data.Type exposing (Type, WordType)


type alias Metadata =
    { isEntryPoint : Bool
    , type_ : Maybe WordType
    }


default : Metadata
default =
    { isEntryPoint = False
    , type_ = Nothing
    }


asEntryPoint : Metadata -> Metadata
asEntryPoint meta =
    { meta | isEntryPoint = True }


withType : List Type -> List Type -> Metadata -> Metadata
withType inputs outputs meta =
    { meta | type_ = Just { input = inputs, output = outputs } }

Modified src/Play/Data/Type.elm from [eb94e8525a] to [64e60d84ed].

1
2
3
4
5

6
7
8
9
10
11
module Play.Data.Type exposing (..)


type Type
    = Int



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





>






1
2
3
4
5
6
7
8
9
10
11
12
module Play.Data.Type exposing (..)


type Type
    = Int
    | Custom String


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

Modified src/Play/Parser.elm from [4960fa8fba] to [007bdc46d7].

1
2


3
4
5
6
7

8
9
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
..
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
..
81
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
...
168
169
170
171
172
173
174
175













































176
177
178
179
180
181



182
183


















module Play.Parser exposing (..)



import List.Extra as List
import Play.Data.Metadata as Metadata exposing (Metadata)
import Play.Data.Type as Type exposing (Type)
import Play.Tokenizer as Token exposing (Token)
import Result.Extra as Result



type alias Definition =












    { name : String
    , metadata : Metadata
    , implementation : List AstNode
    }


type AstNode
    = Integer Int
    | Word String





parse : List Token -> Result () (List Definition)
parse tokens =


    tokens
        |> gather isDefinition
        |> List.map parseDefinition
        |> Result.combine














gather : (a -> Bool) -> List a -> List (List a)
gather pred tokens =
    gatherHelp pred tokens []


................................................................................
                        List.takeWhile (not << pred) tokens

                remainingTokens =
                    List.drop (List.length tilNextDefinition) tokens
            in
            gatherHelp pred remainingTokens (tilNextDefinition :: acc)







isDefinition : Token -> Bool
isDefinition token =
    case token of
        Token.Metadata "def" ->
            True

        _ ->
            False


parseDefinition : List Token -> Result () Definition
parseDefinition tokens =
    case tokens of
        (Token.Metadata "def") :: (Token.Symbol wordName) :: rest ->
            case List.splitWhen (\token -> token == Token.Metadata "") rest of
                Nothing ->
                    Err ()



                Just ( meta, impl ) ->
                    let
                        ( metaParseErrors, metadata ) =
                            meta
                                |> gather isMeta
                                |> List.foldl parseMeta ( [], Metadata.default )
................................................................................
                        parsedImpl =
                            impl
                                |> List.drop 1
                                |> List.map parseAstNode
                                |> Result.combine
                    in
                    case ( metaParseErrors, parsedImpl ) of
                        ( [], Ok ast ) ->
                            Ok




                                { name = wordName
                                , metadata = metadata
                                , implementation = ast
                                }




                        _ ->













                            Err ()









        _ ->
            Err ()










isMeta : Token -> Bool
isMeta token =
    case token of
        Token.Metadata _ ->
            True
................................................................................

        Token.Symbol value ->
            Ok (Word value)

        _ ->
            Err ()















































parseType : Token -> Result () Type
parseType token =
    case token of
        Token.Type "Int" ->
            Ok Type.Int




        _ ->
            Err ()




















>
>





>


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









>
>
>


|

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







 







>
>
>
>
>




|
|





|
|




|
>
>







 







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

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







 








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






>
>
>


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
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
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
..
79
80
81
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
...
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
...
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
module Play.Parser exposing (..)

import Dict exposing (Dict)
import Dict.Extra as Dict
import List.Extra as List
import Play.Data.Metadata as Metadata exposing (Metadata)
import Play.Data.Type as Type exposing (Type)
import Play.Tokenizer as Token exposing (Token)
import Result.Extra as Result
import Set exposing (Set)


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 AstNode
    }


type AstNode
    = Integer Int
    | Word String
    | ConstructType String
    | GetMember String String
    | SetMember String String


parse : List Token -> Result () AST
parse tokens =
    let
        ( errors, ast ) =
            tokens
                |> gather isDefinition
                |> List.foldl parseDefinition

                    ( []
                    , { types = Dict.empty
                      , words = Dict.empty
                      }
                    )
    in
    case errors of
        [] ->
            Ok ast

        _ ->
            Err ()


gather : (a -> Bool) -> List a -> List (List a)
gather pred tokens =
    gatherHelp pred tokens []


................................................................................
                        List.takeWhile (not << pred) tokens

                remainingTokens =
                    List.drop (List.length tilNextDefinition) tokens
            in
            gatherHelp pred remainingTokens (tilNextDefinition :: acc)


definitionKeywords : Set String
definitionKeywords =
    Set.fromList [ "def", "deftype" ]


isDefinition : Token -> Bool
isDefinition token =
    case token of
        Token.Metadata value ->
            Set.member value definitionKeywords

        _ ->
            False


parseDefinition : List Token -> ( List (), AST ) -> ( List (), AST )
parseDefinition tokens ( errors, ast ) =
    case tokens of
        (Token.Metadata "def") :: (Token.Symbol wordName) :: rest ->
            case List.splitWhen (\token -> token == Token.Metadata "") rest of
                Nothing ->
                    ( () :: errors
                    , ast
                    )

                Just ( meta, impl ) ->
                    let
                        ( metaParseErrors, metadata ) =
                            meta
                                |> gather isMeta
                                |> List.foldl parseMeta ( [], Metadata.default )
................................................................................
                        parsedImpl =
                            impl
                                |> List.drop 1
                                |> List.map parseAstNode
                                |> Result.combine
                    in
                    case ( metaParseErrors, parsedImpl ) of
                        ( [], Ok wordImpl ) ->

                            ( errors
                            , { ast
                                | words =
                                    Dict.insert wordName
                                        { name = wordName
                                        , metadata = metadata
                                        , implementation = wordImpl
                                        }
                                        ast.words
                              }
                            )

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

        (Token.Metadata "deftype") :: (Token.Type typeName) :: [] ->
            ( errors
            , parseTypeDefinition typeName [] ast
            )

        (Token.Metadata "deftype") :: (Token.Type typeName) :: (Token.Metadata "") :: Token.ListStart :: rest ->
            case List.splitWhen (\t -> t == Token.ListEnd) rest of
                Just ( types, [ Token.ListEnd ] ) ->
                    case parseTypeMembers types [] of
                        Err () ->
                            ( () :: errors
                            , ast
                            )

                        Ok members ->
                            ( errors
                            , parseTypeDefinition typeName members ast
                            )

                _ ->

                    ( () :: errors
                    , ast
                    )

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


isMeta : Token -> Bool
isMeta token =
    case token of
        Token.Metadata _ ->
            True
................................................................................

        Token.Symbol value ->
            Ok (Word value)

        _ ->
            Err ()


parseTypeDefinition : String -> List ( String, Type ) -> AST -> AST
parseTypeDefinition typeName members ast =
    let
        typeDef =
            { name = typeName
            , members = members
            }

        metadata =
            Metadata.default
                |> Metadata.withType (List.map Tuple.second members) [ Type.Custom typeName ]

        ctorDef =
            { name = ">" ++ typeName
            , metadata = metadata
            , implementation = [ ConstructType typeName ]
            }

        generatedDefs =
            members
                |> List.concatMap setterGetterPair
                |> (::) ctorDef
                |> Dict.fromListBy .name

        setterGetterPair ( memberName, memberType ) =
            [ { name = ">" ++ memberName
              , metadata =
                    Metadata.default
                        |> Metadata.withType [ Type.Custom typeName, memberType ] [ Type.Custom typeName ]
              , implementation = [ SetMember typeName memberName ]
              }
            , { name = memberName ++ ">"
              , metadata =
                    Metadata.default
                        |> Metadata.withType [ Type.Custom typeName ] [ memberType ]
              , implementation = [ GetMember typeName memberName ]
              }
            ]
    in
    { ast
        | types = Dict.insert typeName typeDef ast.types
        , words = Dict.union generatedDefs ast.words
    }


parseType : Token -> Result () Type
parseType token =
    case token of
        Token.Type "Int" ->
            Ok Type.Int

        Token.Type name ->
            Ok <| Type.Custom name

        _ ->
            Err ()


parseTypeMembers : List Token -> List ( String, Type ) -> Result () (List ( String, Type ))
parseTypeMembers tokens acc =
    case tokens of
        [] ->
            Ok (List.reverse acc)

        (Token.Metadata name) :: ((Token.Type _) as typeToken) :: rest ->
            case parseType typeToken of
                Err () ->
                    Err ()

                Ok typeValue ->
                    parseTypeMembers rest (( name, typeValue ) :: acc)

        _ ->
            Err ()

Modified src/Play/Qualifier.elm from [b0aa805422] to [d38ce01e0f].

1
2
3
4

5
6
7
8
9
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
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









module Play.Qualifier exposing (..)

import Dict exposing (Dict)
import Play.Data.Metadata exposing (Metadata)

import Play.Parser as AST
import Result.Extra as Result
import Set exposing (Set)


type alias Definition =












    { name : String
    , metadata : Metadata
    , implementation : List Node
    }


type Node
    = Integer Int
    | Word String



    | BuiltinPlus
    | BuiltinMinus
    | BuiltinEqual


builtinDict : Dict String Node
builtinDict =
................................................................................
    Dict.fromList
        [ ( "+", BuiltinPlus )
        , ( "-", BuiltinMinus )
        , ( "=", BuiltinEqual )
        ]


qualify : List AST.Definition -> Result () (List Definition)
qualify ast =
    let
        knownUserDefinitions =
            ast
                |> List.map .name
                |> Set.fromList





    in
    ast
        |> List.map (qualifyDefinition knownUserDefinitions)
        |> Result.combine







qualifyDefinition : Set String -> AST.Definition -> Result () Definition















qualifyDefinition knownUserDefinitions definition =





    let
        qualifiedImplementationResult =
            definition.implementation
                |> List.map (qualifyNode knownUserDefinitions)
                |> Result.combine
    in
    case qualifiedImplementationResult of
        Err () ->
            Err ()



        Ok qualifiedImplementation ->
            Ok
                { name = definition.name



                , metadata = definition.metadata
                , implementation = qualifiedImplementation
                }




qualifyNode : Set String -> AST.AstNode -> Result () Node
qualifyNode knownUserDefinitions node =
    case node of
        AST.Integer value ->
            Ok (Integer value)

        AST.Word value ->
            if Set.member value knownUserDefinitions then
                Ok (Word value)

            else
                case Dict.get value builtinDict of
                    Just builtin ->
                        Ok builtin

                    Nothing ->
                        Err ()













>
|

<


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









>
>
>







 







|


|
|
|
|
>
>
>
>
>

<
<
<
>
>
>
>
>
|

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


|
|




|
>
|
>

<
<
>
>
>
|


>
|

>
|
|

|


|
|









>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7

8
9
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
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
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
module Play.Qualifier exposing (..)

import Dict exposing (Dict)
import Play.Data.Metadata exposing (Metadata)
import Play.Data.Type exposing (Type)
import Play.Parser as Parser
import Result.Extra as Result



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
    | BuiltinPlus
    | BuiltinMinus
    | BuiltinEqual


builtinDict : Dict String Node
builtinDict =
................................................................................
    Dict.fromList
        [ ( "+", BuiltinPlus )
        , ( "-", BuiltinMinus )
        , ( "=", BuiltinEqual )
        ]


qualify : Parser.AST -> Result () AST
qualify ast =
    let
        ( typeErrors, qualifiedTypes ) =
            ast.types
                |> Dict.values
                |> List.foldl (qualifyType ast) ( [], Dict.empty )

        ( wordErrors, qualifiedWords ) =
            ast.words
                |> Dict.values
                |> List.foldl (qualifyDefinition ast) ( [], Dict.empty )
    in



    case ( typeErrors, wordErrors ) of
        ( [], [] ) ->
            Ok
                { types = qualifiedTypes
                , words = qualifiedWords
                }


        _ ->
            Err ()


qualifyType :
    Parser.AST
    -> Parser.TypeDefinition
    -> ( List (), Dict String TypeDefinition )
    -> ( List (), Dict String TypeDefinition )
qualifyType ast unqualifiedWord ( errors, acc ) =
    ( errors
    , Dict.insert unqualifiedWord.name unqualifiedWord 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 = unqualifiedWord.metadata
                , implementation = qualifiedImplementation
                }
                acc
            )


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

        Parser.Word value ->
            if Dict.member value ast.words then
                Ok (Word value)

            else
                case Dict.get value builtinDict of
                    Just builtin ->
                        Ok builtin

                    Nothing ->
                        Err ()

        Parser.ConstructType typeName ->
            Ok (ConstructType typeName)

        Parser.SetMember typeName memberName ->
            Ok (SetMember typeName memberName)

        Parser.GetMember typeName memberName ->
            Ok (GetMember typeName memberName)

Modified src/Play/Tokenizer.elm from [26354c3c50] to [80de6e77ac].

5
6
7
8
9
10
11


12
13
14
15
16
17
18
..
31
32
33
34
35
36
37
38


39
40
41







42
43
44
45
46
47
48
49
50
51
52

type Token
    = Integer Int
    | Symbol String
    | Metadata String
    | Type String
    | TypeSeperator




tokenize : String -> Result () (List Token)
tokenize sourceCode =
    sourceCode
        |> String.words
        |> List.map recognizeToken
................................................................................

            else if String.endsWith ":" word then
                word
                    |> String.dropRight 1
                    |> Metadata
                    |> Ok

            else if word == "--" then


                Ok TypeSeperator

            else







                Ok (Symbol word)


stringStartsWithUpper : String -> Bool
stringStartsWithUpper str =
    case String.uncons str of
        Just ( firstLetter, _ ) ->
            Char.isUpper firstLetter

        Nothing ->
            False







>
>







 







|
>
>
|

<
>
>
>
>
>
>
>
|










5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
..
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

type Token
    = Integer Int
    | Symbol String
    | Metadata String
    | Type String
    | TypeSeperator
    | ListStart
    | ListEnd


tokenize : String -> Result () (List Token)
tokenize sourceCode =
    sourceCode
        |> String.words
        |> List.map recognizeToken
................................................................................

            else if String.endsWith ":" word then
                word
                    |> String.dropRight 1
                    |> Metadata
                    |> Ok

            else
                case word of
                    "--" ->
                        Ok TypeSeperator


                    "{" ->
                        Ok ListStart

                    "}" ->
                        Ok ListEnd

                    _ ->
                        Ok (Symbol word)


stringStartsWithUpper : String -> Bool
stringStartsWithUpper str =
    case String.uncons str of
        Just ( firstLetter, _ ) ->
            Char.isUpper firstLetter

        Nothing ->
            False

Modified src/Play/TypeChecker.elm from [e46ea1e026] to [60728609c9].

1
2
3

4
5
6
7
8






9






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

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
...
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
...
198
199
200
201
202
203
204
























205
206
207
208
209
210
211
212








module Play.TypeChecker exposing (..)

import Dict exposing (Dict)

import Play.Data.Metadata exposing (Metadata)
import Play.Data.Type as Type exposing (Type, WordType)
import Play.Qualifier as Qualifier








type alias TypedDefinition =






    { name : String
    , type_ : WordType
    , metadata : Metadata
    , implementation : List AstNode
    }


type AstNode
    = IntLiteral Int
    | Word String WordType



    | BuiltinPlus
    | BuiltinMinus
    | BuiltinEqual


type alias Context =

    { typedWords : Dict String TypedDefinition
    , untypedWords : Dict String Qualifier.Definition
    , stackEffects : List StackEffect
    , errors : List ()
    }


type StackEffect
    = Push Type
    | Pop Type


initContext : List Qualifier.Definition -> Context
initContext ast =

    { typedWords = Dict.empty
    , untypedWords = List.foldl (\word acc -> Dict.insert word.name word acc) Dict.empty ast

    , stackEffects = []
    , errors = []
    }


typeCheck : List Qualifier.Definition -> Result () (List TypedDefinition)
typeCheck ast =
    typeCheckHelper (initContext ast) ast


typeCheckHelper : Context -> List Qualifier.Definition -> Result () (List TypedDefinition)
typeCheckHelper context ast =
    let
        updatedContext =



            List.foldl typeCheckDefinition context ast
    in
    if List.isEmpty updatedContext.errors then


        Ok <| Dict.values updatedContext.typedWords


    else
        Err ()


typeCheckDefinition : Qualifier.Definition -> Context -> Context
typeCheckDefinition untypedDef context =
    let
        cleanContext =
            { context | stackEffects = [] }
    in
    case Dict.get untypedDef.name context.typedWords of
        Just _ ->
................................................................................
                            case Dict.get name newContext.typedWords of
                                Nothing ->
                                    Debug.todo "inconcievable!"

                                Just def ->
                                    addStackEffect newContext <| wordTypeToStackEffects def.type_





































        Qualifier.BuiltinPlus ->
            addStackEffect context <| wordTypeToStackEffects { input = [ Type.Int, Type.Int ], output = [ Type.Int ] }

        Qualifier.BuiltinMinus ->
            addStackEffect context <| wordTypeToStackEffects { input = [ Type.Int, Type.Int ], output = [ Type.Int ] }

        Qualifier.BuiltinEqual ->
            addStackEffect context <| wordTypeToStackEffects { input = [ Type.Int, Type.Int ], output = [ Type.Int ] }


wordTypeToStackEffects : WordType -> List StackEffect
wordTypeToStackEffects wordType =
    List.map Pop wordType.input
        ++ List.map Push wordType.output
        |> List.reverse



wordTypeFromStackEffects : Context -> ( Context, WordType )
wordTypeFromStackEffects context =
    wordTypeFromStackEffectsHelper context.stackEffects ( context, { input = [], output = [] } )


................................................................................
            case Dict.get name context.typedWords of
                Just def ->
                    Word def.name def.type_

                Nothing ->
                    Debug.todo "Inconcievable!"

























        Qualifier.BuiltinPlus ->
            BuiltinPlus

        Qualifier.BuiltinMinus ->
            BuiltinMinus

        Qualifier.BuiltinEqual ->
            BuiltinEqual











>





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










>
>
>






>
|
|










|

>
|
<
>





|




|



>
>
>
|


>
>
|
>





|







 







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












<
|
<
>







 







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








>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
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
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
86
87
88
89
90
91
92
93
94
95
96
...
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
...
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
module Play.TypeChecker exposing (..)

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


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
    , type_ : WordType
    , metadata : Metadata
    , implementation : List AstNode
    }


type AstNode
    = IntLiteral Int
    | Word String WordType
    | ConstructType String
    | SetMember String String Type
    | GetMember String String Type
    | BuiltinPlus
    | BuiltinMinus
    | BuiltinEqual


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


type StackEffect
    = Push Type
    | Pop Type


initContext : Qualifier.AST -> Context
initContext ast =
    { types = ast.types
    , typedWords = Dict.empty

    , untypedWords = ast.words
    , stackEffects = []
    , errors = []
    }


typeCheck : Qualifier.AST -> Result () AST
typeCheck ast =
    typeCheckHelper (initContext ast) ast


typeCheckHelper : Context -> Qualifier.AST -> Result () AST
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 ()


typeCheckDefinition : Qualifier.WordDefinition -> Context -> Context
typeCheckDefinition untypedDef context =
    let
        cleanContext =
            { context | stackEffects = [] }
    in
    case Dict.get untypedDef.name context.typedWords of
        Just _ ->
................................................................................
                            case Dict.get name newContext.typedWords of
                                Nothing ->
                                    Debug.todo "inconcievable!"

                                Just def ->
                                    addStackEffect newContext <| wordTypeToStackEffects def.type_

        Qualifier.ConstructType typeName ->
            case Dict.get typeName context.types of
                Just type_ ->
                    addStackEffect context <|
                        wordTypeToStackEffects
                            { input = List.map Tuple.second type_.members
                            , output = [ Type.Custom typeName ]
                            }

                Nothing ->
                    Debug.todo "inconcievable!"

        Qualifier.SetMember typeName memberName ->
            case getMemberType context.types typeName memberName of
                Just memberType ->
                    addStackEffect context <|
                        wordTypeToStackEffects
                            { input = [ Type.Custom typeName, memberType ]
                            , output = [ Type.Custom typeName ]
                            }

                Nothing ->
                    Debug.todo "inconcievable!"

        Qualifier.GetMember typeName memberName ->
            case getMemberType context.types typeName memberName of
                Just memberType ->
                    addStackEffect context <|
                        wordTypeToStackEffects
                            { input = [ Type.Custom typeName ]
                            , output = [ memberType ]
                            }

                Nothing ->
                    Debug.todo "inconcievable!"

        Qualifier.BuiltinPlus ->
            addStackEffect context <| wordTypeToStackEffects { input = [ Type.Int, Type.Int ], output = [ Type.Int ] }

        Qualifier.BuiltinMinus ->
            addStackEffect context <| wordTypeToStackEffects { input = [ Type.Int, Type.Int ], output = [ Type.Int ] }

        Qualifier.BuiltinEqual ->
            addStackEffect context <| wordTypeToStackEffects { input = [ Type.Int, Type.Int ], output = [ Type.Int ] }


wordTypeToStackEffects : WordType -> List StackEffect
wordTypeToStackEffects wordType =

    List.map Push wordType.output

        ++ List.map Pop wordType.input


wordTypeFromStackEffects : Context -> ( Context, WordType )
wordTypeFromStackEffects context =
    wordTypeFromStackEffectsHelper context.stackEffects ( context, { input = [], output = [] } )


................................................................................
            case Dict.get name context.typedWords of
                Just def ->
                    Word def.name def.type_

                Nothing ->
                    Debug.todo "Inconcievable!"

        Qualifier.ConstructType typeName ->
            case Dict.get typeName context.types of
                Just _ ->
                    ConstructType typeName

                Nothing ->
                    Debug.todo "Inconcievable!"

        Qualifier.SetMember typeName memberName ->
            case getMemberType context.types typeName memberName of
                Just memberType ->
                    SetMember typeName memberName memberType

                Nothing ->
                    Debug.todo "Inconcievable!"

        Qualifier.GetMember typeName memberName ->
            case getMemberType context.types typeName memberName of
                Just memberType ->
                    GetMember typeName memberName memberType

                Nothing ->
                    Debug.todo "Inconcievable!"

        Qualifier.BuiltinPlus ->
            BuiltinPlus

        Qualifier.BuiltinMinus ->
            BuiltinMinus

        Qualifier.BuiltinEqual ->
            BuiltinEqual


getMemberType : Dict String TypeDefinition -> String -> String -> Maybe Type
getMemberType typeDict typeName memberName =
    Dict.get typeName typeDict
        |> Maybe.map .members
        |> Maybe.andThen (List.find (\( name, _ ) -> name == memberName))
        |> Maybe.map Tuple.second

Modified src/Wasm.elm from [eabf1aaafa] to [181df993e7].

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
...
107
108
109
110
111
112
113



114
115



116
117
118
119
120
121
122




























123
124
125
126
127
128
129
        Int32 ->
            "i32"


type Instruction
    = NoOp
    | Batch (List Instruction)




    | Call String
    | Local_Get Int
    | Local_Set Int
    | Local_Tee Int
    | I32_Const Int
    | I32_Add
    | I32_Sub

    | I32_Eq

    | I32_Store
    | I32_Load


instructionToString : Module -> Instruction -> String
instructionToString ((Module module_) as fullModule) ins =
    case ins of
        NoOp ->
            "nop"

        Batch insList ->
            insList
                |> List.map (instructionToString fullModule)
                |> String.join " "























        Call word ->
            case List.findIndex (\f -> f.name == word) module_.functions of
                Just idx ->
                    "(call " ++ String.fromInt idx ++ ") ;; $" ++ word

                Nothing ->
................................................................................

        I32_Add ->
            "i32.add"

        I32_Sub ->
            "i32.sub"




        I32_Eq ->
            "i32.eq"




        I32_Store ->
            "i32.store"

        I32_Load ->
            "i32.load"






























initModule : Module
initModule =
    Module
        { typeSignatures = []
        , functions = []
        , imports = []







>
>
>
>







>

>













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







 







>
>
>


>
>
>







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







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
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
...
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
        Int32 ->
            "i32"


type Instruction
    = NoOp
    | Batch (List Instruction)
    | Block (List Instruction)
    | Loop (List Instruction)
    | Break Int
    | BreakIf Int
    | Call String
    | Local_Get Int
    | Local_Set Int
    | Local_Tee Int
    | I32_Const Int
    | I32_Add
    | I32_Sub
    | I32_Mul
    | I32_Eq
    | I32_EqZero
    | I32_Store
    | I32_Load


instructionToString : Module -> Instruction -> String
instructionToString ((Module module_) as fullModule) ins =
    case ins of
        NoOp ->
            "nop"

        Batch insList ->
            insList
                |> List.map (instructionToString fullModule)
                |> String.join "\n"

        Block insList ->
            "(block\n"
                ++ (insList
                        |> List.map (instructionToString fullModule)
                        |> String.join "\n"
                   )
                ++ "\n)"

        Loop insList ->
            "(loop\n"
                ++ (insList
                        |> List.map (instructionToString fullModule)
                        |> String.join "\n"
                   )
                ++ "\n)"

        Break num ->
            "(br " ++ String.fromInt num ++ ")"

        BreakIf num ->
            "(br_if " ++ String.fromInt num ++ ")"

        Call word ->
            case List.findIndex (\f -> f.name == word) module_.functions of
                Just idx ->
                    "(call " ++ String.fromInt idx ++ ") ;; $" ++ word

                Nothing ->
................................................................................

        I32_Add ->
            "i32.add"

        I32_Sub ->
            "i32.sub"

        I32_Mul ->
            "i32.mul"

        I32_Eq ->
            "i32.eq"

        I32_EqZero ->
            "i32.eqz"

        I32_Store ->
            "i32.store"

        I32_Load ->
            "i32.load"


maximumLocalIndex : Instruction -> Maybe Int
maximumLocalIndex ins =
    case ins of
        Batch insList ->
            List.filterMap maximumLocalIndex insList
                |> List.maximum

        Block insList ->
            List.filterMap maximumLocalIndex insList
                |> List.maximum

        Loop insList ->
            List.filterMap maximumLocalIndex insList
                |> List.maximum

        Local_Get idx ->
            Just idx

        Local_Set idx ->
            Just idx

        Local_Tee idx ->
            Just idx

        _ ->
            Nothing


initModule : Module
initModule =
    Module
        { typeSignatures = []
        , functions = []
        , imports = []

Modified tests/Test/Parser.elm from [54a2a3e69e] to [56ed5689f9].

1
2


3
4
5
6
7
8
9
..
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
..
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
86








87
































































































































module Test.Parser exposing (..)



import Expect
import Play.Data.Metadata as Metadata
import Play.Data.Type as Type
import Play.Parser as AST exposing (..)
import Play.Tokenizer as Token exposing (Token(..))
import Test exposing (Test, describe, test)

................................................................................

suite : Test
suite =
    describe "Parser"
        [ test "Sample program" <|
            \_ ->
                let
                    defaultMeta =
                        Metadata.default

                    source =
                        [ -- inc function
                          Metadata "def"
                        , Symbol "inc"
                        , Metadata ""
                        , Token.Integer 1
                        , Symbol "+"
................................................................................
                        , Symbol "inc"
                        , Symbol "inc"
                        , Symbol "dec"
                        , Token.Integer 2
                        , Symbol "="
                        ]

                    expectedDefinitions =



                        [ { name = "inc"
                          , metadata = Metadata.default
                          , implementation =
                                [ AST.Integer 1
                                , AST.Word "+"
                                ]
                          }
                        , { name = "dec"
                          , metadata = { defaultMeta | type_ = Just { input = [ Type.Int ], output = [ Type.Int ] } }



                          , implementation =
                                [ AST.Integer 1
                                , AST.Word "-"
                                ]
                          }
                        , { name = "main"
                          , metadata = { defaultMeta | isEntryPoint = True }


                          , implementation =
                                [ AST.Integer 1
                                , AST.Word "inc"
                                , AST.Word "inc"
                                , AST.Word "dec"
                                , AST.Integer 2
                                , AST.Word "="
                                ]
                          }
                        ]

                in
                case parse source of
                    Err () ->
                        Expect.fail "Did not expect parsing to fail"

                    Ok definitions ->
                        Expect.equalLists expectedDefinitions definitions








        ]


































































































































>
>







 







<
<
<







 







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





<
<
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
..
12
13
14
15
16
17
18



19
20
21
22
23
24
25
..
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
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
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
module Test.Parser exposing (..)

import Dict
import Dict.Extra as Dict
import Expect
import Play.Data.Metadata as Metadata
import Play.Data.Type as Type
import Play.Parser as AST exposing (..)
import Play.Tokenizer as Token exposing (Token(..))
import Test exposing (Test, describe, test)

................................................................................

suite : Test
suite =
    describe "Parser"
        [ test "Sample program" <|
            \_ ->
                let



                    source =
                        [ -- inc function
                          Metadata "def"
                        , Symbol "inc"
                        , Metadata ""
                        , Token.Integer 1
                        , Symbol "+"
................................................................................
                        , Symbol "inc"
                        , Symbol "inc"
                        , Symbol "dec"
                        , Token.Integer 2
                        , Symbol "="
                        ]

                    expectedAst =
                        { types = Dict.empty
                        , words =
                            Dict.fromListBy .name
                                [ { name = "inc"
                                  , metadata = Metadata.default
                                  , implementation =
                                        [ AST.Integer 1
                                        , AST.Word "+"
                                        ]
                                  }
                                , { name = "dec"

                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Int ] [ Type.Int ]
                                  , implementation =
                                        [ AST.Integer 1
                                        , AST.Word "-"
                                        ]
                                  }
                                , { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.asEntryPoint
                                  , implementation =
                                        [ AST.Integer 1
                                        , AST.Word "inc"
                                        , AST.Word "inc"
                                        , AST.Word "dec"
                                        , AST.Integer 2
                                        , AST.Word "="
                                        ]
                                  }
                                ]
                        }
                in
                case parse source of
                    Err () ->
                        Expect.fail "Did not expect parsing to fail"



                    Ok ast ->
                        Expect.equal expectedAst ast
        , test "Custom data structure without fields" <|
            \_ ->
                let
                    source =
                        [ Metadata "deftype"
                        , Type "True"

                        -- as int
                        , Metadata "def"
                        , Symbol "as-int"
                        , Metadata "type"
                        , Type "True"
                        , TypeSeperator
                        , Type "Int"
                        , Metadata ""
                        , Token.Integer 1
                        ]

                    expectedAst =
                        { types =
                            Dict.fromListBy .name
                                [ { name = "True"
                                  , members = []
                                  }
                                ]
                        , words =
                            Dict.fromListBy .name
                                [ { name = ">True"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [] [ Type.Custom "True" ]
                                  , implementation = [ AST.ConstructType "True" ]
                                  }
                                , { name = "as-int"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Custom "True" ] [ Type.Int ]
                                  , implementation =
                                        [ AST.Integer 1
                                        ]
                                  }
                                ]
                        }
                in
                case parse source of
                    Err () ->
                        Expect.fail "Did not expect parsing to fail"

                    Ok ast ->
                        Expect.equal expectedAst ast
        , test "Custom data structure with fields" <|
            \_ ->
                let
                    source =
                        [ Metadata "deftype"
                        , Type "Person"
                        , Metadata ""
                        , ListStart
                        , Metadata "age"
                        , Type "Int"
                        , Metadata "jobs"
                        , Type "Int"
                        , ListEnd

                        -- get-age
                        , Metadata "def"
                        , Symbol "get-age"
                        , Metadata "type"
                        , Type "Person"
                        , TypeSeperator
                        , Type "Int"
                        , Metadata ""
                        , Token.Symbol "age>"
                        ]

                    expectedAst =
                        { types =
                            Dict.fromListBy .name
                                [ { name = "Person"
                                  , members =
                                        [ ( "age", Type.Int )
                                        , ( "jobs", Type.Int )
                                        ]
                                  }
                                ]
                        , words =
                            Dict.fromListBy .name
                                [ { name = ">Person"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Int, Type.Int ] [ Type.Custom "Person" ]
                                  , implementation = [ AST.ConstructType "Person" ]
                                  }
                                , { name = ">age"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Custom "Person", Type.Int ] [ Type.Custom "Person" ]
                                  , implementation = [ AST.SetMember "Person" "age" ]
                                  }
                                , { name = ">jobs"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Custom "Person", Type.Int ] [ Type.Custom "Person" ]
                                  , implementation = [ AST.SetMember "Person" "jobs" ]
                                  }
                                , { name = "age>"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Custom "Person" ] [ Type.Int ]
                                  , implementation = [ AST.GetMember "Person" "age" ]
                                  }
                                , { name = "jobs>"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Custom "Person" ] [ Type.Int ]
                                  , implementation = [ AST.GetMember "Person" "jobs" ]
                                  }
                                , { name = "get-age"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Custom "Person" ] [ Type.Int ]
                                  , implementation =
                                        [ AST.Word "age>"
                                        ]
                                  }
                                ]
                        }
                in
                case parse source of
                    Err () ->
                        Expect.fail "Did not expect parsing to fail"

                    Ok ast ->
                        Expect.equal expectedAst ast
        ]

Modified tests/Test/Qualifier.elm from [0cecf73ea9] to [ec7132c8ba].

1
2


3
4
5
6
7
8
9
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
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
module Test.Qualifier exposing (..)



import Expect
import Play.Data.Metadata as Metadata
import Play.Parser as AST
import Play.Qualifier exposing (..)
import Test exposing (Test, describe, test)


suite : Test
suite =
    describe "Qualifier"
        [ test "Simple program" <|
            \_ ->
                let
                    defaultMeta =
                        Metadata.default


                    entryMeta =
                        { defaultMeta | isEntryPoint = True }

                    sourceDefinitions =
                        [ { name = "inc"
                          , metadata = defaultMeta
                          , implementation =
                                [ AST.Integer 1
                                , AST.Word "+"
                                ]
                          }
                        , { name = "dec"
                          , metadata = defaultMeta
                          , implementation =
                                [ AST.Integer 1
                                , AST.Word "-"
                                ]
                          }
                        , { name = "main"
                          , metadata = entryMeta


                          , implementation =
                                [ AST.Integer 1
                                , AST.Word "inc"
                                , AST.Word "inc"
                                , AST.Word "dec"
                                , AST.Integer 2
                                , AST.Word "="
                                ]
                          }
                        ]


                    expectedDefinitions =



                        [ { name = "inc"
                          , metadata = defaultMeta
                          , implementation =
                                [ Integer 1
                                , BuiltinPlus
                                ]
                          }
                        , { name = "dec"
                          , metadata = defaultMeta
                          , implementation =
                                [ Integer 1
                                , BuiltinMinus
                                ]
                          }
                        , { name = "main"
                          , metadata = entryMeta


                          , implementation =
                                [ Integer 1
                                , Word "inc"
                                , Word "inc"
                                , Word "dec"
                                , Integer 2
                                , BuiltinEqual
                                ]
                          }
                        ]

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

                    Ok definitions ->
                        Expect.equalLists expectedDefinitions definitions
        ]


>
>













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

|



|
|

1
2
3
4
5
6
7
8
9
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
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
86
87
88
89
90
91
92
module Test.Qualifier exposing (..)

import Dict
import Dict.Extra as Dict
import Expect
import Play.Data.Metadata as Metadata
import Play.Parser as AST
import Play.Qualifier exposing (..)
import Test exposing (Test, describe, test)


suite : Test
suite =
    describe "Qualifier"
        [ test "Simple program" <|
            \_ ->
                let
                    unqualifiedAst =
                        { types = Dict.empty

                        , words =
                            Dict.fromListBy .name



                                [ { name = "inc"
                                  , metadata = Metadata.default
                                  , implementation =
                                        [ AST.Integer 1
                                        , AST.Word "+"
                                        ]
                                  }
                                , { name = "dec"
                                  , metadata = Metadata.default
                                  , implementation =
                                        [ AST.Integer 1
                                        , AST.Word "-"
                                        ]
                                  }
                                , { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.asEntryPoint
                                  , implementation =
                                        [ AST.Integer 1
                                        , AST.Word "inc"
                                        , AST.Word "inc"
                                        , AST.Word "dec"
                                        , AST.Integer 2
                                        , AST.Word "="
                                        ]
                                  }
                                ]
                        }

                    expectedAst =
                        { types = Dict.empty
                        , words =
                            Dict.fromListBy .name
                                [ { name = "inc"
                                  , metadata = Metadata.default
                                  , implementation =
                                        [ Integer 1
                                        , BuiltinPlus
                                        ]
                                  }
                                , { name = "dec"
                                  , metadata = Metadata.default
                                  , implementation =
                                        [ Integer 1
                                        , BuiltinMinus
                                        ]
                                  }
                                , { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.asEntryPoint
                                  , implementation =
                                        [ Integer 1
                                        , Word "inc"
                                        , Word "inc"
                                        , Word "dec"
                                        , Integer 2
                                        , BuiltinEqual
                                        ]
                                  }
                                ]
                        }
                in
                case qualify unqualifiedAst of
                    Err () ->
                        Expect.fail "Did not expect qualification to fail"

                    Ok qualifiedAst ->
                        Expect.equal expectedAst qualifiedAst
        ]

Modified tests/Test/Tokenizer.elm from [71efbda39f] to [57b6e7051f].

53
54
55
56
57
58
59

















































60
61
62
63
64
65
66
67
                        , Integer 1
                        , Symbol "inc"
                        , Symbol "inc"
                        , Symbol "dec"
                        , Integer 2
                        , Symbol "="
                        ]

















































                in
                case tokenize source of
                    Err () ->
                        Expect.fail "Did not expect tokenization to fail"

                    Ok tokens ->
                        Expect.equalLists expectedTokens tokens
        ]







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








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
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
                        , Integer 1
                        , Symbol "inc"
                        , Symbol "inc"
                        , Symbol "dec"
                        , Integer 2
                        , Symbol "="
                        ]
                in
                case tokenize source of
                    Err () ->
                        Expect.fail "Did not expect tokenization to fail"

                    Ok tokens ->
                        Expect.equalLists expectedTokens tokens
        , test "Data structure without fields" <|
            \_ ->
                let
                    source =
                        """
                        deftype: True
                        """

                    expectedTokens =
                        [ Metadata "deftype"
                        , Type "True"
                        ]
                in
                case tokenize source of
                    Err () ->
                        Expect.fail "Did not expect tokenization to fail"

                    Ok tokens ->
                        Expect.equalLists expectedTokens tokens
        , test "Data structure with fields" <|
            \_ ->
                let
                    source =
                        """
                        deftype: Person
                        : {
                            age: Int
                            jobs: Int
                        }
                        """

                    expectedTokens =
                        [ Metadata "deftype"
                        , Type "Person"
                        , Metadata ""
                        , ListStart
                        , Metadata "age"
                        , Type "Int"
                        , Metadata "jobs"
                        , Type "Int"
                        , ListEnd
                        ]
                in
                case tokenize source of
                    Err () ->
                        Expect.fail "Did not expect tokenization to fail"

                    Ok tokens ->
                        Expect.equalLists expectedTokens tokens
        ]

Modified tests/Test/TypeChecker.elm from [64e6abf301] to [8a9ecd20c4].

1
2


3
4
5
6
7
8
9
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
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
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


















































































































module Test.TypeChecker exposing (..)



import Expect
import Play.Data.Metadata as Metadata exposing (Metadata)
import Play.Data.Type as Type
import Play.Qualifier as QAST
import Play.TypeChecker exposing (..)
import Test exposing (Test, describe, test)


defaultMeta : Metadata
defaultMeta =
    Metadata.default


suite : Test
suite =
    describe "TypeChecker"
        [ test "Simple program" <|
            \_ ->
                let
                    entryMeta =
                        { defaultMeta | isEntryPoint = True }

                    input =



                        [ { name = "inc"
                          , metadata = defaultMeta
                          , implementation =
                                [ QAST.Integer 1
                                , QAST.BuiltinPlus
                                ]
                          }
                        , { name = "dec"
                          , metadata = defaultMeta
                          , implementation =
                                [ QAST.Integer 1
                                , QAST.BuiltinMinus
                                ]
                          }
                        , { name = "main"
                          , metadata = entryMeta


                          , implementation =
                                [ QAST.Integer 1
                                , QAST.Word "inc"
                                , QAST.Word "inc"
                                , QAST.Word "dec"
                                , QAST.Integer 2
                                , QAST.BuiltinEqual
                                ]
                          }
                        ]


                    expectedResult =



                        [ { name = "inc"
                          , type_ = { input = [ Type.Int ], output = [ Type.Int ] }
                          , metadata = defaultMeta
                          , implementation =
                                [ IntLiteral 1
                                , BuiltinPlus
                                ]
                          }
                        , { name = "dec"
                          , type_ = { input = [ Type.Int ], output = [ Type.Int ] }
                          , metadata = defaultMeta
                          , implementation =
                                [ IntLiteral 1
                                , BuiltinMinus
                                ]
                          }
                        , { name = "main"
                          , type_ = { input = [], output = [ Type.Int ] }
                          , metadata = entryMeta


                          , implementation =
                                [ IntLiteral 1
                                , Word "inc" { input = [ Type.Int ], output = [ Type.Int ] }
                                , Word "inc" { input = [ Type.Int ], output = [ Type.Int ] }
                                , Word "dec" { input = [ Type.Int ], output = [ Type.Int ] }
                                , IntLiteral 2
                                , BuiltinEqual
                                ]
                          }
                        ]
                            |> List.sortBy .name

                in
                case typeCheck input of
                    Err () ->
                        Expect.fail "Did not expect typecheck to fail."

                    Ok typedAst ->
                        Expect.equalLists expectedResult typedAst
        , test "Bad type annotation" <|
            \_ ->
                let
                    input =



                        [ { name = "main"
                          , metadata = { defaultMeta | type_ = Just { input = [ Type.Int ], output = [] } }



                          , implementation =
                                [ QAST.Integer 1
                                , QAST.Integer 2
                                , QAST.BuiltinEqual
                                ]
                          }
                        ]

                in
                case typeCheck input of
                    Err () ->
                        Expect.pass

                    Ok _ ->
                        Expect.fail "Did not expect type check to succeed."











        ]




















































































































>
>







<
<
<
<
<







<
<
<

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

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






|




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







>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
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
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
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
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
246
247
module Test.TypeChecker exposing (..)

import Dict
import Dict.Extra as Dict
import Expect
import Play.Data.Metadata as Metadata exposing (Metadata)
import Play.Data.Type as Type
import Play.Qualifier as QAST
import Play.TypeChecker exposing (..)
import Test exposing (Test, describe, test)







suite : Test
suite =
    describe "TypeChecker"
        [ test "Simple program" <|
            \_ ->
                let



                    input =
                        { types = Dict.empty
                        , words =
                            Dict.fromListBy .name
                                [ { name = "inc"
                                  , metadata = Metadata.default
                                  , implementation =
                                        [ QAST.Integer 1
                                        , QAST.BuiltinPlus
                                        ]
                                  }
                                , { name = "dec"
                                  , metadata = Metadata.default
                                  , implementation =
                                        [ QAST.Integer 1
                                        , QAST.BuiltinMinus
                                        ]
                                  }
                                , { name = "main"
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.asEntryPoint
                                  , implementation =
                                        [ QAST.Integer 1
                                        , QAST.Word "inc"
                                        , QAST.Word "inc"
                                        , QAST.Word "dec"
                                        , QAST.Integer 2
                                        , QAST.BuiltinEqual
                                        ]
                                  }
                                ]
                        }

                    expectedResult =
                        { types = Dict.empty
                        , words =
                            Dict.fromListBy .name
                                [ { name = "inc"
                                  , type_ = { input = [ Type.Int ], output = [ Type.Int ] }
                                  , metadata = Metadata.default
                                  , implementation =
                                        [ IntLiteral 1
                                        , BuiltinPlus
                                        ]
                                  }
                                , { name = "dec"
                                  , type_ = { input = [ Type.Int ], output = [ Type.Int ] }
                                  , metadata = Metadata.default
                                  , implementation =
                                        [ IntLiteral 1
                                        , BuiltinMinus
                                        ]
                                  }
                                , { name = "main"
                                  , type_ = { input = [], output = [ Type.Int ] }
                                  , metadata =
                                        Metadata.default
                                            |> Metadata.asEntryPoint
                                  , implementation =
                                        [ IntLiteral 1
                                        , Word "inc" { input = [ Type.Int ], output = [ Type.Int ] }
                                        , Word "inc" { input = [ Type.Int ], output = [ Type.Int ] }
                                        , Word "dec" { input = [ Type.Int ], output = [ Type.Int ] }
                                        , IntLiteral 2
                                        , BuiltinEqual
                                        ]
                                  }
                                ]

                        }
                in
                case typeCheck input of
                    Err () ->
                        Expect.fail "Did not expect typecheck to fail."

                    Ok typedAst ->
                        Expect.equal expectedResult typedAst
        , test "Bad type annotation" <|
            \_ ->
                let
                    input =
                        { types = Dict.empty
                        , words =
                            Dict.fromListBy .name
                                [ { name = "main"

                                  , metadata =
                                        Metadata.default
                                            |> Metadata.withType [ Type.Int ] []
                                  , implementation =
                                        [ QAST.Integer 1
                                        , QAST.Integer 2
                                        , QAST.BuiltinEqual
                                        ]
                                  }
                                ]
                        }
                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.BuiltinPlus
                                        , 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"

                    Ok _ ->
                        Expect.pass
        ]

Modified wasm_tests/wasm.test.js from [3c681334e4] to [5da770b938].

3
4
5
6
7
8
9

10
11
12
13
14
15
16
17
18
19
20
21
22
23

24
25
















26


















27
28
29
30
31
32
33
..
56
57
58
59
60
61
62





63





64
65








test('Simple expression', async () => {
    const wat = await compileToWat(`
        def: main
        entry: true
        : 1 1 +
    `);

    const result = await runCode(wat, 'main');

    expect(result).toBe(2);
});

test('Function calls', async () => {
    const wat = await compileToWat(`
        def: main
        entry: true
        : 1 inc inc

        def: inc
        : 1 +
    `);

    const result = await runCode(wat, 'main');

















    expect(result).toBe(3);


















});

// Helpers

function compileToWat(sourceCode) {
    return new Promise((resolve, reject) => {
        const compiler = Compiler.Elm.Main.init({});
................................................................................
            memory: memory
        }
    };

    const program = await WebAssembly.instantiate(wasmModule, imports);
    program.instance.exports[functionName]();






    const memoryView = new Uint32Array(memory.buffer, 0, 20);





    return memoryView[1];
}














>


|











>


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







 







>
>
>
>
>
|
>
>
>
>
>
|
|
>
>
>
>
>
>
>
3
4
5
6
7
8
9
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
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
..
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

test('Simple expression', async () => {
    const wat = await compileToWat(`
        def: main
        entry: true
        : 1 1 +
    `);

    const result = await runCode(wat, 'main');

    expect(result.valueOnBottomOfStack()).toBe(2);
});

test('Function calls', async () => {
    const wat = await compileToWat(`
        def: main
        entry: true
        : 1 inc inc

        def: inc
        : 1 +
    `);

    const result = await runCode(wat, 'main');

    expect(result.valueOnBottomOfStack()).toBe(3);
});

test('Enum type', async () => {
    const wat = await compileToWat(`
       deftype: True 
       deftype: False

       def: main
       entry: true
       : >True
    `);

    const result = await runCode(wat, 'main');

    // types are sorted alphabetically, so False will get id 0, and True gets id 1.
    expect(result.typeIdForPointer()).toBe(1);
});

test('Compound type', async () => {
    const wat = await compileToWat(`
        deftype: Person
        : { age: Int }

        def: inc-age
        : age> 1 + >Person

        def: main
        entry: true
        : 1 >Person 19 >age inc-age age>
    `);

    const result = await runCode(wat, 'main');

    expect(result.valueOnBottomOfStack()).toBe(20);
});

// Helpers

function compileToWat(sourceCode) {
    return new Promise((resolve, reject) => {
        const compiler = Compiler.Elm.Main.init({});
................................................................................
            memory: memory
        }
    };

    const program = await WebAssembly.instantiate(wasmModule, imports);
    program.instance.exports[functionName]();

    return new ExecutionResult(memory.buffer);
}

class ExecutionResult {
    constructor(memoryBuffer) {
        this.memoryView = new Uint32Array(memoryBuffer, 0, 512);
    }

    valueOnBottomOfStack() {
        // The first three I32 positions are used for stack and heap information
        // The fourth position is the first element of the stack
        return this.memoryView[3];
    }

    typeIdForPointer() {
        const pointer = this.valueOnBottomOfStack();
        const wordPointer = pointer / 4;
        return this.memoryView[wordPointer];
    }
}