Permalink
Browse files

[feature] compiler, database, mongo: Added slice code generation

  • Loading branch information...
1 parent 8ffa67a commit 00eb420ab9ba5bfb8df7cc17ce4faaca76e0dc53 @BourgerieQuentin BourgerieQuentin committed Apr 10, 2012
Showing with 24 additions and 3 deletions.
  1. +22 −2 opa/pass_MongoAccessGeneration.ml
  2. +2 −1 opalang/classic_syntax/parser_path.trx
@@ -200,17 +200,37 @@ module Generator = struct
let select_to_expr gamma annotmap select =
let rec aux prev_fld ((annotmap, acc) as aacc) select =
+ let get_name () = BaseFormat.sprintf "%a" QmlAst.Db.pp_field prev_fld in
match select with
| DbAst.SFlds flds ->
List.fold_left
(fun aacc (fld, select) -> aux (prev_fld @ fld) aacc select)
aacc
flds
| DbAst.SNil | DbAst.SStar ->
- let name = BaseFormat.sprintf "%a" QmlAst.Db.pp_field prev_fld in
+ let name = get_name () in
let annotmap, one = C.int annotmap 1 in
add_to_document gamma annotmap name one acc
- | DbAst.SSlice _ -> assert false
+ | DbAst.SSlice (e1, e2) ->
+ let name = get_name () in
+ let tyint = (Q.TypeConst Q.TyInt) in
+ let limitid = Ident.next "limit" in
+ let annotmap, pvar = QmlAstCons.TypedPat.var annotmap limitid tyint in
+ let annotmap, ko_expr =
+ let annotmap, empty = empty_query gamma annotmap in
+ add_to_document gamma annotmap "$slice" e1 empty
+ in
+ let annotmap, ok_expr =
+ let annotmap, empty = empty_query gamma annotmap in
+ let annotmap, limit = C.ident annotmap limitid tyint in
+ let annotmap, sklim = C.list ~ty:tyint (annotmap, gamma) [limit; e1] in
+ add_to_document gamma annotmap "$slice" sklim empty
+ in
+ let annotmap, slice =
+ QmlAstCons.TypedPat.match_option annotmap gamma e2 pvar ok_expr ko_expr
+ in
+ let annotmap, empty = empty_query gamma annotmap in
+ add_to_document gamma annotmap name slice empty
in aux [] (empty_query gamma annotmap) select
let query_add_order gamma annotmap order query =
@@ -155,7 +155,8 @@ select_fields <-
select_list <-
/ lbracket Opa_parser.expr:e rbracket {{ QmlAst.Db.SSlice (e, none (label e)) }}
- / lbracket Opa_parser.expr:e1 Opa_lexer.comma Opa_parser.expr:e2 rbracket {{ QmlAst.Db.SSlice (e1, e2) }}
+ / lbracket Opa_parser.expr:e1 Opa_lexer.comma Opa_parser.expr:e2 rbracket
+ {{ QmlAst.Db.SSlice (e1, some e2) }}
select_star <- "*" {{ QmlAst.Db.SStar }}

0 comments on commit 00eb420

Please sign in to comment.