Play

Changes On Branch codegen-generic-multiwords
Login

Changes In Branch codegen-generic-multiwords Excluding Merge-Ins

This is equivalent to a diff from 1f6d7fad40 to 46a4d80dc8

2020-08-12
12:31
Auto (un)boxing of integers that are involved as the target of multiwords. Fixes [143c4a153a]. check-in: 24260843e0 user: robin.hansen tags: trunk
12:29
Remove codegen test case for pattern matches including generics. This will be added back in, in a la... Closed-Leaf check-in: 46a4d80dc8 user: robin.hansen tags: codegen-generic-multiwords
12:28
Support boxed integers when matching for a specific int value. check-in: 52ae8dcc51 user: robin.hansen tags: codegen-generic-multiwords
2020-08-07
14:02
Add tests for currently missing functionality in codegen check-in: 435bf2d49e user: robin.hansen tags: codegen-generic-multiwords
2020-08-06
10:52
Can now use parens in type signatures for expressing generic types and unions. check-in: 1f6d7fad40 user: robin.hansen tags: trunk
2020-08-05
14:14
Support recursive words and fix type checking issue with union comparision.

Detect recursive words ... check-in: 3aba10c79c user: robin.hansen tags: trunk


Modified src/Play/Codegen.elm from [ac0268c65a] to [3963448ae1].

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











17
18
19
20
21
22
23
..
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
..
56
57
58
59
60
61
62

63



64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
..
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
...
127
128
129
130
131
132
133



















134
135
136
137
138
139
140
...
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
...
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
...
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
...
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
...
338
339
340
341
342
343
344






345
346
347
348
349
350
351
352
module Play.Codegen exposing (..)

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


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














-- Codegen


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


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



toWasmFuncDef : Dict String TypeInformation -> AST.WordDefinition -> Wasm.FunctionDef



toWasmFuncDef typeInfo def =
    let
        wasmImplementation =
            case def.implementation of
                AST.MultiImpl whens defaultImpl ->
                    [ multiFnToInstructions typeInfo def whens defaultImpl ]

                AST.SoloImpl impl ->
                    List.map (nodeToInstruction typeInfo) impl

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










































































































































multiFnToInstructions :
    Dict String TypeInformation

    -> AST.WordDefinition
    -> List ( AST.TypeMatch, List AST.AstNode )
    -> List AST.AstNode
    -> Wasm.Instruction
multiFnToInstructions typeInfo def whens defaultImpl =
    let
        branches =
            List.foldl buildBranch (Wasm.Batch []) whens

        buildBranch ( type_, nodes ) previousBranch =
            let
                testForInequality =
                    makeInequalityTest type_ 0

                makeInequalityTest t_ localIdx =
                    case t_ of














                        AST.TypeMatch (Type.Custom name) conditions ->
                            whenSetup localIdx name conditions

                        AST.TypeMatch (Type.CustomGeneric name _) conditions ->
                            whenSetup localIdx name conditions

                        _ ->
................................................................................
                        , Wasm.I32_Const typeId
                        , Wasm.I32_NotEq -- Types doesn't match?
                        , Wasm.BreakIf 0 -- Move to next branch if above test is true
                        , conditions
                            |> List.concatMap (conditionTest localIdx)
                            |> Wasm.Batch
                        ]




















                conditionTest localIdx ( fieldName, value ) =
                    case value of
                        AST.LiteralInt num ->
                            [ Wasm.Local_Get localIdx
                            , Wasm.Call BaseModule.stackPushFn
                            , Wasm.Call <| fieldName ++ ">"
................................................................................
                            , Wasm.Call BaseModule.stackPopFn
                            , Wasm.Local_Set nextLocalIdx
                            , makeInequalityTest match nextLocalIdx
                            ]

                implementation =
                    nodes
                        |> List.map (nodeToInstruction typeInfo)
                        |> Wasm.Batch
            in
            Wasm.Block
                [ previousBranch
                , testForInequality
                , implementation
                , Wasm.Return
................................................................................
            max 0 (List.length def.type_.input - 1)
    in
    Wasm.Batch
        [ Wasm.I32_Const selfIndex
        , Wasm.Call BaseModule.stackGetElementFn
        , Wasm.Local_Set 0 -- store instance id in local
        , branches
        , Wasm.Batch (List.map (nodeToInstruction typeInfo) defaultImpl)
        ]


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 BaseModule.stackPushFn
                ]

        AST.Word value _ ->
            Wasm.Call value

        AST.WordRef name ->
            Wasm.FunctionIndex name

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

                        memberSize =
