Permalink
Browse files

[feature] compiler, typer: Handle selection + use generic traverse on…

… path node
  • Loading branch information...
1 parent e882653 commit 81eb8ef211f4592a324d6038116ab44be5d3735a @BourgerieQuentin BourgerieQuentin committed Apr 3, 2012
Showing with 14 additions and 45 deletions.
  1. +14 −45 libqmlcompil/typer_w/w_Infer.ml
@@ -1,5 +1,5 @@
(*
- Copyright © 2011 MLstate
+ Copyright © 2011, 2012 MLstate
This file is part of OPA.
@@ -908,13 +908,10 @@ let rec infer_expr_type ~bypass_typer typing_env original_expr =
we process the coerced expressions in a regular way. *)
let (expr_ty, expr_annotmap) =
(match expr with
- | QmlAst.Path (_, keys, kind) ->
- (* [TODO] Note that as HMX typechecker, we don't attach
- importance to the [QmlAst.Dd.kind] stored in the 2nd
- [QmlAst.Path] argument. *)
- infer_db_path
- ~bypass_typer typing_env ~surrounding_path_expr: expr keys kind
- | _ -> infer_expr_type ~bypass_typer typing_env expr) in
+ | QmlAst.Path (_, keys, kind, select) ->
+ infer_db_path
+ ~bypass_typer typing_env ~surrounding_path_expr: expr keys kind select
+ | _ -> infer_expr_type ~bypass_typer typing_env expr) in
#<If:TYPER $minlevel 9> (* <---------- DEBUG *)
OManager.printf "Coerce end inferred expr@." ;
#<End> ; (* <---------- END DEBUG *)
@@ -986,7 +983,7 @@ let rec infer_expr_type ~bypass_typer typing_env original_expr =
This will be much more readable. *)
infer_directive_type
~bypass_typer typing_env original_expr variant exprs tys
- | QmlAst.Path (_, _, _) ->
+ | QmlAst.Path (_, _, _, _) ->
(* By invariant, the DbPathCoercion (see pass_DbPathCoercion.ml that
calls pass schema_private.ml) must have instrumented the [QmlAst.Path]
code so that if it didn't plug them in a [QmlAst.Coerce] then it
@@ -1006,47 +1003,19 @@ let rec infer_expr_type ~bypass_typer typing_env original_expr =
(** [surrounding_path_expr] : [QmlAst.Path] surrouding expression, i.e. the
expression containing the keys we are typechecking. This is the
expression node in which the type annotation will be recorded. *)
-and infer_db_path ~bypass_typer typing_env ~surrounding_path_expr keys kind =
+and infer_db_path ~bypass_typer typing_env ~surrounding_path_expr _keys _kind _select =
(* The type of the DB path is not given by the path itself: it is always
coerced afterwards by the surrounding [QmlAst.Coerce]. So we simply return
a type variable and let the regular processing coercing it. *)
let ty = W_CoreTypes.type_variable () in
- (* Typecheck each key and recover the updated annotation map. *)
let annotmap' =
- List.fold_right
- (fun key annotmap_accu ->
- let _rebuild, exprs =
- let open Traverse.Utils in
- QmlAst.Db.sub_path_elt sub_current sub_current key
- in
- List.fold_left
- (fun annotmap_accu e ->
- (* [TODO] check [_e_ty] against something somehow ? *)
- let (_e_ty, e_annotmap) =
- infer_expr_type ~bypass_typer typing_env e in
- QmlAnnotMap.merge annotmap_accu e_annotmap)
- annotmap_accu exprs)
- keys W_AnnotMap.empty_annotmap in
- (* Typecheck update ast and recover the updated annotation map. *)
- let annotmap' = match kind with
- | QmlAst.Db.Default | QmlAst.Db.Option | QmlAst.Db.Valpath | QmlAst.Db.Ref -> annotmap'
- | QmlAst.Db.Update u ->
- let rec aux annotmap_accu = function
- | QmlAst.Db.UPop | QmlAst.Db.UShift
- | QmlAst.Db.UIncr _ -> annotmap_accu
- | QmlAst.Db.UAppend e
- | QmlAst.Db.UPrepend e
- | QmlAst.Db.UAppendAll e
- | QmlAst.Db.UPrependAll e
- | QmlAst.Db.UExpr e ->
- (* [TODO] check [_e_ty] against something somehow ? *)
- let (_e_ty, e_annotmap) =
- infer_expr_type ~bypass_typer typing_env e in
- QmlAnnotMap.merge annotmap_accu e_annotmap
- | QmlAst.Db.UFlds fields ->
- List.fold_left (fun a (_,u) -> aux a u) annotmap_accu fields
- in aux annotmap' u
- in
+ QmlAstWalk.Expr.traverse_fold
+ (fun tra annotmap_accu -> function
+ | QmlAst.Path _ as e -> tra annotmap_accu e
+ | _ as e ->
+ let _e_ty, e_annotmap = infer_expr_type ~bypass_typer typing_env e in
+ QmlAnnotMap.merge annotmap_accu e_annotmap
+ ) W_AnnotMap.empty_annotmap surrounding_path_expr in
perform_infer_expr_type_postlude surrounding_path_expr annotmap' ty

0 comments on commit 81eb8ef

Please sign in to comment.