From 401aec67d056644d4dfebbd045cd930ead3578bc Mon Sep 17 00:00:00 2001 From: YetAnotherMinion Date: Fri, 7 Jan 2022 23:57:28 +0000 Subject: [PATCH] fix: Astrid.Query.andThen compose with map* Reserve stack slots for andThen values and fill them in later. The old approach of a strict stack machine was wrong. --- .../src/CombinatorsTest.elm | 76 +++++++--- lib/sql/src/Astrid/Query.elm | 7 +- src/exec/fixtures/README.md | 127 ++++++++++++++++ src/exec/mod.rs | 8 +- src/fixture/query.js | 138 ++++++++++-------- 5 files changed, 271 insertions(+), 85 deletions(-) create mode 100644 src/exec/fixtures/README.md diff --git a/examples/sqlite-integration/src/CombinatorsTest.elm b/examples/sqlite-integration/src/CombinatorsTest.elm index 9dfc352..66a455b 100644 --- a/examples/sqlite-integration/src/CombinatorsTest.elm +++ b/examples/sqlite-integration/src/CombinatorsTest.elm @@ -1,12 +1,13 @@ -module CombinatorsTest exposing (main) +module CombinatorsTest exposing (testMap3, testAndThen, testDeep) -import Astrid.Query exposing (fetch, execute, errorToString, map3, fetchOne, andThen) +import Astrid.Query exposing (fetch, execute, errorToString, map3, fetchOne, andThen, map) import Json.Decode import Html exposing (Html, ul, li, text, code, node, div) import Array.Extra -main : Html msg -main = + +testMap3 : Html msg +testMap3 = let query = map3 @@ -14,33 +15,62 @@ main = one ++ " " ++ two ++ " " ++ three ) (fetchOne "select json_quote('a')" [] Json.Decode.string) - {- - (andThen - (\right -> - map - (\v -> - "andThen( " ++ v ++ "" - ) - (andThen - (\left -> - succeed "andThen" - ) - ) - ) - (fetchOne "select json_quote('b')" [] Json.Decode.string) - ) - -} (fetchOne "select json_quote('b')" [] Json.Decode.string) (fetchOne "select json_quote('c')" [] Json.Decode.string) in - case execute query of - Ok result -> + viewResult (execute query) + + +testAndThen : Html msg +testAndThen = + let + query = + andThen + (\_ -> + (fetchOne "select json_quote('d')" [] Json.Decode.string) + ) + (fetchOne "select json_quote('b')" [] Json.Decode.string) + in + viewResult (execute query) + + +testDeep : Html msg +testDeep = + let + query = + map3 + (\one two three -> + one ++ " " ++ two ++ " " ++ three + ) + (map + (\x -> "andThen(" ++ x ++ ")") + ( andThen + (\y -> + map + (\z -> + y ++ "->" ++ z + ) + (fetchOne "select json_quote('d')" [] Json.Decode.string) + ) + (fetchOne "select json_quote('a')" [] Json.Decode.string) + ) + ) + (fetchOne "select json_quote('b')" [] Json.Decode.string) + (fetchOne "select json_quote('c')" [] Json.Decode.string) + in + viewResult (execute query) + + +viewResult : Result Astrid.Query.Error String -> Html msg +viewResult result = + case result of + Ok x -> div [] [ node "style" [] [ text "code { background-color: #f6f7f9; display: block; padding: 1em; border-radius: 4px; border 1px solid #eee; } " ] , code [] - [ text result ] + [ text x ] ] Err error -> diff --git a/lib/sql/src/Astrid/Query.elm b/lib/sql/src/Astrid/Query.elm index 3f50703..175b3ad 100644 --- a/lib/sql/src/Astrid/Query.elm +++ b/lib/sql/src/Astrid/Query.elm @@ -1,6 +1,7 @@ module Astrid.Query exposing - ( Query + ( Error + , Query , andThen , errorToString , execute @@ -54,7 +55,7 @@ javascript. dummyExecute : Result Error a dummyExecute = let - query = Dummy + _ = Dummy _ = Execute "" "" _ = Decode "" 0 (Json.Decode.Failure "" Json.Encode.null) _ = Failure "" @@ -96,5 +97,5 @@ map5 f a b c d e = Dummy andThen : (a -> Query b) -> Query a -> Query b -andThen f a = +andThen f q = Dummy diff --git a/src/exec/fixtures/README.md b/src/exec/fixtures/README.md new file mode 100644 index 0000000..e226f10 --- /dev/null +++ b/src/exec/fixtures/README.md @@ -0,0 +1,127 @@ + +# Query batching + +Step 1) + queries = [ (0, map3 fA (succeed x) (map fB (andThen (\_ -> succeed j) (succeed k))) (succeed y)) ] + values = [ Pending ] + callbacks = [] +Step 1.A) + query = map3 fA (succeed x) (map fB (andThen (\_ -> succeed j) (succeed k))) (succeed y) ] + + +Step 2) + queries = [ (1, succeed x), (2, (map fB (andThen (\_ -> succeed j) (succeed k)))), (3, (succeed y)) ] + values = [Pending, Pending, Pending, Pending] + callbacks = [ (0, fA) ] + +Step 2.A) + query = (3, succeed y) + +Step 3) + queries = [ (1, succeed x), (2, (map fB (andThen (\_ -> succeed j) (succeed k)))), ] + values = [ Pending, Pending, Pending, Ready y ] + callbacks = [ (0, fA) ] + +Step 3.A) + query = (2, (map fB (andThen (\_ -> succeed j) (succeed k)))) + +Step 4) + queries = [ (1, succeed x), (4, (andThen (\_ -> succeed j) (succeed k))) ] + values = [ Pending, Pending, Pending, Ready y, Pending ] + callbacks = [ (0, fA), (2, fB) ] + +Step 4.A) + query = (4, (andThen (\_ -> succeed j) (succeed k))) + +Step 5) + queries = [ (1, succeed x), (5, succeed k) ] + values = [ Pending, Pending, Pending, Ready y, Pending, Pending ] + callbacks = [ (0, fA), (2, fB), (4, andThen (\_ -> succeed j)) ] + +Step 5.A) + query = (5, succeed k) + -- insert the value into position 5 + +Step 6) + queries = [ (1, succeed x) ] + values = [ Pending, Pending, Pending, Ready y, Pending, Ready k ] + callbacks = [ (0, fA), (2, fB), (4, andThen (\_ -> succeed j)) ] + +Step 6.A) + query = (1, succeed x) + -- insert the value into position 1 + +Step 6) + queries = [] + values = [ Pending, Ready x, Pending, Ready y, Pending, Ready k ] + callbacks = [ (0, fA), (2, fB), (4, andThen (\_ -> succeed j)) ] + +> Now go to reduce phase + +Reduce Step 1) + queries = [] + values = [ Pending, Ready x, Pending, Ready y, Pending, Ready k ] + callbacks = [ (0, fA), (2, fB), (4, andThen (\_ -> succeed j)) ] + +Reduce Step 1.A) + last = (4, andThen (\_ -> succeed j)) + value = values.pop() -- It should always be ready + -- call the callback to get the new query + queries.push(4, succeed j) + +Reduce Step 2) + queries = [ (4, succeed j) ] + values = [ Pending, Ready x, Pending, Ready y, Pending ] + callbacks = [ (0, fA), (2, fB) ] + +Reduce Step 2.A) + -- check that we have 1 arg ready at end of stack, no, so break the reduce step + + +> Now go back to query phase + +Step 7) + queries = [ (4, succeed j) ] + values = [ Pending, Ready x, Pending, Ready y, Pending ] + callbacks = [ (0, fA), (2, fB) ] + +Step 7.A) + query = (4, succeed j) + -- place value in slot 4 + +Step 8) + queries = [] + values = [ Pending, Ready x, Pending, Ready y, Ready j ] + callbacks = [ (0, fA), (2, fB) ] + +> Now go to reduce phase + +Reduce Step 3) + queries = [] + values = [ Pending, Ready x, Pending, Ready y, Ready j ] + callbacks = [ (0, fA), (2, fB) ] + +Reduece Step 3.A) + last = (2, fB) + -- We look at last 1 arg + args = [ Ready j ] + -- place (fB j) in slot 2 + +Reduce Step 4) + queries = [] + values = [ Pending, Ready x, Ready (fB j), Ready y ] + callbacks = [ (0, fA) ] + +Reduece Step 4.A) + last = (0, fA) + -- We look at last 3 args + args = [ Ready x, Ready (fB j), Ready y ] + -- They are all ready + -- place (fA x (fB j) y) in slot 0 + +Reduce Step 5) + queries = [] + values = [ Ready (fA x (fB j) y) ] + callbacks = [] + +-- Termination criteria reached, return values[0] diff --git a/src/exec/mod.rs b/src/exec/mod.rs index 7847994..2b00ce6 100644 --- a/src/exec/mod.rs +++ b/src/exec/mod.rs @@ -210,11 +210,15 @@ pub(crate) fn exec( ) .replace( "var $author$project$Astrid$Query$map2 = F3(\n\tfunction (f, a, b) {\n\t\treturn $author$project$Astrid$Query$Dummy;\n\t});", - r#"var $author$project$Astrid$Query$map3 = _Query_map2;"#, + r#"var $author$project$Astrid$Query$map2 = _Query_map2;"#, ) .replace( "var $author$project$Astrid$Query$map = F2(\n\tfunction (f, a) {\n\t\treturn $author$project$Astrid$Query$Dummy;\n\t});", - r#"var $author$project$Astrid$Query$map3 = _Query_map1;"#, + r#"var $author$project$Astrid$Query$map = _Query_map1;"#, + ) + .replace( + "var $author$project$Astrid$Query$andThen = F2(\n\tfunction (f, q) {\n\t\treturn $author$project$Astrid$Query$Dummy;\n\t});", + r#"var $author$project$Astrid$Query$andThen = _Query_andThen;"#, ); // final_script.replace("var $author$project$Astrid$Query$run = ", "JSON.stringify(x)"); diff --git a/src/fixture/query.js b/src/fixture/query.js index 4e30308..9e25d74 100644 --- a/src/fixture/query.js +++ b/src/fixture/query.js @@ -1,8 +1,21 @@ // CORE QUERIES function __Debug_print(object) { - //Deno.core.print(JSON.stringify(object)); - //Deno.core.print("\n"); + Deno.core.print(JSON.stringify(object)); + Deno.core.print("\n"); +} + +function __Debug_print_slots(values) { + var len = values.length; + for (var i = 0; i < len; i++) { + Deno.core.print([" ", i, ": ", JSON.stringify(values[i]), "\n"].join("")); + } +} + +function __Debug_assert(expr) { + if (!expr) { + throw new Error("debug assert"); + } } function _Query_succeed(value) @@ -11,7 +24,7 @@ function _Query_succeed(value) $: 0, a: value }; -} +}; var _Query_fetchOptional = F3(function(sql, args, decoder) @@ -53,14 +66,14 @@ function _Query_mapMany(f, queries) }; } -var _Query_andThen = F2(function(callback, query) -{ - return { - $: 5, - e: query, - h: callback - }; -}); +var _Query_andThen = F2( + function(callback, query) { + return { + $: 5, + e: query, + h: callback + }; + }); var _Query_map1 = F2(function(f, q1) { @@ -194,22 +207,29 @@ function _Query_runDecoder(decoder, sql, xs) var _Query_execute = function(query) { + // queries: Array (Int, Query a) + // values: Array (Maybe a) + // callbacks: Array (Int, Fn: * -> a) var queries = new Array; - var statements = new Array; - var decoders = new Array; var values = new Array; var callbacks = new Array; + var statements = new Array; + var decoders = new Array; - queries.push(query); + queries.push({slot: 0, query: query}); + values.push($elm$core$Maybe$Nothing); while (true) { - var q; - while(q = queries.pop()) { - __Debug_print("query ="); - __Debug_print(q); + var x; + while(x = queries.pop()) { + var slot = x.slot; + var q = x.query; + //__Debug_print({"the result of this query goes in slot": slot}); + //__Debug_print({"query": q ? q : "missing" }); + //__Debug_print_slots(values); switch (q.$) { case 0: - values.push(q.a); + values[slot] = $elm$core$Maybe$Just(q.a); break; case 1: @@ -220,34 +240,33 @@ var _Query_execute = function(query) var bindParameters = _List_toArray(q.c); var decoder = q.d; statements.push([moreThanOneRow, sql, bindParameters]); - decoders.push(decoder); + decoders.push({slot: slot, decoder: decoder}); break; case 4: - __Debug_print("got a map"); - __Debug_print(q) - callbacks.push({ $:'Map', a: q.f }) - // We know that the list of queries is limited to length 8, - // which is much less then browser's stack overflow limits that - // start around 100,000 elements. - Array.prototype.push.apply(queries, q.g); + callbacks.push({ $:'Map', a: q.f, slot: slot }) + // Array.prototype.push.apply(queries, q.g); + var len = q.g.length; + for (var i = 0; i < len; i++) { + queries.push({slot: values.length, query: q.g[i]}) + values.push($elm$core$Maybe$Nothing); + } break; case 5: - callbacks.push({ $:'AndThen', a: q.h }) - queries.push(q.e) + callbacks.push({ $:'AndThen', a: q.h, slot: slot }) + queries.push({slot: values.length, query: q.e}) + values.push($elm$core$Maybe$Nothing); break; } } + __Debug_print("-----------------------"); if (statements.length > 0) { - __Debug_print("statements = "); - __Debug_print(statements); var queryResult = Deno.core.opSync( 'op_starmelon_batch_queries', statements, ); - __Debug_print(queryResult); // I am assuming here that the Rust code is serializing the same // structure that the Elm compiler thinks we have. if (!$elm$core$Result$isOk(queryResult)) { @@ -257,64 +276,69 @@ var _Query_execute = function(query) var len = results.length; for (var i = 0; i < len; i++) { - var result = _Query_runDecoder(decoders[i], statements[i][1], results[i]) + var { decoder, slot } = decoders[i]; + var result = _Query_runDecoder(decoder, statements[i][1], results[i]) if (!$elm$core$Result$isOk(result)) { return result } - values.push(result.a); + values[slot] = $elm$core$Maybe$Just(result.a); } statements.length = 0; decoders.length = 0; } - __Debug_print("processing callbacks stack"); - __Debug_print(callbacks); - __Debug_print("====="); + __Debug_print({"processing callbacks stack": callbacks}); reduce: while(callbacks.length > 0) { var last = callbacks[callbacks.length - 1]; switch (last.$) { case 'Map': - __Debug_print(last); - __Debug_print(values); - var arity = last.a.a; - if (values.length < arity) { + var arity = last.a.a ? last.a.a : 1; + var slot = last.slot; + var len = values.length; + if (len < arity + 1) { // This implies that queries.length > 0 because we must // have a way to generate the missing value(s) to call // this function. break reduce; } + // Check if all the values are ready + var args = new Array; + for(var i = len - arity; i < len; i++) { + if (values[i].$ === 'Nothing') { + break reduce; + } + args.push(values[i].a); + } callbacks.pop(); // Directly call the wrapped Elm function since we know all // the arguments - __Debug_print("ready to call function"); - var fun = last.a.f; - __Debug_print(typeof fun); - var args = values.slice(-arity); - values.length = values.length - args.length; - args.reverse(); - __Debug_print({ args: args, values: values}); - values.push(fun.apply(null, args)); + var fun = last.a.f ? last.a.f : last.a; + values.length = values.length - arity; + values[slot] = $elm$core$Maybe$Just(fun.apply(null, args)); break; case 'AndThen': callbacks.pop(); - var fun = last.a.f; - // I think that if we have an AndThen then we will always have at least one value - queries.push(fun(values.pop())); - break; + var fun = last.a; + var slot = last.slot; + __Debug_assert(values.length > 0); + var maybeValue = values.pop(); + __Debug_assert(maybeValue.$ === 'Just'); + queries.push({slot: slot, query: fun(maybeValue.a)}) } } if (queries.length == 0 && callbacks.length == 0) { - __Debug_print("final result"); - __Debug_print(values); - // values must have one element in it. - return $elm$core$Result$Ok(values.pop()) + __Debug_assert(values.length === 1); + __Debug_assert(values[0].$ === 'Just'); + + return $elm$core$Result$Ok(values.pop().a) } } }; var $author$project$Astrid$Query$execute = _Query_execute; +var $author$project$Astrid$Query$andThen = _Query_andThen;