Commit c05df5e0 authored by Pietro Abate's avatar Pietro Abate

[r2005-03-06 15:52:10 by afrisch] New syntax for record types/patterns

Original author: afrisch
Date: 2005-03-06 15:52:11+00:00
parent b5e633e3
......@@ -19,6 +19,12 @@ Since 0.2.2
A dot in an identifier must now be escaped with a backslash, e.g. x\.y
* Identifiers (for types, values) are now qualified names.
* float_of: String -> Float
* Syntax modifications for records and attributes:
- ".." to denote open record types/patterns:
open record: { l1=t1 l2=t2 .. }
closed record: { l1=t1 l2=t2 }
- the ";" between fields is optional even for records
(used to be optional only for attributes)
- Tools:
* A new tool cduce_mktop produces customized CDuce toplevels with embedded
......
......@@ -354,7 +354,7 @@ EXTEND
];
a = expr_attrib_spec; ">"; c = expr ->
exp loc (Xml (t, Pair (a,c)))
| "{"; r = [ expr_record_spec | -> exp loc (RecordLitt []) ]; "}" -> r
| "{"; r = expr_record_spec; "}" -> r
| s = STRING2 ->
let s = U.mk s in
exp loc (String (U.start_index s, U.end_index s, s, cst_nil))
......@@ -546,7 +546,7 @@ EXTEND
]
];
located_ident: [ [ a = IDENT -> (lop loc,ident a) ] ];
located_ident: [ [ a = [IDENT|keyword] -> (lop loc,ident a) ] ];
pat: [
[ x = pat; "where";
......@@ -558,8 +558,7 @@ EXTEND
| "simple" [ x = pat; "&"; y = pat -> mk loc (And (x,y))
| x = pat; "\\"; y = pat -> mk loc (Diff (x,y)) ]
|
[ "{"; r = record_spec; "}" -> mk loc (Record (true,r))
| "{|"; r = record_spec; "|}" -> mk loc (Record (false,r))
[ "{"; r = record_spec; "}" -> r
| "ref"; p = pat ->
let get_fun = mk loc (Arrow (pat_nil, p))
and set_fun = mk loc (Arrow (p, pat_nil))in
......@@ -571,7 +570,7 @@ EXTEND
mk loc (Constant (ident a,c))
| "!"; a = IDENT ->
mk loc (Internal (Types.abstract (Types.Abstract.atom a)))
| cu = OPT [ cu = IDENT; "." -> U.mk cu ]; a = IDENT ->
| cu = OPT [ cu = IDENT; "." -> U.mk cu ]; a = [ IDENT | keyword ] ->
mk loc (PatVar (cu, ident a))
| i = INT ; "--"; j = INT ->
let i = Intervals.V.mk i
......@@ -630,7 +629,7 @@ EXTEND
x = pat; y = or_else -> (o,x,y) ] ] ];
record_spec:
[ [ r = LIST0 [ l = [IDENT | keyword ]; f = opt_field_pat ->
[ [ r = LIST0 [ l = [IDENT | keyword ]; f = opt_field_pat; OPT ";" ->
let (o,x,y) =
match f with
| None -> (false, mknoloc (PatVar (None,ident l)), None)
......@@ -638,8 +637,8 @@ EXTEND
in
let x = if o then mk loc (Optional x) else x in
(label l, (x,y))
] SEP ";" ->
r
]; op = [ ".." -> true | -> false ] ->
mk loc (Record (op,r))
] ];
char:
......@@ -648,46 +647,27 @@ EXTEND
];
attrib_spec:
[ [ r = LIST0 [ l = [IDENT | keyword ]; f = opt_field_pat; OPT ";" ->
let (o,x,y) =
match f with
| None -> (false, mknoloc (PatVar (None,ident l)), None)
| Some z -> z
in
let x = if o then mk loc (Optional x) else x in
(label l, (x, y))
] ->
mk loc (Record (true,r))
| "("; t = pat; ")" -> t
| "{"; r = record_spec; "}" -> mk loc (Record (true,r))
| "{|"; r = record_spec; "|}" -> mk loc (Record (false,r))
] ];
attrib_spec: [
[ r = record_spec -> r
| "("; t = pat; ")" -> t
] ];
opt_field_expr: [ [ OPT [ "="; x = expr LEVEL "no_appl" -> x ] ] ];
expr_record_spec:
[ [ r = LIST1
[ [ r = LIST0
[ l = [IDENT | keyword ];
x = opt_field_expr ->
x = opt_field_expr; OPT ";" ->
let x = match x with Some x -> x | None -> Var (ident l) in
(label l,x) ]
SEP ";" ->
->
exp loc (RecordLitt r)
] ];
expr_attrib_spec:
[ [ r = LIST1
[ l = [IDENT | keyword ];
x = opt_field_expr; OPT ";" ->
let x = match x with Some x -> x | None -> Var (ident l) in
(label l,x) ] ->
exp loc (RecordLitt r)
]
| [ e = expr LEVEL "no_appl" -> e
| -> exp loc (RecordLitt [])
]
];
expr_attrib_spec: [
[ e = expr_record_spec -> e
| "("; e = expr; ")" -> e
] ];
END
module Hook = struct
......
......@@ -75,6 +75,7 @@ let rec token = lexer
| [ "<>=.,:;+-*/@&{}[]()|?`!" ]
| "->" | "::" | ";;" | "--" | "//" | "/@" | ":=" | "\\" | "++"
| "{|" | "|}" | "<=" | ">=" | "<<" | ">>" | "||" | "&&" | "**"
| ".."
| ["?+*"] "?" | "#" ->
return lexbuf ("", L.utf8_lexeme lexbuf)
| '"' | "'" ->
......
......@@ -324,8 +324,7 @@ and print_attr ppf = function
and print_record ppf = function
| [] -> ()
| [f] -> Format.fprintf ppf " %a" print_field f
| f :: rem -> Format.fprintf ppf " %a;%a" print_field f print_record rem
| f :: rem -> Format.fprintf ppf " %a" print_field f; print_record ppf rem
and print_field ppf (l,v) =
Format.fprintf ppf "%a=%a" Label.print (LabelPool.value l) print v
......
......@@ -62,25 +62,21 @@ let import_dtd ppf name filename =
| _ -> Format.fprintf ppf "String"
in
let attrib ppf e =
ignore
(List.fold_left
(fun first a ->
let (at,ad) = e # attribute a in
match ad with
| D_fixed _ -> first
| _ ->
Format.fprintf ppf "%s%s=%s%a"
(if first then "" else "; ")
a
(if ad = D_required then "" else "?")
att_type at;
false
)
true (e # attribute_names)
List.iter
(fun a ->
let (at,ad) = e # attribute a in
match ad with
| D_fixed _ -> ()
| _ ->
Format.fprintf ppf " %s=%s%a"
a
(if ad = D_required then "" else "?")
att_type at;
)
(e # attribute_names)
in
let elt ppf e =
Format.fprintf ppf "type @[<2>%s =@ @[<3><%s {|%a|}>[@ @[%a@]@ ]@]@];;@\n"
Format.fprintf ppf "type @[<2>%s =@ @[<3><%s%a>[@ @[%a@]@ ]@]@];;@\n"
(name (e # name))
(e # name)
attrib e
......
......@@ -1581,12 +1581,9 @@ struct
do_print_attr attr
(do_print_slot 2) t
| Record (r,some,none) ->
if some then Format.fprintf ppf "@[{"
else Format.fprintf ppf "@[{|";
do_print_record ppf r;
if not none then Format.fprintf ppf ";@ ...";
if some then Format.fprintf ppf " }@]"
else Format.fprintf ppf " |}@]"
Format.fprintf ppf "@[{";
do_print_record ppf (r,some,none);
Format.fprintf ppf " }@]"
| Arrows (p,n) ->
(match p with
| [] -> Format.fprintf ppf "Arrow"
......@@ -1610,18 +1607,18 @@ struct
| `Tag s -> s ppf
| `Type t -> Format.fprintf ppf "(%a)" (do_print_slot 0) t
and do_print_attr ppf = function
| { state = `Marked|`Expand;
def = [ Record (r,true,true) ] } -> do_print_record ppf r
| t -> Format.fprintf ppf " %a" (do_print_slot 2) t
and do_print_record ppf r =
let first = ref true in
| { state = `Marked|`Expand|`None;
def = [ Record (r,some,none) ] } -> do_print_record ppf (r,some,none)
| t -> Format.fprintf ppf " (%a)" (do_print_slot 2) t
and do_print_record ppf (r,some,none) =
List.iter
(fun (l,(o,t)) ->
let sep = if !first then (first := false; "") else ";" in
let opt = if o then "?" else "" in
Format.fprintf ppf "%s@ @[%a =%s@] %a" sep
Format.fprintf ppf "@ @[%a=%s@]%a"
Label.print (LabelPool.value l) opt (do_print_slot 0) t
) (LabelMap.get r)
) (LabelMap.get r);
if not none then Format.fprintf ppf "@ (+others)";
if some then Format.fprintf ppf " ..";
and do_print_regexp pri ppf = function
| Pretty.Empty -> Format.fprintf ppf "Empty" (*assert false *)
| Pretty.Epsilon -> ()
......
This diff is collapsed.
type Special = Xbr | Xspan | Xbdo | Xmap | Xobject | Ximg;;
type Fontstyle = Xtt | Xi | Xb | Xbig | Xsmall;;
type Phrase = Xem | Xstrong | Xdfn | Xcode | Xq |
Xsamp | Xkbd | Xvar | Xcite | Xabbr | Xacronym | Xsub | Xsup;;
type InlineForms = Xinput | Xselect | Xtextarea | Xlabel | Xbutton;;
type MiscInline = Xins | Xdel | Xscript;;
type Misc = Xnoscript | MiscInline;;
type Inline = Xa | Special | Fontstyle | Phrase | InlineForms;;
type Special = br | span | bdo | map | object | img;;
type Fontstyle = tt | i | b | big | small;;
type Phrase = em | strong | dfn | code | q |
samp | kbd | var | cite | abbr | acronym | sub | sup;;
type InlineForms = input | select | textarea | label | button;;
type MiscInline = ins | del | script;;
type Misc = noscript | MiscInline;;
type Inline = a | Special | Fontstyle | Phrase | InlineForms;;
type Inlines = [ (Char | Inline | MiscInline)* ];;
type Heading = Xh1 | Xh2 | Xh3 | Xh4 | Xh5 | Xh6;;
type Lists = Xul | Xol | Xdl;;
type Blocktext = Xpre | Xhr | Xblockquote | Xaddress;;
type Block = Xp | Heading | Xdiv | Lists | Blocktext | Xfieldset | Xtable;;
type Blocks = [ (Block | Xform | Misc)* ];;
type Heading = h1 | h2 | h3 | h4 | h5 | h6;;
type Lists = ul | ol | dl;;
type Blocktext = pre | hr | blockquote | address;;
type Block = p | Heading | div | Lists | Blocktext | fieldset | table;;
type Blocks = [ (Block | form | Misc)* ];;
type Flow = [ (Char | Block | Xform | Inline | Misc)* ];;
type Flow = [ (Char | Block | form | Inline | Misc)* ];;
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment