Permalink
Browse files

[feature] compiler, database: Added typing of id update/select

  • Loading branch information...
1 parent 7b1846c commit ecce968757e54c3a107b5be93f1bc24b1884259c @BourgerieQuentin BourgerieQuentin committed Apr 16, 2012
Showing with 21 additions and 1 deletion.
  1. +1 −1 libqmlcompil/_tags
  2. +14 −0 libqmlcompil/dbGen/schema_private.ml
  3. +6 −0 libqmlcompil/qmlDbGen.ml
View
@@ -21,7 +21,7 @@
<qmlTypesUtils.ml>: with_mlstate_debug
<qmlDependencies.ml> : with_mlstate_debug, use_graph
<qmlTyper.ml> : with_mlstate_debug
-<qmlDbGen.ml> : with_mlstate_debug
+<qmlDbGen.ml> : with_mlstate_debug, use_opacapi
<typer_w.ml> : with_mlstate_debug
<typer_w/w_TypingEnv.ml> : with_mlstate_debug
<typer_w/w_Infer.ml> : with_mlstate_debug
@@ -1172,6 +1172,13 @@ module Preprocess = struct
in
match u with
| Db.UExpr e -> Db.UExpr (coerce e ty)
+ | Db.UId (id, u) ->
+ begin match QmlTypesUtils.Inspect.follow_alias_noopt_private
+ ~until:Opacapi.Types.map gamma ty with
+ | Q.TypeName ([kty; dty], _) -> Db.UId (coerce id kty, update dty u)
+ | _ -> error "with the identifier @{<bright>'%a'}" "@{<bright>'%a'} is not a map"
+ QmlPrint.pp#expr id QmlPrint.pp#ty ty
+ end
| Db.UFlds fields ->
Db.UFlds
(List.map
@@ -1239,6 +1246,13 @@ module Preprocess = struct
) ->
(ty, Db.SSlice (coerce e1 H.tyint, coerce e2 (H.typeoption H.tyint)))
| Db.SSlice _ -> error "" "slice is not available on %a" QmlPrint.pp#ty ty
+ | Db.SId (id, select) ->
+ match QmlTypesUtils.Inspect.follow_alias_noopt_private ~until:Opacapi.Types.map gamma ty with
+ | Q.TypeName ([kty; dty], _) ->
+ let fst, snd = aux dty select in
+ (fst, Db.SId (coerce id kty, snd))
+ | _ -> error "with the identifier @{<bright>'%a'}" "@{<bright>'%a'} is not a map"
+ QmlPrint.pp#expr id QmlPrint.pp#ty ty
in
let tyres, s = aux dataty select in
#<If:DBGEN_DEBUG>
View
@@ -365,6 +365,12 @@ module Utils = struct
let rec type_of_selected gamma ty select =
let res = match select with
| DbAst.SNil | DbAst.SStar | DbAst.SSlice _ -> ty
+ | DbAst.SId (_id, s) ->
+ begin match QmlTypesUtils.Inspect.follow_alias_noopt_private ~until:"ordered_map" gamma ty with
+ | QmlAst.TypeName ([_; dty; _], _) -> type_of_selected gamma dty s
+ | ty2 -> OManager.i_error "Try to select an id on %a %a" QmlPrint.pp#ty ty QmlPrint.pp#ty ty2
+ end
+
| DbAst.SFlds sflds ->
let ty = QmlTypesUtils.Inspect.follow_alias_noopt_private gamma ty in
match ty with

0 comments on commit ecce968

Please sign in to comment.