................................................................................
                        , Wasm.Local_Get 0
                        , Wasm.Call BaseModule.stackPushFn
                        ]

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

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

                        memberSize =
................................................................................

                        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 BaseModule.stackPopFn -- Get instance address
                        , Wasm.I32_Const ((memberIndex + 1) * BaseModule.wasmPtrSize) -- Calculate member offset
                        , Wasm.I32_Add -- Calculate member address
                        , Wasm.I32_Load -- Retrieve member
                        , Wasm.Call BaseModule.stackPushFn -- Push member onto stack
                        ]

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

        AST.Builtin builtin ->
            case builtin of
                Builtin.Plus ->
                    Wasm.Call BaseModule.addIntFn

                Builtin.Minus ->
                    Wasm.Call BaseModule.subIntFn

................................................................................
                    Wasm.Call BaseModule.rotFn

                Builtin.StackLeftRotate ->
                    Wasm.Call BaseModule.leftRotFn

                Builtin.Apply ->
                    Wasm.CallIndirect








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





|
|









>
>
>
>
>
>
>
>
>
>
>







 







|







 







>
|
>
>
>
|



|
|

|
|







 








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


>




|











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







 







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







 







|







 







|



|


|





|


|


|







 







|







 







|













|







 







>
>
>
>
>
>








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
..
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
..
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
..
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
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
...
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
...
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
...
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
...
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
...
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
...
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
module Play.Codegen exposing (..)

import Dict exposing (Dict)
import List.Extra as List
import Play.Codegen.BaseModule as BaseModule
import Play.Data.Builtin as Builtin exposing (Builtin)
import Play.Data.Type as Type exposing (Type, WordType)
import Play.TypeChecker as AST exposing (AST)
import Wasm


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


type AstNode
    = IntLiteral Int
    | Word String WordType
    | WordRef String
    | ConstructType String
    | SetMember String String Type
    | GetMember String String Type
    | Builtin Builtin
    | PromoteInt Int



-- Codegen


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


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


toWasmFuncDef :
    Dict String TypeInformation
    -> AST
    -> AST.WordDefinition
    -> Wasm.FunctionDef
toWasmFuncDef typeInfo ast def =
    let
        wasmImplementation =
            case def.implementation of
                AST.SoloImpl impl ->
                    astNodesToInstructions typeInfo ast def impl

                AST.MultiImpl whens defaultImpl ->
                    [ multiFnToInstructions typeInfo ast def whens defaultImpl ]

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


astNodesToInstructions :
    Dict String TypeInformation
    -> AST
    -> AST.WordDefinition
    -> List AST.AstNode
    -> List Wasm.Instruction
astNodesToInstructions typeInfo ast def astNodes =
    astNodes
        |> List.foldl (astNodeToCodegenNode ast) ( def.type_.input, [] )
        |> Tuple.second
        |> List.reverse
        |> List.map (nodeToInstruction typeInfo)


astNodeToCodegenNode :
    AST
    -> AST.AstNode
    -> ( List Type, List AstNode )
    -> ( List Type, List AstNode )
