Skip to content
This repository
tree: 4a8c34e31f
Fetching contributors…

Cannot retrieve contributors at this time

file 1078 lines (1021 sloc) 46.485 kb
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 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 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 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 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078
(*
Copyright © 2011, 2012 MLstate

This file is part of OPA.

OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.

OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.

You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)

(* shorthands *)
module Q = QmlAst
module C = QmlAstCons.TypedExpr

module Api = struct
  let some = Opacapi.some

  module Types = Opacapi.Types

  module Db = Opacapi.DbMongo

  module DbSet = Opacapi.DbSet
end

module DbAst = QmlAst.Db
module DbSchema = QmlDbGen.Schema
module List = BaseList
module Format = BaseFormat

type db_access = {
  engines : Ident.t StringMap.t
}

let label = Annot.nolabel "MongoAccessGeneration"

module Generator = struct

  let ty_is_const gamma ty =
    match QmlTypesUtils.Inspect.follow_alias_noopt_private gamma ty with
    | Q.TypeConst _ -> true
    | _ -> false

  (* With mongo db we don't consider list as a sum *)
  let ty_is_sum gamma ty =
    match ty with
    | Q.TypeName ([_], name) when Q.TypeIdent.to_string name = "list" -> false
    | ty ->
        match QmlTypesUtils.Inspect.follow_alias_noopt_private gamma ty with
        | Q.TypeSum _ -> true
        | _ -> false

  let ty_database = Q.TypeVar (QmlTypeVars.TypeVar.next ())

  let open_database gamma annotmap name host port =
    let annotmap, name = C.string annotmap name in
    let annotmap, host =
      match host with
      | None -> C.none annotmap gamma
      | Some host ->
          let annotmap, host = C.string annotmap host in
          C.some annotmap gamma host
    in
    let annotmap, port =
      match port with
      | None -> C.none annotmap gamma
      | Some port ->
          let annotmap, port = C.int annotmap port in
          C.some annotmap gamma port
    in
    let annotmap, open_ = OpaMapToIdent.typed_val ~label Api.Db.open_ annotmap gamma in
    let annotmap, open_ = C.apply gamma annotmap open_ [name; host; port] in
    (annotmap, open_)

  let node_to_dbexpr _gamma annotmap node =
    C.ident annotmap node.DbSchema.database.DbSchema.ident ty_database

  let opa2doc gamma annotmap expr
      ?(ty=QmlAnnotMap.find_ty (Annot.annot (QmlAst.Label.expr expr)) annotmap)
      ()
      =
    let (annotmap, opa2doc) =
      OpaMapToIdent.typed_val ~label ~ty:[ty] Api.DbSet.opa2doc annotmap gamma
    in
    C.apply gamma annotmap opa2doc [expr]

  let expr_to_field gamma annotmap expr
      ?(ty=QmlAnnotMap.find_ty (Annot.annot (QmlAst.Label.expr expr)) annotmap)
      ()
      =
    let annotmap, expr_to_field =
      OpaMapToIdent.typed_val ~label ~ty:[ty] Opacapi.DbMongo.expr_to_field annotmap gamma
    in
    C.apply gamma annotmap expr_to_field [expr]

  let add_to_document0 gamma annotmap name expr
      ?(ty=QmlAnnotMap.find_ty (Annot.annot (QmlAst.Label.expr expr)) annotmap)
      doc =
    let (annotmap, add_to_document) =
      OpaMapToIdent.typed_val ~label ~ty:[ty] Api.DbSet.add_to_document annotmap gamma
    in
    let (annotmap, opaty) =
      Pass_ExplicitInstantiation.ty_to_opaty
        ~memoize:false
        ~val_:OpaMapToIdent.val_ ~side:`server
        annotmap gamma ty in
    C.apply gamma annotmap add_to_document [doc; name; expr; opaty]

  let add_to_document gamma annotmap name expr ?ty doc =
    let (annotmap, name) = C.string annotmap name in
    add_to_document0 gamma annotmap name expr ?ty doc

  let expr_of_strpath gamma annotmap strpath =
    let annotmap, path = List.fold_left
      (fun (annotmap, acc) key ->
         let annotmap, e = C.string annotmap key in
         annotmap, e::acc
      ) (annotmap, []) strpath
    in
    C.rev_list (annotmap, gamma) path

  let expr_of_strexprpath gamma annotmap path =
    let path = match path with [] -> [`string "value"] | _ -> path in
    let fld_to_string annotmap fld =
      C.string annotmap (BaseFormat.sprintf "%a" QmlAst.Db.pp_field fld)
    in
    let rec aux annotmap prev_str prev_expr = function
      | (`string s)::q -> aux annotmap (s::prev_str) prev_expr q
      | (`expr e1)::q ->
          let annotmap, prev_expr =
            if prev_str = [] then annotmap, prev_expr
            else
              let annotmap, e = fld_to_string annotmap prev_str in
              let annotmap, d = C.string annotmap "." in
              annotmap, d::e::prev_expr
          in
          let annotmap, e1 = expr_to_field gamma annotmap e1 () in
          let annotmap, d1 = C.string annotmap "." in
          if q = [] then
            let annotmap, value = C.string annotmap "value" in
            annotmap, value::d1::e1::prev_expr
          else
            aux annotmap [] (d1::e1::prev_expr) q
      | [] ->
          if prev_str = [] then
            annotmap, prev_expr
          else
            let annotmap, e = fld_to_string annotmap prev_str in
            if prev_expr = [] then annotmap, (e::prev_expr)
            else
              let annotmap, d0 = C.string annotmap "." in
              annotmap, (e::d0::prev_expr)

    in match aux annotmap [] [] path with
    | annotmap, [u] -> annotmap, u
    | annotmap, lst ->
        let annotmap, lst = C.list (annotmap, gamma) lst in
        let annotmap, flatten =
          OpaMapToIdent.typed_val ~label Opacapi.String.flatten annotmap gamma
        in C.apply gamma annotmap flatten [lst]

  let rec prepare_query query =
    match query with
    | DbAst.QEq _
    | DbAst.QGt _
    | DbAst.QLt _
    | DbAst.QGte _
    | DbAst.QLte _
    | DbAst.QNe _
    | DbAst.QMod _
    | DbAst.QIn _ -> query
    | DbAst.QFlds flds -> DbAst.QFlds (List.map (fun (f, q) -> (f, prepare_query q)) flds)
    | DbAst.QAnd (q1, q2) -> DbAst.QAnd (prepare_query q1, prepare_query q2)
    | DbAst.QOr (q1, q2) -> DbAst.QOr (prepare_query q1, prepare_query q2)
    | DbAst.QNot DbAst.QEq e -> DbAst.QNe e
    | DbAst.QNot DbAst.QGt e -> DbAst.QLte e
    | DbAst.QNot DbAst.QLt e -> DbAst.QGte e
    | DbAst.QNot DbAst.QGte e -> DbAst.QLt e
    | DbAst.QNot DbAst.QLte e -> DbAst.QGt e
    | DbAst.QNot DbAst.QNe e -> DbAst.QEq e
    | DbAst.QNot (DbAst.QIn _ | DbAst.QMod _) -> query
    | DbAst.QNot (DbAst.QNot query) -> query
    | DbAst.QNot (DbAst.QFlds flds) ->
        DbAst.QFlds (List.map (fun (f, q) -> (f, prepare_query (DbAst.QNot q))) flds)
    | DbAst.QNot (DbAst.QOr (q1, q2)) ->
        DbAst.QAnd (prepare_query (DbAst.QNot q1), prepare_query (DbAst.QNot q2))
    | DbAst.QNot (DbAst.QAnd (q1, q2)) ->
        DbAst.QOr (prepare_query (DbAst.QNot q1), prepare_query (DbAst.QNot q2))

  let empty_query gamma annotmap = C.list (annotmap, gamma) []

  let query_to_expr gamma annotmap query =
    match query with
    | None -> empty_query gamma annotmap
    | Some (_todo, query) ->
        let query = prepare_query query in
        let rec aux annotmap query =
          match query with
          | DbAst.QEq e ->
              let (annotmap, e) = C.shallow_copy annotmap e in
              opa2doc gamma annotmap e ()
          | DbAst.QMod _ -> assert false
          | DbAst.QGt e | DbAst.QLt e | DbAst.QGte e | DbAst.QLte e | DbAst.QNe e | DbAst.QIn e ->
              let name =
                match query with
                | DbAst.QGt _ -> "$gt"
                | DbAst.QLt _ -> "$lt"
                | DbAst.QGte _ -> "$gte"
                | DbAst.QLte _ -> "$lte"
                | DbAst.QNe _ -> "$ne"
                | DbAst.QIn _ -> "$in"
                | _ -> assert false
              in
              let annotmap, query = empty_query gamma annotmap in
              add_to_document gamma annotmap name e query
          | DbAst.QFlds flds ->
              List.fold_left
                (fun (annotmap, acc) (fld, query) ->
                   let name = BaseFormat.sprintf "%a" QmlAst.Db.pp_field fld in
                   match query with
                   | DbAst.QEq e -> add_to_document gamma annotmap name e acc
                   | _ ->
                       let annotmap, query = aux annotmap query in
                       add_to_document gamma annotmap name query acc
                )
                (empty_query gamma annotmap)
                flds
          | DbAst.QNot query ->
              let annotmap, query = aux annotmap query in
              let annotmap, empty = empty_query gamma annotmap in
              add_to_document gamma annotmap "$not" query empty
          | DbAst.QAnd (q1, q2)
          | DbAst.QOr (q1, q2) ->
              let name =
                match query with
                | DbAst.QAnd _ -> "$and"
                | DbAst.QOr _ -> "$or"
                | _ -> assert false
              in
              let annotmap, q1 = aux annotmap q1 in
              let annotmap, q2 = aux annotmap q2 in
              let ty =
                QmlAnnotMap.find_ty (Annot.annot (QmlAst.Label.expr q1)) annotmap
              in
              let annotmap, query = C.list ~ty (annotmap, gamma) [q1; q2] in
              let annotmap, empty = empty_query gamma annotmap in
              add_to_document gamma annotmap name query empty
        in aux annotmap query

  let select_to_expr gamma annotmap select =
    let rec aux prev_fld ((annotmap, acc) as aacc) select =
      let get_name annotmap = expr_of_strexprpath gamma annotmap prev_fld in
      match select with
      | DbAst.SFlds flds ->
          List.fold_left
            (fun aacc (fld, select) ->
               aux (List.rev_map_append (fun s -> `string s) fld prev_fld) aacc select)
            aacc flds
      | DbAst.SId (id, s) -> aux ((`expr id)::prev_fld) aacc s
      | DbAst.SNil | DbAst.SStar ->
          let annotmap, name = get_name annotmap in
          let annotmap, one = C.int annotmap 1 in
          add_to_document0 gamma annotmap name one acc
      | DbAst.SSlice (e1, e2) ->
          let annotmap, name = get_name annotmap 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_document0 gamma annotmap name slice empty
    in aux [] (empty_query gamma annotmap) select

  let query_add_order gamma annotmap order query =
    match order with
    | None -> annotmap, query
    | Some order ->
        let annotmap, eorder =
          List.fold_left
            (fun (annotmap, acc) (fld, expr) ->
               let name = BaseFormat.sprintf "%a" QmlAst.Db.pp_field fld in
               let annotmap, expr =
                 let annotmap, up = C.int annotmap 1 in
                 let annotmap, pup =
                   let annotmap, any = QmlAstCons.TypedPat.any annotmap in
                   QmlAstCons.TypedPat.record annotmap ["up", any] in
                 let annotmap, down = C.int annotmap (-1) in
                 let annotmap, pdown =
                   let annotmap, any = QmlAstCons.TypedPat.any annotmap in
                 QmlAstCons.TypedPat.record annotmap ["down", any] in
                 C.match_ annotmap expr [(pup, up); (pdown, down)]
               in add_to_document gamma annotmap name expr acc)
            (empty_query gamma annotmap) order
        in
        let annotmap, metaquery = empty_query gamma annotmap in
        let annotmap, metaquery = add_to_document gamma annotmap "$query" query metaquery in
        add_to_document gamma annotmap "$orderby" eorder metaquery

  let update_to_expr ?(set=true) gamma annotmap = function
    | DbAst.UExpr e ->
        let annotmap, uexpr = opa2doc gamma annotmap e () in
        if set then
          let annotmap, empty = C.list (annotmap, gamma) [] in
          add_to_document gamma annotmap "$set" uexpr empty
        else annotmap, uexpr
    | update ->
        let addset = set in
        let rec collect rfld (inc, set, other, annotmap) update =
          match update with
          | DbAst.UId (e, u) -> collect (`expr e::rfld) (inc, set, other, annotmap) u
          | DbAst.UFlds fields ->
              List.fold_left
                (fun (inc, set, other, annotmap) (f, u) ->
                   let fld = List.rev_map_append (fun s -> `string s) f rfld in
                   collect fld (inc, set, other, annotmap) u)
                (inc, set, other, annotmap) fields
          | DbAst.UExpr e -> (inc, (rfld, e)::set, other, annotmap)
          | DbAst.UIncr i -> ((rfld, i)::inc, set, other, annotmap)
          | DbAst.UAppend e -> (inc, set, (rfld, "$push", e)::other, annotmap)
          | DbAst.UAppendAll e -> (inc, set, (rfld, "$pushAll", e)::other, annotmap)
          | DbAst.URemove e -> (inc, set, (rfld, "$pull", e)::other, annotmap)
          | DbAst.URemoveAll e -> (inc, set, (rfld, "$pullAll", e)::other, annotmap)
          | DbAst.UPop ->
              let annotmap, e = C.int annotmap (-1) in
              (inc, set, (rfld, "$pop", e)::other, annotmap)
          | DbAst.UShift ->
              let annotmap, e = C.int annotmap 1 in
              (inc, set, (rfld, "$pop", e)::other, annotmap)
        in let (inc, set, other, annotmap) = collect [] ([], [], [], annotmap) update in
        let annotmap, uexpr = C.list (annotmap, gamma) [] in
        let annotmap, uexpr =
          match inc with
          | [] -> annotmap, uexpr
          | _ ->
              let ty = Q.TypeConst Q.TyInt in
              let rec aux ((annotmap, doc) as acc) inc =
                match inc with
                | [] -> acc
                | (field, value)::q ->
                    let annotmap, value = C.int annotmap value in
                    let annotmap, field = expr_of_strexprpath gamma annotmap field in
                    aux (add_to_document0 gamma annotmap field value ~ty doc) q
              in
              let annotmap, iexpr = aux (C.list (annotmap, gamma) []) inc in
              add_to_document gamma annotmap "$inc" iexpr uexpr
        in
        let annotmap, uexpr =
          match set with
          | [] -> annotmap, uexpr
          | _ ->
              let rec aux ((annotmap, doc) as acc) set =
                match set with
                | [] -> acc
                | (field, value)::q ->
                    (*Special case for _id fields we can't modify.
Mongo restriction : TODO ?*)
                    match field with
                    | [`string "_id"] -> aux acc q
                    | _ ->
                        let annotmap, field = expr_of_strexprpath gamma annotmap field in
                        aux (add_to_document0 gamma annotmap field value doc) q
              in
              if addset then (
                let annotmap, sexpr = aux (C.list (annotmap, gamma) []) set in
                add_to_document gamma annotmap "$set" sexpr uexpr
              ) else (
                aux (C.list (annotmap, gamma) []) set
              )
        in
        let annotmap, uexpr =
          List.fold_left
            (fun (annotmap, uexpr) (fld, name, request) ->
               let annotmap, empty = C.list (annotmap, gamma) [] in
               let annotmap, fld = expr_of_strexprpath gamma annotmap fld in
               let annotmap, request = add_to_document0 gamma annotmap fld request empty in
               add_to_document gamma annotmap name request uexpr
            ) (annotmap, uexpr) other
        in annotmap, uexpr

  let dot_update gamma annotmap field update =
    match update with
    | DbAst.UExpr e ->
        let annotmap, e = C.dot gamma annotmap e field in
        Some (annotmap, DbAst.UExpr e)
    | DbAst.UFlds fields ->
        List.find_map
          (fun (fields, u) -> match fields with
           | t::q when t = field -> Some (annotmap, DbAst.UFlds [q, u])
           | _ -> None)
          fields
    | _ -> None

  let dot_select field update =
    match update with
    | DbAst.SFlds fields ->
        List.find_map
          (fun (fields, u) -> match fields with
           | [t] when t = field ->
               Some (if u = DbAst.SNil then DbAst.SStar else u)
           | [_t] -> None
           | _t::_q -> assert false
           | _ -> None)
          fields
    | DbAst.SNil -> Some DbAst.SNil
    | DbAst.SStar -> Some DbAst.SStar
    | _ -> None

  let get_node ~context schema path =
    try
      DbSchema.get_node schema path
    with Base.NotImplemented s ->
      QmlError.error context
        "Can't generates mongo access because : %s is not yet implemented"
        s

  let dbMongoSet_to_dbSet gamma annotmap set dataty imap =
    let setident = Ident.next "mongoset" in
    let annotmap, identset =
      let tyset = OpaMapToIdent.specialized_typ ~ty:[dataty]
        Api.Types.DbMongoSet.engine gamma in
      C.ident annotmap setident tyset
    in
    let annotmap, iterator =
      let annotmap, iterator =
        OpaMapToIdent.typed_val ~label ~ty:[dataty]
          Api.DbSet.iterator annotmap gamma
      in
      imap (C.apply ~ty:dataty gamma annotmap iterator [identset])
    in
    let annotmap, genset =
      let annotmap, identset = C.copy annotmap identset in
      C.record annotmap [("iter", iterator); ("engine", identset)]
    in
    C.letin annotmap [setident, set] genset

  let get_read_map setkind dty uniq annotmap gamma =
    let aty = QmlAstCons.Type.next_var () in
    match setkind, uniq with
    | DbSchema.Map (_kty, _), true ->
        OpaMapToIdent.typed_val ~label ~ty:[aty; dty] Api.DbSet.map_to_uniq annotmap gamma
    | DbSchema.Map (kty, _), false ->
        let annotmap, to_map =
          OpaMapToIdent.typed_val ~label ~ty:[aty; dty; dty; kty;]
            Api.DbSet.to_map annotmap gamma
        in
        let annotmap, identity =
          let idx = Ident.next "x" in
          let annotmap, x = C.ident annotmap idx dty in
          C.lambda annotmap [idx, dty] x
        in
        let idx = Ident.next "x" in
        let annotmap, x = C.ident annotmap idx dty in
        let annotmap, body = C.apply gamma annotmap to_map [x; identity] in
        let annotmap, body = C.some annotmap gamma body in
        C.lambda annotmap [idx, aty] body
    | DbSchema.DbSet _, true ->
        OpaMapToIdent.typed_val ~label ~ty:[dty] Api.DbSet.set_to_uniq annotmap gamma
    | DbSchema.DbSet dataty, false ->
        let idset = Ident.next "set" in
        let tyset = OpaMapToIdent.specialized_typ ~ty:[dataty]
          Api.Types.DbMongoSet.engine gamma in
        let annotmap, set = C.ident annotmap idset tyset in
        let annotmap, set = dbMongoSet_to_dbSet gamma annotmap set dty (fun x -> x) in
        let annotmap, set = C.some annotmap gamma set in
        C.lambda annotmap [idset, tyset] set

  let apply_postmap gamma kind dataty postmap =
    match postmap with
    | None -> (fun x -> x)
    | Some (map, postty) ->
        match kind with
        | DbAst.Default ->
            (fun (annotmap, expr) -> C.apply ~ty:postty gamma annotmap map [expr])
        | DbAst.Option ->
            (fun (annotmap, expr) ->
               let id = Ident.next "data" in
               let annotmap, pvar = QmlAstCons.TypedPat.var annotmap id postty in
               let annotmap, ko_expr = C.none annotmap gamma in
               let annotmap, ok_expr =
                 let annotmap, eid = C.ident annotmap id dataty in
                 let annotmap, result = C.apply ~ty:postty gamma annotmap map [eid] in
                 C.some annotmap gamma result
               in
               QmlAstCons.TypedPat.match_option annotmap gamma expr pvar ok_expr ko_expr
            )
        | _ -> assert false

  let rec compose_path ~context gamma annotmap schema dbname kind subs select =
    let subkind =
      match kind with
      | DbAst.Update _
      | DbAst.Ref -> DbAst.Ref
      | _ -> DbAst.Valpath
    in
    let subs =
      List.filter_map
        (function (field, sub) ->
           match dot_select field select with
           | Some select -> Some (field, select, sub)
           | None -> None
        ) subs
    in
    let annotmap, elements =
      C.list_map
        (fun annotmap (field, select, sub) ->
           let (annotmap, path) =
             string_path ~context gamma annotmap schema (subkind, dbname::sub) select
           in
           let (annotmap, field) = C.string annotmap field in
           C.opa_tuple_2 (annotmap, gamma) (field, path)
        ) (annotmap, gamma) subs
    in
    let builder, pathty =
      match subkind with
      | DbAst.Ref -> Api.Db.build_rpath_compose, Api.Types.DbMongo.ref_path
      | DbAst.Valpath -> Api.Db.build_vpath_compose, Api.Types.DbMongo.val_path
      | _ -> assert false
    in
    (annotmap, [elements], builder, pathty)

  and string_path ~context gamma annotmap schema (kind, strpath) select =
    let node =
      let strpath = List.map (fun k -> DbAst.FldKey k) strpath in
      get_node ~context schema strpath in
    match node.DbSchema.kind with
    | DbSchema.SetAccess (setkind, path, query, _todo) ->
        dbset_path ~context gamma annotmap (kind, path) setkind node query None select
    | _ ->
        let dataty = node.DbSchema.ty in
        let dbname = node.DbSchema.database.DbSchema.name in
        match kind with
        | DbAst.Update (u, o) ->
            begin match node.DbSchema.kind with
            | DbSchema.Plain ->
                let annotmap, path = expr_of_strpath gamma annotmap strpath in
                let annotmap, uexpr =
                  if ty_is_sum gamma dataty then (
                    let annotmap, uexpr = update_to_expr ~set:false gamma annotmap u in
                    (* Special case for upsert without '$' modifier, needs
_id to the update query. *)
                    let _id =
                      (Format.sprintf "/%a"
                         (Format.pp_list "/" Format.pp_print_string) strpath)
                    in
                    let annotmap, _id = C.string annotmap _id in
                    add_to_document gamma annotmap "_id" _id uexpr
                  ) else (
                    update_to_expr gamma annotmap u
                  )
                in
                let annotmap, database = node_to_dbexpr gamma annotmap node in
                let annotmap, update =
                  OpaMapToIdent.typed_val ~label Api.Db.update_path annotmap gamma in
                C.apply gamma annotmap update [database; path; uexpr]
            | DbSchema.Partial (sum, rpath, partial) ->
                if sum then QmlError.serror context "Update inside a sum path is forbidden";
                let annotmap, path = expr_of_strpath gamma annotmap (dbname::rpath) in
                let annotmap, uexpr = update_to_expr gamma annotmap (DbAst.UFlds [partial, u]) in
                let annotmap, database = node_to_dbexpr gamma annotmap node in
                let annotmap, update =
                  OpaMapToIdent.typed_val ~label Api.Db.update_path annotmap gamma in
                C.apply gamma annotmap update [database; path; uexpr]
            | DbSchema.Compose c ->
                (* TODO - Warning non atocmic update ??*)
                let annotmap, sub =
                  List.fold_left_filter_map
                    (fun annotmap (field, subpath) ->
                       match dot_update gamma annotmap field u with
                       | Some (annotmap, subu) ->
                           begin match dot_select field select with
                           | Some select ->
                               let annotmap, sube =
                                 string_path ~context gamma annotmap schema
                                   (DbAst.Update (subu, o), dbname::subpath)
                                   select
                               in (annotmap, Some (Ident.next "_", sube))
                           | None -> annotmap, None
                           end
                       | None -> annotmap, None
                    ) annotmap c
                in
                let annotmap, unit = C.unit annotmap in
                C.letin annotmap sub unit
            | _ -> assert false
            end
        | _ ->
            (* All other kind access are factorized bellow *)
            let annotmap, path = expr_of_strpath gamma annotmap strpath in
            let (annotmap, args, builder, pathty) =
              match node.DbSchema.kind with
              | DbSchema.Compose subs ->
                  compose_path ~context gamma annotmap schema dbname kind subs select

              | DbSchema.Partial (sum, rpath, partial) ->
                  let annotmap, partial = C.list_map
                    (fun annotmap fragment -> C.string annotmap fragment)
                    (annotmap, gamma) partial
                  in let annotmap, rpath = C.list_map
                    (fun annotmap fragment -> C.string annotmap fragment)
                    (annotmap, gamma) (dbname::rpath)
                  in begin match kind with
                  | DbAst.Ref ->
                      if sum then QmlError.serror context "Update inside a sum path is forbidden";
                      annotmap, [rpath; partial], Api.Db.build_rpath_sub, Api.Types.DbMongo.ref_path
                  | _ ->
                      annotmap, [rpath; partial], Api.Db.build_vpath_sub, Api.Types.DbMongo.val_path
                  end
              | DbSchema.Plain ->
                  let annotmap, const = C.bool (annotmap, gamma) (ty_is_const gamma dataty) in
                  (match kind with
                   | DbAst.Update _
                   | DbAst.Ref -> (annotmap, [const], Api.Db.build_rpath, Api.Types.DbMongo.ref_path)
                   | _ -> (annotmap, [const], Api.Db.build_vpath, Api.Types.DbMongo.val_path))
              | _ -> assert false
            in
            let (annotmap, build) =
              OpaMapToIdent.typed_val ~label ~ty:[dataty] builder annotmap gamma in
            let (annotmap, database) = node_to_dbexpr gamma annotmap node in
            let ty = OpaMapToIdent.specialized_typ ~ty:[dataty] pathty gamma in
            let (annotmap, default) = node.DbSchema.default ~select annotmap in
            let (annotmap, path) = C.apply ~ty gamma annotmap build
              ([database; path; default] @ args) in
            let again =
              match kind with
              | DbAst.Default -> Some Api.Db.read
              | DbAst.Option -> Some Api.Db.option
              | _ -> None
            in
            let (annotmap, path) =
              match again with
              | None -> (annotmap, path)
              | Some again ->
                  let (annotmap, again) =
                    OpaMapToIdent.typed_val ~label ~ty:[QmlAstCons.Type.next_var (); dataty]
                      again annotmap gamma in
                  C.apply gamma annotmap again [path]
            in annotmap, path

  and dbset_path ~context gamma annotmap (kind, path) setkind node query0 embed select0 =
    let ty = node.DbSchema.ty in
    let annotmap, skip, limit, query, order, uniq =
      match query0 with
      | None ->
          let annotmap, limit = C.int annotmap 0 in
          let annotmap, skip = C.int annotmap 0 in
          annotmap, skip, limit, None, None, false
      | Some ((uniq, (query, opt)) as _x) ->
          let annotmap, limit =
            match opt.DbAst.limit with
            | None -> C.int annotmap 0
            | Some i -> annotmap, i
          in let annotmap, skip =
            match opt.DbAst.skip with
            | None -> C.int annotmap 0
            | Some i -> annotmap, i
          in let query = Some (
            match setkind with
            | DbSchema.Map _ ->
                let rec insert_id query = match query with
                  | DbAst.QEq _
                  | DbAst.QGt _
                  | DbAst.QLt _
                  | DbAst.QGte _
                  | DbAst.QLte _
                  | DbAst.QNe _
                  | DbAst.QMod _
                  | DbAst.QIn _ -> DbAst.QFlds [(["_id"], query)]
                  | DbAst.QFlds flds -> DbAst.QFlds (List.map (fun (flds, q) -> ("_id"::flds, q)) flds)
                  | DbAst.QNot q -> DbAst.QNot (insert_id q)
                  | DbAst.QAnd (q1, q2) -> DbAst.QAnd (insert_id q1, insert_id q2)
                  | DbAst.QOr (q1, q2) -> DbAst.QOr (insert_id q1, insert_id q2)
                in
                uniq, insert_id query
            | _ -> uniq, query
          )
          in
          annotmap, skip, limit, query, opt.DbAst.sort, uniq
    in
    match query0, kind with
    | None, DbAst.Update (DbAst.UExpr e, _options) (* TODO : options *) ->
        (* Just reuse ref path on collections if 0 query *)
        let annotmap, refpath =
          dbset_path ~context gamma annotmap (DbAst.Ref, path) setkind node query0 embed select0 in
        let annotmap, more = C.dot gamma annotmap refpath "more" in
        let annotmap, write = C.dot gamma annotmap more "write" in
        let annotmap, apply = C.apply gamma annotmap write [e] in
        let annotmap, ignore =
          let i = Ident.next "_ignore" in
          let annotmap, v = C.cheap_void annotmap gamma in
          C.letin annotmap [(i, apply)] v
        in annotmap, ignore

    | _ ->
        (* Preprocessing of the embedded path, for select only useful data. *)
        let select0, postdot =
          let dot str ty =
            match QmlTypesUtils.Inspect.follow_alias_noopt_private gamma ty with
            | Q.TypeRecord ((Q.TyRow (row, _)) as tyrow) ->
                begin try List.assoc str row
                with Not_found -> OManager.i_error "Selection : %s not found in %a"
                  str QmlPrint.pp#tyrow tyrow
                end
            | ty -> OManager.i_error "Selection : %s not found in non record : %a"
                str QmlPrint.pp#ty ty
          in
          match embed with
          | None -> select0, None
          | Some embed ->
              let select0, postdot =
                List.fold_right
                  (fun fragment (select, post) ->
                     match fragment with
                     | DbAst.FldKey str ->
                         DbAst.SFlds [[str], select],
                         (fun ((annotmap, expr), ty) ->
                            let ty = dot str ty in
                            let ae = C.dot gamma annotmap expr str in
                            post (ae, ty)
                         )
                     | DbAst.ExprKey uexpr
                     | DbAst.Query (DbAst.QEq uexpr , _)->
                         DbAst.SId (uexpr, select),
                         (fun ((annotmap, expr), dty) ->

                                post ((annotmap, expr), dty)

                            )
                     | DbAst.NewKey _
                     | DbAst.Query _ ->
                         QmlError.error context
                           "This kind of sub selection is not yet implemented by mongo generator")
                  embed
                  (select0, (fun x -> x))
              in select0, Some postdot
        in
        (* Type of the data after selection *)
        let dataty =
          let ty =
            match setkind with
            | DbSchema.DbSet ty -> ty
            | DbSchema.Map (_, ty) -> ty
          in QmlDbGen.Utils.type_of_selected gamma ty select0
        in
        (* DbSet.build *)
        let (annotmap, build, query, args) =
          match kind with
          | DbAst.Default
          | DbAst.Valpath
          | DbAst.Ref
          | DbAst.Option ->
              (* query *)
              let annotmap, query = query_to_expr gamma annotmap query in
              let annotmap, query = query_add_order gamma annotmap order query in
              let annotmap, default = node.DbSchema.default ~select:select0 annotmap in
              let annotmap, select =
                match select0 with
                | DbAst.SNil | DbAst.SStar -> C.none annotmap gamma
                | select ->
                    let annotmap, select = select_to_expr gamma annotmap select in
                    C.some annotmap gamma select
              in
              begin match kind with
              | DbAst.Default | DbAst.Option ->
                  let annotmap, build =
                    OpaMapToIdent.typed_val ~label ~ty:[dataty] Api.DbSet.build annotmap gamma in
                  (annotmap, build, query, [default; skip; limit; select])
              | DbAst.Valpath ->
                  let annotmap, build =
                    OpaMapToIdent.typed_val ~label ~ty:[QmlAstCons.Type.next_var (); dataty]
                      Api.DbSet.build_vpath annotmap gamma
                  in
                  let annotmap, read_map = get_read_map setkind dataty uniq annotmap gamma in
                  (annotmap, build, query, [default; skip; limit; select; read_map])
              | DbAst.Ref ->
                  let annotmap, read_map = get_read_map setkind dataty uniq annotmap gamma in
                  let build_rpath, (annotmap, write_map) =
                    match setkind, uniq with
                    | DbSchema.DbSet _, true ->
                        let iarg = Ident.next "data" in
                        let annotmap, earg = C.ident annotmap iarg dataty in
                        let annotmap, doc = opa2doc ~ty:dataty gamma annotmap earg () in
                        Api.DbSet.build_rpath, C.lambda annotmap [(iarg, dataty)] doc
                    | DbSchema.Map (_kty, _dty), true ->
                        let iarg = Ident.next "data" in
                        let annotmap, earg = C.ident annotmap iarg dataty in
                        let annotmap, doc = opa2doc ~ty:dataty gamma annotmap earg () in
                        Api.DbSet.build_rpath, C.lambda annotmap [(iarg, dataty)] doc
                    | DbSchema.DbSet _, false ->
                        QmlError.warning ~wclass:WarningClass.dbgen_mongo
                          context "Reference path on database set is not advised";
                        Api.DbSet.build_rpath_collection,
                        OpaMapToIdent.typed_val ~label ~ty:[dataty]
                          Api.DbSet.set_to_docs annotmap gamma

                    | DbSchema.Map (kty, _), false ->
                        QmlError.warning ~wclass:WarningClass.dbgen_mongo
                          context "Reference path on database map is not advised";
                        Api.DbSet.build_rpath_collection,
                        OpaMapToIdent.typed_val ~label ~ty:[kty; dataty]
                          Api.DbSet.map_to_docs annotmap gamma
                  in
                  let annotmap, build =
                    OpaMapToIdent.typed_val ~label ~ty:[dataty; dataty] build_rpath annotmap gamma
                  in
                  (annotmap, build, query, [default; skip; limit; select; read_map; write_map])
              | _ -> assert false
              end

          | DbAst.Update (u, o) ->
              let (annotmap, query) = query_to_expr gamma annotmap query in
              let (annotmap, update) =
                let u = Option.default_map u
                  (function embed ->
                     List.fold_right
                       (fun fragment update -> match fragment with
                        | DbAst.FldKey str -> DbAst.UFlds [[str], update]
                        | DbAst.Query ((DbAst.QEq uexpr), _)
                        | DbAst.ExprKey uexpr -> DbAst.UId (uexpr, update)
                        | _ -> QmlError.error context
                            "This kind of update access is not supported by mongo dbgen driver"
                       ) embed u
                  ) embed
                in
                let u =
                  (* Hack : When map value is simple, adding the "value" field *)
                  match setkind with
                  | DbSchema.Map (_, tyval) when ty_is_const gamma tyval -> DbAst.UFlds [["value"], u]
                  | _ -> u
                in
                update_to_expr gamma annotmap u
              in
              let annotmap, upsert =
                if o.DbAst.ifexists then C._false (annotmap, gamma)
                else C._true (annotmap, gamma)
              in
              let (annotmap, build) =
                OpaMapToIdent.typed_val ~label Api.DbSet.update annotmap gamma
              in
              (annotmap, build, query, [update; upsert])
        in
        (* database *)
        let (annotmap, database) = node_to_dbexpr gamma annotmap node in
        (* path : list(string) *)
        let (annotmap, path) =
          let (annotmap, path) = List.fold_left
            (fun (annotmap, acc) key ->
               let annotmap, e = C.string annotmap key in
               annotmap, e::acc
            ) (annotmap, []) path
          in
          C.rev_list (annotmap, gamma) path in
        (* dbset = DbSet.build(database, path, query, ...) *)
        let (annotmap, set) =
          C.apply gamma annotmap build
            ([database; path; query] @ args) in
        let ty =
          (*FIXME : We should project the resulted ty according to the selection *)
          ty
        in
        (* Final convert *)
        let (annotmap, set) =
          match kind with
          | DbAst.Default | DbAst.Option ->
              let annotmap, postmap =
                match postdot with
                | None -> annotmap, None
                | Some postdot ->
                    let data = Ident.next "data" in
                    let (annotmap, map), postty =
                      postdot ((C.ident annotmap data dataty), dataty)
                    in
                    let annotmap, map = C.lambda annotmap [(data, dataty)] map in
                    annotmap, Some (map, postty)
              in
              (match setkind, uniq with
               | DbSchema.DbSet _, false ->
                   let imap = function (annotmap, iterator) ->
                     match postmap with
                     | None -> annotmap, iterator
                     | Some (map, postty) ->
                         let annotmap, imap =
                           OpaMapToIdent.typed_val ~label ~ty:[dataty; postty]
                             Api.DbSet.iterator_map annotmap gamma
                         in C.apply ~ty gamma annotmap imap [map; iterator]
                   in
                   dbMongoSet_to_dbSet gamma annotmap set dataty imap
               | DbSchema.Map (keyty, _), false ->
                   let (annotmap, postdot), postty =
                     match postmap with
                     | None ->
                         let id = Ident.next "x" in
                         let annotmap, idx = C.ident annotmap id dataty in
                         (C.lambda annotmap [id, dataty] idx), dataty
                     | Some (map, postty) -> (annotmap, map), postty
                   in
                   let annotmap, to_map =
                     OpaMapToIdent.typed_val ~label
                       ~ty:[QmlAstCons.Type.next_var (); dataty; postty; keyty;]
                       Api.DbSet.to_map annotmap gamma in
                   let annotmap, map =
                     C.apply ~ty gamma annotmap to_map [set; postdot] in
                   begin match kind with
                   | DbAst.Option ->
                       (* TODO - Actually we consider map already exists *)
                       C.some annotmap gamma map
                   | _ -> (annotmap, map)
                   end
               | DbSchema.DbSet _, true ->
                   let (annotmap, set_to_uniq) =
                     let set_to_uniq = match kind with
                       | DbAst.Default -> Api.DbSet.set_to_uniq_def
                       | DbAst.Option -> Api.DbSet.set_to_uniq
                       | _ -> assert false
                     in
                     OpaMapToIdent.typed_val ~label ~ty:[dataty] set_to_uniq annotmap gamma in
                   apply_postmap gamma kind dataty postmap
                     (C.apply ~ty gamma annotmap set_to_uniq [set])
               | DbSchema.Map (_keyty, _), true ->
                   let (annotmap, map_to_uniq) =
                     let map_to_uniq = match kind with
                       | DbAst.Default -> Api.DbSet.map_to_uniq_def
                       | DbAst.Option -> Api.DbSet.map_to_uniq
                       | _ -> assert false
                     in
                     OpaMapToIdent.typed_val ~label ~ty:[QmlAstCons.Type.next_var (); dataty]
                       map_to_uniq annotmap gamma in
                   apply_postmap gamma kind dataty postmap
                     (C.apply ~ty gamma annotmap map_to_uniq [set])
              )
          | _ -> (annotmap, set)
        in
        (annotmap, set)


  let path ~context gamma annotmap schema (label, dbpath, kind, select) =
    let node = get_node ~context schema dbpath in
    match node.DbSchema.database.DbSchema.options.DbAst.backend with
    | `mongo -> (
        let annotmap, mongopath =
          match node.DbSchema.kind with
          | DbSchema.SetAccess (setkind, path, query, embed) ->
              dbset_path ~context gamma annotmap (kind, path) setkind node query embed select
          | _ ->
              let strpath = List.map
                (function
                 | DbAst.FldKey k -> k
                 | _ -> assert false
                ) dbpath in
              string_path ~context gamma annotmap schema (kind, strpath) select
        in
        match kind with
        | DbAst.Ref | DbAst.Valpath ->
            let annotmap, p2p =
              OpaMapToIdent.typed_val ~label
                ~ty:[QmlAstCons.Type.next_var (); node.DbSchema.ty]
                Api.Db.path_to_path annotmap gamma in
            C.apply gamma annotmap p2p [mongopath]
        | _ -> annotmap, mongopath
      )
    | `db3 -> annotmap, Q.Path (label, dbpath, kind, select)

  let indexes gamma annotmap _schema node rpath lidx =
    let (annotmap, database) =
      node_to_dbexpr gamma annotmap node in
    let (annotmap, build) =
      OpaMapToIdent.typed_val ~label Api.DbSet.indexes annotmap gamma in
    let (annotmap, path) =
      C.rev_list_map
        (fun annotmap fragment -> C.string annotmap fragment)
        (annotmap, gamma) rpath
    in
    let (annotmap, lidx) =
      List.fold_left_map
        (fun annotmap idx ->
           C.list_map
             (fun annotmap fragment -> C.string annotmap fragment)
             (annotmap, gamma) idx)
        annotmap lidx
    in
    let (annotmap, lidx) = C.list (annotmap, gamma) lidx
    in C.apply gamma annotmap build [database; path; lidx]



end

let init_database gamma annotmap schema =
  List.fold_left
    (fun (annotmap, newvals) database ->
       if database.DbSchema.options.DbAst.backend = `mongo
         && database.DbSchema.package = ObjectFiles.get_current_package_name () then
         let ident = database.DbSchema.ident in
         let name = database.DbSchema.name in
         let (annotmap, open_) = Generator.open_database gamma annotmap name None None in
         (annotmap, (Q.NewVal (label, [ident, open_]))::newvals)
       else (annotmap, newvals)
    )
    (annotmap, []) (DbSchema.get_db_declaration schema)

