Permalink
Browse files

[enhance] compiler, database, syntax: tilda syntactic sugar (database…

… update)
  • Loading branch information...
1 parent 3b35aa8 commit 081c98b0b68cc3501e486345bb83f8d09725946e @BourgerieQuentin BourgerieQuentin committed Apr 2, 2012
@@ -980,6 +980,8 @@ record_fields_assign <- assign
record_long_ident <- long_ident
+record_short_ident <- deco_ml_identifier
+
extend_record_element <-
/ long_binding:b {{ `binding b }}
/ tilda:tilda (=deco(long_ident)):lp may_coerce:t not_assign
@@ -991,7 +993,7 @@ extend_record_element <-
record_element <-
/ ident_binding:b {{ `binding b }}
- / tilda:tilda deco_ml_identifier:p may_coerce:t not_assign
+ / tilda:tilda record_short_ident:p may_coerce:t not_assign
{{ let rhs = if tilda then `value (var_to_exprvar p) else `novalue p in
`noassign (undecorate p, rhs, t)
}}
@@ -31,6 +31,7 @@
;rbrace_nosp <- Opa_lexer.rbrace_nosp
;spacing <- Opa_lexer.spacing
;semic <- Opa_lexer.semic
+;tilda <- Opa_parser.tilda
(* path definition, ie for [db pathdef : typ] or [db pathdef = expr] *)
;pathdef_nosp <-slash_nosp ml_identifier_nosp:i
@@ -66,21 +67,31 @@ path_update <-
DBPath (pa, QmlAst.Db.Update (QmlAst.Db.UExpr e))
}}
+
(* ******************************************************************)
(**
{7 Path updating }
*)
update <-
- / lbrace update_fields:u rbrace {{ u }}
+ / update_fields:u {{ u }}
/ Opa_parser.expr:e {{ QmlAst.Db.UExpr e }}
update_field <-
- Opa_parser.record_long_ident:i (Opa_parser.record_fields_assign update:e {{e}} / update_simple):e
- {{ (List.map undecorate i, e) }}
+ / Opa_parser.record_long_ident:i (Opa_parser.record_fields_assign update:e {{e}} / update_simple):e
+ {{ `binding (List.map undecorate i, e) }}
+ / tilda:tilda Opa_parser.record_short_ident:i
+ {{
+ let u = if tilda then `value (QmlAst.Db.UExpr (var_to_exprvar i)) else `novalue i in
+ `noassign ([undecorate i], u , None)
+ }}
update_fields <-
+ tilda:tilda lbrace
(=list0(update_field, Opa_parser.record_fields_separator)):l Opa_parser.record_fields_separator?
- {{ QmlAst.Db.UFlds l }}
+ rbrace
+ {{
+ QmlAst.Db.UFlds (default_value_in_expr_update tilda l)
+ }}
update_simple <- update_incr / update_list
@@ -966,18 +966,30 @@ let list_expr_of_expr_list_unsafe l =
(*
* same as above with record stuff
*)
+let gen_default_value_in_expr_record may_coerce set_default f =
+ List.map (function
+ | `binding b -> b
+ | `noassign (i, `value p, t) ->
+ (i,may_coerce p t)
+ | `noassign (i, `novalue i2, t) ->
+ (i, may_coerce (set_default i2) t)) f
+
let default_value_in_expr_record tilda f =
let set_default =
if tilda then
fun i -> var_to_exprvar i
else
fun i -> void (label i) in
- List.map (function
- | `binding b -> b
- | `noassign (i, `value p, t) ->
- (i,may_coerce_expr p t)
- | `noassign (i, `novalue i2, t) ->
- (i, may_coerce_expr (set_default i2) t)) f
+ gen_default_value_in_expr_record may_coerce_expr set_default f
+
+let default_value_in_expr_update tilda f =
+ let set_default =
+ if tilda then
+ fun i -> QmlAst.Db.UExpr (var_to_exprvar i)
+ else
+ fun i -> QmlAst.Db.UExpr (void (label i)) in
+ gen_default_value_in_expr_record (fun x _y -> x) set_default f
+
let default_value_in_pat_record tilda f =
let default_value =
if tilda then
@@ -219,6 +219,24 @@ val simple_record : string -> annot -> ('a, 'b) coerced_expr_node
val record1 : string -> ('a, 'b) expr -> ('a, 'b) expr
val simple_record_expr : string -> annot -> ('a, 'b) coerced_expr
val simple_record_expr2 : string * annot -> ('a, 'b) coerced_expr
+val default_value_in_expr_update :
+ bool ->
+ [< `binding of
+ 'a *
+ (('b, [> `coerce ] as 'c) SurfaceAst.expr_node * QmlLoc.annot)
+ QmlAst.Db.update
+ | `noassign of
+ 'a *
+ [< `novalue of 'b * QmlLoc.annot
+ | `value of
+ (('b, 'c) SurfaceAst.expr_node * QmlLoc.annot)
+ QmlAst.Db.update ] *
+ 'd ]
+ list ->
+ ('a *
+ (('b, 'c) SurfaceAst.expr_node * QmlLoc.annot) QmlAst.Db.update)
+ list
+
val default_value_in_expr_record : bool ->
[< `binding of 'a * (string, [> `coerce ] as 'c) SurfaceAst.expr
| `noassign of 'a *
@@ -1031,7 +1031,7 @@ record_element <-
))
/ (binding_lambda / binding_module):b
{{ `binding (undecorate (fst b), snd b) }}
- / tilda:tilda deco_field_identifier:p
+ / tilda:tilda record_short_ident:p
{{ let rhs = if tilda then `value (var_to_exprvar p) else `novalue p in
`noassign (undecorate p, rhs, None)
}}
@@ -1060,6 +1060,7 @@ record_with_element <-
record_long_ident_nosp <- deco_ml_identifier_nosp:i ('.' deco_field_identifier_nosp:i {{i}})*:l {{ i :: l }}
record_long_ident <- spacing record_long_ident_nosp:i {{i}}
+record_short_ident <- deco_ml_identifier
record_long_binding <-
/ record_long_ident:i record_fields_assign expr:e {{ (i, e) }}

0 comments on commit 081c98b

Please sign in to comment.