astNodeToCodegenNode ast node ( stack, result ) =
    let
        newNode =
            case node of
                AST.IntLiteral val ->
                    IntLiteral val

                AST.Word name type_ ->
                    Word name type_

                AST.WordRef name ->
                    WordRef name

                AST.ConstructType typeName ->
                    ConstructType typeName

                AST.SetMember typeName memberName type_ ->
                    SetMember typeName memberName type_

                AST.GetMember typeName memberName type_ ->
                    GetMember typeName memberName type_

                AST.Builtin builtin ->
                    Builtin builtin

        nodeType =
            case node of
                AST.IntLiteral _ ->
                    { input = []
                    , output = [ Type.Int ]
                    }

                AST.Word _ type_ ->
                    type_

                AST.WordRef name ->
                    case Dict.get name ast.words of
                        Just def ->
                            { input = []
                            , output = [ Type.Quotation def.type_ ]
                            }

                        Nothing ->
                            Debug.todo "help"

                AST.ConstructType typeName ->
                    case Dict.get typeName ast.types of
                        Just (AST.CustomTypeDef _ gens members) ->
                            { input = List.map Tuple.second members
                            , output = [ typeFromTypeDef typeName gens ]
                            }

                        _ ->
                            Debug.todo "help"

                AST.SetMember typeName _ memberType ->
                    case Dict.get typeName ast.types of
                        Just (AST.CustomTypeDef _ gens _) ->
                            let
                                type_ =
                                    typeFromTypeDef typeName gens
                            in
                            { input = [ type_, memberType ]
                            , output = [ type_ ]
                            }

                        _ ->
                            Debug.todo "help"

                AST.GetMember typeName _ memberType ->
                    case Dict.get typeName ast.types of
                        Just (AST.CustomTypeDef _ gens _) ->
                            let
                                type_ =
                                    typeFromTypeDef typeName gens
                            in
                            { input = [ type_ ]
                            , output = [ memberType ]
                            }

                        _ ->
                            Debug.todo "help"

                AST.Builtin builtin ->
                    Builtin.wordType builtin

        typeFromTypeDef typeName gens =
            if List.isEmpty gens then
                Type.Custom typeName

            else
                Type.CustomGeneric typeName (List.map Type.Generic gens)

        intsToPromote =
            List.map2 Tuple.pair (List.reverse stack) (List.reverse nodeType.input)
                |> List.indexedMap (\i ( l, r ) -> ( i, l, r ))
                |> List.filterMap maybePromoteInt

        maybePromoteInt ( idx, leftType, rightType ) =
            case ( leftType, rightType ) of
                ( Type.Int, Type.Union _ ) ->
                    Just (PromoteInt idx)

                _ ->
                    Nothing

        newStack =
            List.reverse stack
                |> List.drop (List.length nodeType.input)
                |> (\s -> List.reverse nodeType.output ++ s)
                |> List.reverse
    in
    ( newStack
    , newNode :: (intsToPromote ++ result)
    )


multiFnToInstructions :
    Dict String TypeInformation
    -> AST
    -> AST.WordDefinition
    -> List ( AST.TypeMatch, List AST.AstNode )
    -> List AST.AstNode
    -> Wasm.Instruction
multiFnToInstructions typeInfo ast def whens defaultImpl =
    let
        branches =
            List.foldl buildBranch (Wasm.Batch []) whens

        buildBranch ( type_, nodes ) previousBranch =
            let
                testForInequality =
                    makeInequalityTest type_ 0

                makeInequalityTest t_ localIdx =
                    case t_ of
                        AST.TypeMatch Type.Int conditions ->
                            Wasm.Batch
                                [ Wasm.Local_Get localIdx
                                , Wasm.I32_Load -- Load instance id
                                , Wasm.I32_Const BaseModule.intBoxId
                                , Wasm.I32_NotEq -- Types doesn't match?
                                , Wasm.BreakIf 0 -- Move to next branch if above test is true
                                , Wasm.I32_Const selfIndex
                                , conditions
                                    |> List.concatMap (matchingIntTest localIdx)
                                    |> Wasm.Batch
                                , Wasm.Call BaseModule.demoteIntFn
                                ]

                        AST.TypeMatch (Type.Custom name) conditions ->
                            whenSetup localIdx name conditions

                        AST.TypeMatch (Type.CustomGeneric name _) conditions ->
                            whenSetup localIdx name conditions

                        _ ->