let clean_code gamma annotmap schema code =
  List.fold_left_filter_map
    (fun annotmap -> function
       | Q.Database _ -> annotmap, None
       | Q.NewDbValue (_label, DbAst.Db_TypeDecl (p, _ty)) ->
           let fake_path =
             match p with
             | DbAst.Decl_fld k::_ -> [DbAst.FldKey k]
             | _ -> []
           in
           begin match p with
           | (DbAst.Decl_fld _)::p ->
               let rec aux rpath p =
                 match p with
                 | (DbAst.Decl_set lidx)::[] ->
                     let (annotmap, init) =
                       let fake_node = DbSchema.get_node schema fake_path in
                       Generator.indexes gamma annotmap schema fake_node rpath lidx
                     in
                     let id = Ident.next "_index_setup" in
                     annotmap, Some (Q.NewVal (label, [id, init]))
                 | (DbAst.Decl_set _lidx)::_ -> assert false
                 | (DbAst.Decl_fld str)::p -> aux (str::rpath) p
                 | [] -> annotmap, None
                 | _ -> assert false
               in aux [] p
           | _ -> annotmap, None
           end
       | Q.NewDbValue _ -> annotmap, None
       | elt -> annotmap, Some elt)
    annotmap code

let process_path gamma annotmap schema code =
  let fmap tra annotmap = function
    | Q.Path (label, path, kind, select) as expr ->
        let context = QmlError.Context.annoted_expr annotmap expr in
        let annotmap, result =
          Generator.path ~context gamma annotmap schema (label, path, kind, select) in
        tra annotmap result
    | e -> tra annotmap e
  in
  QmlAstWalk.CodeExpr.fold_map
    (fun annotmap expr ->
       let annotmap, expr = QmlAstWalk.Expr.traverse_foldmap fmap annotmap expr in
       fmap (fun a e -> a,e) annotmap expr)
    annotmap code


let process_code ~stdlib_gamma gamma annotmap schema code =
  match ObjectFiles.compilation_mode () with
  | `init -> (annotmap, code)
  | _ ->
      let gamma = QmlTypes.Env.unsafe_append stdlib_gamma gamma in
      let (annotmap, code) = clean_code gamma annotmap schema code in
      let (annotmap, code) =
        let (annotmap, vals) = init_database stdlib_gamma annotmap schema in
        (annotmap, vals@code)
      in
      let (annotmap, code) = process_path gamma annotmap schema code in
      (annotmap, code)
Something went wrong with that request. Please try again.