Skip to content
This repository
Browse code

[fix] compiler, database, mongo: Val/Ref path on database map/set

  • Loading branch information...
commit d84fca71495430a2a622c6b17de5de26da399fbc 1 parent bb536aa
Quentin Bourgerie authored

Showing 1 changed file with 45 additions and 23 deletions. Show diff stats Hide diff stats

  1. 68  opa/pass_MongoAccessGeneration.ml
68  opa/pass_MongoAccessGeneration.ml
@@ -375,17 +375,56 @@ module Generator = struct
375 375
         "Can't generates mongo access because : %s is not yet implemented"
376 376
         s
377 377
 
  378
+  let dbMongoSet_to_dbSet gamma annotmap set dataty imap =
  379
+    let setident = Ident.next "mongoset" in
  380
+    let annotmap, identset =
  381
+      let tyset = OpaMapToIdent.specialized_typ ~ty:[dataty]
  382
+        Api.Types.DbMongoSet.engine gamma in
  383
+      C.ident annotmap setident tyset
  384
+    in
  385
+    let annotmap, iterator =
  386
+      let annotmap, iterator =
  387
+        OpaMapToIdent.typed_val ~label ~ty:[dataty]
  388
+          Api.DbSet.iterator annotmap gamma
  389
+      in
  390
+      imap (C.apply ~ty:dataty gamma annotmap iterator [identset])
  391
+    in
  392
+    let annotmap, genset =
  393
+      let annotmap, identset = C.copy annotmap identset in
  394
+      C.record annotmap [("iter", iterator); ("engine", identset)]
  395
+    in
  396
+    C.letin annotmap [setident, set] genset
  397
+
378 398
   let get_read_map setkind dty uniq annotmap gamma =
379 399
     let aty = QmlAstCons.Type.next_var () in
380 400
     match setkind, uniq with
381 401
     | DbSchema.Map (_kty, _), true ->
382 402
         OpaMapToIdent.typed_val ~label ~ty:[aty; dty] Api.DbSet.map_to_uniq annotmap gamma
383  
-    | DbSchema.Map (_kty, _), false ->
384  
-        OpaMapToIdent.typed_val ~label ~ty:[aty; dty] Api.DbSet.map_to_uniq annotmap gamma
  403
+    | DbSchema.Map (kty, _), false ->
  404
+        let annotmap, to_map =
  405
+          OpaMapToIdent.typed_val ~label ~ty:[aty; dty; dty; kty;]
  406
+            Api.DbSet.to_map annotmap gamma
  407
+        in
  408
+        let annotmap, identity =
  409
+          let idx = Ident.next "x" in
  410
+          let annotmap, x = C.ident annotmap idx dty in
  411
+          C.lambda annotmap [idx, dty] x
  412
+        in
  413
+        let idx = Ident.next "x" in
  414
+        let annotmap, x = C.ident annotmap idx dty in
  415
+        let annotmap, body = C.apply gamma annotmap to_map [x; identity] in
  416
+        let annotmap, body = C.some annotmap gamma body in
  417
+        C.lambda annotmap [idx, aty] body
385 418
     | DbSchema.DbSet _, true ->
386 419
         OpaMapToIdent.typed_val ~label ~ty:[dty] Api.DbSet.set_to_uniq annotmap gamma
387  
-    | DbSchema.DbSet _, false ->
388  
-        OpaMapToIdent.typed_val ~label ~ty:[dty] Api.some annotmap gamma
  420
+    | DbSchema.DbSet dataty, false ->
  421
+        let idset = Ident.next "set" in
  422
+        let tyset = OpaMapToIdent.specialized_typ ~ty:[dataty]
  423
+          Api.Types.DbMongoSet.engine gamma in
  424
+        let annotmap, set = C.ident annotmap idset tyset in
  425
+        let annotmap, set = dbMongoSet_to_dbSet gamma annotmap set dty (fun x -> x) in
  426
+        let annotmap, set = C.some annotmap gamma set in
  427
+        C.lambda annotmap [idset, tyset] set
389 428
 
390 429
   let apply_postmap gamma kind dataty postmap =
391 430
     match postmap with
@@ -785,20 +824,7 @@ module Generator = struct
785 824
               in
786 825
               (match setkind, uniq with
787 826
                | DbSchema.DbSet _, false ->
788  
-                   let setident = Ident.next "mongoset" in
789  
-                   let annotmap, identset =
790  
-                     let tyset = OpaMapToIdent.specialized_typ ~ty:[dataty]
791  
-                       Api.Types.DbMongoSet.engine gamma in
792  
-                     C.ident annotmap setident tyset
793  
-                   in
794  
-                   let annotmap, iterator =
795  
-                     let annotmap, iterator =
796  
-                       OpaMapToIdent.typed_val ~label ~ty:[dataty]
797  
-                         Api.DbSet.iterator annotmap gamma
798  
-                     in
799  
-                     let annotmap, iterator =
800  
-                       C.apply ~ty gamma annotmap iterator [identset]
801  
-                     in
  827
+                   let imap = function (annotmap, iterator) ->
802 828
                      match postmap with
803 829
                      | None -> annotmap, iterator
804 830
                      | Some (map, postty) ->
@@ -807,11 +833,7 @@ module Generator = struct
807 833
                              Api.DbSet.iterator_map annotmap gamma
808 834
                          in C.apply ~ty gamma annotmap imap [map; iterator]
809 835
                    in
810  
-                   let annotmap, genset =
811  
-                     let annotmap, identset = C.copy annotmap identset in
812  
-                     C.record annotmap [("iter", iterator); ("engine", identset)]
813  
-                   in
814  
-                   C.letin annotmap [setident, set] genset
  836
+                   dbMongoSet_to_dbSet gamma annotmap set dataty imap
815 837
                | DbSchema.Map (keyty, _), false ->
816 838
                    let (annotmap, postdot), postty =
817 839
                      match postmap with

0 notes on commit d84fca7

Please sign in to comment.
Something went wrong with that request. Please try again.