................................................................................
                        , Wasm.I32_Const typeId
                        , Wasm.I32_NotEq -- Types doesn't match?
                        , Wasm.BreakIf 0 -- Move to next branch if above test is true
                        , conditions
                            |> List.concatMap (conditionTest localIdx)
                            |> Wasm.Batch
                        ]

                matchingIntTest localIdx ( _, astValue ) =
                    let
                        value =
                            case astValue of
                                AST.LiteralInt num ->
                                    num

                                _ ->
                                    0
                    in
                    [ Wasm.Local_Get localIdx
                    , Wasm.I32_Const BaseModule.wasmPtrSize
                    , Wasm.I32_Add
                    , Wasm.I32_Load -- int value
                    , Wasm.I32_Const value
                    , Wasm.I32_NotEq -- not same number?
                    , Wasm.BreakIf 0 -- move to next branch
                    ]

                conditionTest localIdx ( fieldName, value ) =
                    case value of
                        AST.LiteralInt num ->
                            [ Wasm.Local_Get localIdx
                            , Wasm.Call BaseModule.stackPushFn
                            , Wasm.Call <| fieldName ++ ">"
................................................................................
                            , Wasm.Call BaseModule.stackPopFn
                            , Wasm.Local_Set nextLocalIdx
                            , makeInequalityTest match nextLocalIdx
                            ]

                implementation =
                    nodes
                        |> astNodesToInstructions typeInfo ast def
                        |> Wasm.Batch
            in
            Wasm.Block
                [ previousBranch
                , testForInequality
                , implementation
                , Wasm.Return
................................................................................
            max 0 (List.length def.type_.input - 1)
    in
    Wasm.Batch
        [ Wasm.I32_Const selfIndex
        , Wasm.Call BaseModule.stackGetElementFn
        , Wasm.Local_Set 0 -- store instance id in local
        , branches
        , Wasm.Batch (astNodesToInstructions typeInfo ast def defaultImpl)
        ]


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

        Word value _ ->
            Wasm.Call value

        WordRef name ->
            Wasm.FunctionIndex name

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

                        memberSize =
................................................................................
                        , Wasm.Local_Get 0
                        , Wasm.Call BaseModule.stackPushFn
                        ]

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

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

                        memberSize =
................................................................................

                        Nothing ->
                            Debug.todo "NOOOOO!"

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

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

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

        Builtin builtin ->
            case builtin of
                Builtin.Plus ->
                    Wasm.Call BaseModule.addIntFn

                Builtin.Minus ->
                    Wasm.Call BaseModule.subIntFn

................................................................................
                    Wasm.Call BaseModule.rotFn

                Builtin.StackLeftRotate ->
                    Wasm.Call BaseModule.leftRotFn

                Builtin.Apply ->
                    Wasm.CallIndirect

        PromoteInt stackPos ->
            Wasm.Batch
                [ Wasm.I32_Const stackPos
                , Wasm.Call BaseModule.promoteIntFn
                ]


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/Codegen/BaseModule.elm from [25136384d7] to [9f03c60415].

28
29
30
31
32
33
34





35
36
37
38
39
40
41
...
106
107
108
109
110
111
112















113
114
115
116
117
118
119
...
406
407
408
409
410
411
412
413




































































initialHeapPositionOffset : Int
initialHeapPositionOffset =
    stackPositionOffset + wasmPtrSize








-- Bultin function names


allocFn : String
allocFn =
    "__alloc"
................................................................................
    "__left_rotate"


stackGetElementFn : String
stackGetElementFn =
    "__stack_get"


















-- Base module


baseModule : Wasm.Module
baseModule =
................................................................................
                , Wasm.Local_Get 0 -- read offset
                , Wasm.I32_Const 1
                , Wasm.I32_Add -- add one to offset
                , Wasm.I32_Mul -- offset * ptrSize
                , Wasm.I32_Sub -- stackPosition - ptrOffset
                , Wasm.I32_Load
                ]
            }









































































>
>
>
>
>







 







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







 








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
...
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
...
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499


initialHeapPositionOffset : Int
initialHeapPositionOffset =
    stackPositionOffset + wasmPtrSize


intBoxId : Int
intBoxId =
    -1



-- Bultin function names


allocFn : String
allocFn =
    "__alloc"
................................................................................
    "__left_rotate"


stackGetElementFn : String
stackGetElementFn =
    "__stack_get"


stackReplaceElementFn : String
stackReplaceElementFn =
    "__stack_replace"


