[debug] stdlib: Some debug statements for MongoDB.

MLstate · Mar 20, 2012 · ffdc615 · ffdc615
1 parent a209725
commit ffdc615
Show file tree

Hide file tree

Showing 2 changed files with 23 additions and 4 deletions.
diff --git a/stdlib/apis/mongo/selectupdate.opa b/stdlib/apis/mongo/selectupdate.opa
@@ -271,7 +271,8 @@ MongoSelectUpdate = {{
     | {String=_} -> ({su_either},T.tstring)
     | {Document=d} -> type_of_bson_document(d)
     | {Array=[]} -> ({su_either},T.tempty) // or maybe list('a) or list({})???
-    | {Array=[{name=_; ~value}|_]} -> // comes from an OPA list or intmap so all same type
+    | {Array=[{name=name; ~value}|_]} -> // comes from an OPA list or intmap so all same type
+       //dbg do println("type_of_bson_value: Array({name}) value={value}")
        (sut,ty) = type_of_bson_value(value)
        (sut,T.tlist(ty))
     | {Binary=_} -> ({su_either},T.tbinary)
@@ -301,7 +302,10 @@ MongoSelectUpdate = {{
     else if StringSet.mem(element.name,array_select_names)
     then
       match element.value with
-      | {Array=adoc} -> List.fold(sutymrg,List.map(type_of_bson_value,List.map((e -> e.value),adoc)),(stat,T.tempty))
+      | {Array=adoc} ->
+         tys = List.map(type_of_bson_value,List.map((e -> e.value),adoc))
+         //dbg do println("type_of_bson_element: Array({element.name}) tys={List.list_to_string((_,ty) -> OpaType.to_pretty(ty),tys)}")
+         List.fold(sutymrg,tys,(stat,T.tempty))
       | _ -> ML.fatal("MongoSelectUpdate.type_of_bson_element",
                       "key {element.name} requires an array value, actually {Bson.to_pretty([element])}",-1)
     else
@@ -316,6 +320,7 @@ MongoSelectUpdate = {{
 
   @private
   type_of_bson_document(doc:Bson.document): (Mongo.su_status, OpaType.ty) =
+    //dbg do println("type_of_bson_document: doc={Bson.to_pretty(doc)}")
     List.fold(sutymrg,List.map(type_of_bson_element,doc),({su_either},T.tempty))
 
   @private empty_ty(ty) = ty == T.tempty || T.istvar(ty)

diff --git a/stdlib/apis/mongo/types.opa b/stdlib/apis/mongo/types.opa
@@ -90,6 +90,7 @@ MongoTypeSelect = {{
 
   /** Overlay two types, matching and merging sub-types **/
   tmrgrecs(rec1, rec2) =
+    //dbg do println("tmrgrecs: rec1={OpaType.to_pretty(rec1)} rec2={OpaType.to_pretty(rec2)}")
     if rec1 == rec2 || rec2 == tempty
     then rec1
     else if rec1 == tempty
@@ -101,14 +102,27 @@ MongoTypeSelect = {{
         s2 = FieldSet.From.list(row2)
         i = FieldSet.intersection(s1,s2)
         if FieldSet.is_empty(i)
-        then {TyRecord_row=List.sort_by((r -> r.label),List.flatten([row1,row2]))}
+        then
+          //dbg do println("tmrgrecs: empty intersection")
+          res = {TyRecord_row=List.sort_by((r -> r.label),List.flatten([row1,row2]))}
+          //dbg do println("tmrgrecs: res={OpaType.to_pretty(res)}")
+          res
         else
           ii = FieldSet.fold((f, l ->
                                 match (FieldSet.get(f,s1),FieldSet.get(f,s2)) with
-                                | ({some=f1},{some=f2}) -> [{label=f1.label; ty=tmrgrecs(f1.ty,f2.ty)}|l]
+                                | ({some={~label; ty={TyRecord_row=row1; ...}}},{some={ty={TyRecord_row=row2; ...}; ...}}) ->
+                                   [{~label; ty={TySum_col=[row1, row2]}}]
+                                | ({some=f1},{some=f2}) ->
+                                   [{label=f1.label; ty=tmrgrecs(f1.ty,f2.ty)}|l]
                                 | _ -> @fail/*Can't happen*/),i,[])
           d = FieldSet.To.list(FieldSet.union(diff(s1,s2),diff(s2,s1)))
+          //dbg do println("tmrgrecs: ii={ii}")
+          //dbg do println("tmrgrecs: d={d}")
+          //row1 = List.sort_by((r -> r.label),ii)
+          //row2 = List.sort_by((r -> r.label),d)
+          //res = {TySum_col=[row1, row2]}
           res = {TyRecord_row=List.sort_by((r -> r.label),List.flatten([ii,d]))}
+          //dbg do println("tmrgrecs: res={OpaType.to_pretty(res)}")
           res
       | _ ->
         rec1str = OpaType.to_pretty(rec1)