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.
This commit is contained in:
YetAnotherMinion 2022-01-07 23:57:28 +00:00 committed by nobody
commit 401aec67d0
Signed by: GrocerPublishAgent
GPG key ID: D460CD54A9E3AB86
5 changed files with 271 additions and 85 deletions

View file

@ -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 ->

View file

@ -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

127
src/exec/fixtures/README.md Normal file
View file

@ -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]

View file

@ -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)");

View file

@ -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)
{
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;