promoteIntFn : String
promoteIntFn =
    "__promote_int"


demoteIntFn : String
demoteIntFn =
    "__demote_int"



-- Base module


baseModule : Wasm.Module
baseModule =
................................................................................
                , Wasm.Local_Get 0 -- read offset
                , Wasm.I32_Const 1
                , Wasm.I32_Add -- add one to offset
                , Wasm.I32_Mul -- offset * ptrSize
                , Wasm.I32_Sub -- stackPosition - ptrOffset
                , Wasm.I32_Load
                ]
            }
        |> Wasm.withFunction
            { name = stackReplaceElementFn
            , exported = False
            , isIndirectlyCalled = False
            , args = [ Wasm.Int32, Wasm.Int32 ]
            , results = []
            , locals = []
            , instructions =
                [ Wasm.I32_Const stackPositionOffset
                , Wasm.I32_Load
                , Wasm.I32_Const wasmPtrSize
                , Wasm.Local_Get 0 -- read offset
                , Wasm.I32_Const 1
                , Wasm.I32_Add -- add one to offset
                , Wasm.I32_Mul -- offset * ptrSize
                , Wasm.I32_Sub -- stackPosition - ptrOffset
                , Wasm.Local_Get 1
                , Wasm.I32_Store
                ]
            }
        |> Wasm.withFunction
            { name = promoteIntFn
            , exported = False
            , isIndirectlyCalled = False
            , args = [ Wasm.Int32 ]
            , results = []
            , locals = [ Wasm.Int32 ]
            , instructions =
                let
                    typeSize =
                        -- type descriptor and value
                        wasmPtrSize * 2
                in
                [ Wasm.I32_Const typeSize
                , Wasm.Call allocFn
                , Wasm.Local_Tee 1
                , Wasm.I32_Const intBoxId
                , Wasm.I32_Store
                , Wasm.Local_Get 1
                , Wasm.I32_Const wasmPtrSize
                , Wasm.I32_Add
                , Wasm.Local_Get 0
                , Wasm.Call stackGetElementFn
                , Wasm.I32_Store
                , Wasm.Local_Get 0
                , Wasm.Local_Get 1
                , Wasm.Call stackReplaceElementFn
                ]
            }
        |> Wasm.withFunction
            { name = demoteIntFn
            , exported = False
            , isIndirectlyCalled = False
            , args = [ Wasm.Int32 ]
            , results = []
            , locals = []
            , instructions =
                [ Wasm.Local_Get 0
                , Wasm.Local_Get 0
                , Wasm.Call stackGetElementFn
                , Wasm.I32_Const wasmPtrSize
                , Wasm.I32_Add
                , Wasm.I32_Load
                , Wasm.Call stackReplaceElementFn
                ]
            }

Modified wasm_tests/multiword.test.js from [ddfb268d1f] to [8bc6beabdc].

152
153
154
155
156
157
158




























































          sum
    `);

    const result = await compiler.run(wat, 'main');

    expect(result.stackElement()).toBe(6);
});



































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
          sum
    `);

    const result = await compiler.run(wat, 'main');

    expect(result.stackElement()).toBe(6);
});

test('Int case', async () => {
    const wat = await compiler.toWat(`
        defunion: Bool
        : Int
        : NoInt

        deftype: NoInt

        defmulti: double
        when: Int
          2 *
        when: NoInt
          drop 0

        def: main
        entry: true
        : 4 double
    `);

    const result = await compiler.run(wat, 'main');

    expect(result.stackElement()).toBe(8);
});

test('Int match', async () => {
    const wat = await compiler.toWat(`
        defmulti: double
        when: Int( value 0 )
          drop 2
        when: Int
          2 *

        def: main
        entry: true
        : 0 double
    `);

    const result = await compiler.run(wat, 'main');

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

test('Int match (reverse)', async () => {
    const wat = await compiler.toWat(`
        defmulti: double
        when: Int( value 0 )
          drop 2
        when: Int
          2 *

        def: main
        entry: true
        : 6 double
    `);

    const result = await compiler.run(wat, 'main');

    expect(result.stackElement()).toBe(12);
});