Skip to content
This repository
Browse code

[feature] compiler, database, db3: Update db3 generator (selection)

  • Loading branch information...
commit e9e550e1b74b040594894a2b410ee16a176f88f5 1 parent 81eb8ef
Quentin Bourgerie authored April 03, 2012

Showing 1 changed file with 39 additions and 31 deletions. Show diff stats Hide diff stats

  1. 70  libqmlcompil/dbGen/dbGen_private.ml
70  libqmlcompil/dbGen/dbGen_private.ml
@@ -1896,40 +1896,48 @@ module CodeGenerator ( Arg : DbGenByPass.S ) = struct
1896 1896
         H.apply_lambda' make_virt_path [e; read; write]
1897 1897
     | _ -> assert false (* TODO - ... *)
1898 1898
 
1899  
-  let rec get_expr ~context t dbinfo_map gamma (label, path0, kind) =
  1899
+  let rec get_expr ~context t dbinfo_map gamma (label, path0, kind, select) =
1900 1900
     let _ =
1901 1901
       let pos = QmlError.Context.get_pos context in
1902 1902
       H.start_built_pos pos in
1903 1903
     let prefix, db_def, path = Schema_private.database_def_of_path_expr ~context t path0 in
1904 1904
     if db_def.Schema_private.options.DbAst.backend != `db3 then
1905  
-      Q.Path (label, path0, kind)
1906  
-    else
1907  
-    let dbinfo = StringListMap.find prefix dbinfo_map in
1908  
-    let _, node, virtual_ = Schema_private.find_exprpath db_def.Schema_private.schema db_def.Schema_private.virtual_path ~kind path in
1909  
-    let r = match virtual_ with
1910  
-    | `virtualset (_, wty, false, _) ->
1911  
-        make_virtualset_fullpath  ~context db_def.Schema_private.schema dbinfo gamma node path kind wty
1912  
-    | `virtualset (_, wty, true, record) ->
1913  
-        begin match record with
1914  
-        | Some record -> make_virtualset_partialpath
1915  
-            db_def.Schema_private.schema dbinfo gamma node path kind wty record
1916  
-        | None ->
  1905
+      Q.Path (label, path0, kind, select)
  1906
+    else (
  1907
+      (* Selection with db3 is not implemented *)
  1908
+      (match select with
  1909
+       | Db.SStar | Db.SNil -> ()
  1910
+       | _ ->
  1911
+           QmlError.error context
  1912
+             "This kind of selection is not yet implemented by the db3 backend"
  1913
+      );
  1914
+      let dbinfo = StringListMap.find prefix dbinfo_map in
  1915
+      let _, node, virtual_ = Schema_private.find_exprpath db_def.Schema_private.schema db_def.Schema_private.virtual_path ~kind path in
  1916
+      let r = match virtual_ with
  1917
+        | `virtualset (_, wty, false, _) ->
  1918
+            make_virtualset_fullpath  ~context db_def.Schema_private.schema dbinfo gamma node path kind wty
  1919
+        | `virtualset (_, wty, true, record) ->
  1920
+            begin match record with
  1921
+            | Some record -> make_virtualset_partialpath
  1922
+                db_def.Schema_private.schema dbinfo gamma node path kind wty record
  1923
+            | None ->
  1924
+                match kind with
  1925
+                | Db.Ref -> make_ref_path db_def.Schema_private.schema dbinfo gamma node path
  1926
+                | _ -> get_path_expr db_def.Schema_private.schema dbinfo gamma node path kind
  1927
+            end
  1928
+        | `virtualpath (ident, rty, wty) ->
  1929
+            make_virtualpath db_def.Schema_private.schema dbinfo gamma node path kind ident rty wty
  1930
+        | `realpath ->
1917 1931
             match kind with
1918  
-            | Db.Ref -> make_ref_path db_def.Schema_private.schema dbinfo gamma node path
1919  
-            | _ -> get_path_expr db_def.Schema_private.schema dbinfo gamma node path kind
1920  
-        end
1921  
-    | `virtualpath (ident, rty, wty) ->
1922  
-        make_virtualpath db_def.Schema_private.schema dbinfo gamma node path kind ident rty wty
1923  
-    | `realpath ->
1924  
-        match kind with
1925  
-        | Db.Ref ->
1926  
-            make_ref_path db_def.Schema_private.schema dbinfo gamma node path
1927  
-        | Db.Update update ->
1928  
-            let rpath = make_ref_path db_def.Schema_private.schema dbinfo gamma node path in
1929  
-            make_update_path ~context gamma rpath node update
1930  
-        | _ ->
1931  
-            get_path_expr db_def.Schema_private.schema dbinfo gamma node path kind
1932  
-    in H.end_built_pos (); r
  1932
+            | Db.Ref ->
  1933
+                make_ref_path db_def.Schema_private.schema dbinfo gamma node path
  1934
+            | Db.Update update ->
  1935
+                let rpath = make_ref_path db_def.Schema_private.schema dbinfo gamma node path in
  1936
+                make_update_path ~context gamma rpath node update
  1937
+            | _ ->
  1938
+                get_path_expr db_def.Schema_private.schema dbinfo gamma node path kind
  1939
+      in H.end_built_pos (); r
  1940
+    )
1933 1941
 end
1934 1942
 
1935 1943
 module DatabaseAccess ( Arg : DbGenByPass.S ) = struct
@@ -1943,9 +1951,9 @@ module DatabaseAccess ( Arg : DbGenByPass.S ) = struct
1943 1951
     let context = QmlError.Context.expr e in
1944 1952
     let context = Schema_private.HacksForPositions.map context in
1945 1953
     let f tra = function
1946  
-      | Q.Coerce (_, Q.Path (label, p, kind), _)
1947  
-      | Q.Path (label, p, kind) ->
1948  
-          let e = CodeGenerator.get_expr ~context t dbinfo_map gamma (label, p, kind) in
  1954
+      | Q.Coerce (_, Q.Path (label, p, kind, select), _)
  1955
+      | Q.Path (label, p, kind, select) ->
  1956
+          let e = CodeGenerator.get_expr ~context t dbinfo_map gamma (label, p, kind, select) in
1949 1957
           (* needs to be traversed again because db idents may be introduced *)
1950 1958
           tra e
1951 1959
       | Q.Ident (label, id) ->

0 notes on commit e9e550e

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