Commit 67ffce34 authored by Taddeüs Kroes's avatar Taddeüs Kroes

Implemented a generic traversal function

parent 25a45dbd
...@@ -36,6 +36,7 @@ parser.cmx: parser.cmi lexer.cmi ...@@ -36,6 +36,7 @@ parser.cmx: parser.cmi lexer.cmi
parser.mli: parser.ml parser.mli: parser.ml
parse.cmx: lexer.cmi parser.cmx parse.cmx: lexer.cmi parser.cmx
main.cmx: parse.cmx util.cmx color.cmx main.cmx: parse.cmx util.cmx color.cmx
util.cmx: OCAMLCFLAGS += -pp cpp
$(addsuffix .cmx,$(MODULES)): $(addsuffix .cmi,$(PRE_TGTS)) $(addsuffix .cmx,$(MODULES)): $(addsuffix .cmi,$(PRE_TGTS))
clean: clean:
......
...@@ -53,17 +53,9 @@ let rec short = function ...@@ -53,17 +53,9 @@ let rec short = function
| c -> c | c -> c
let rec compress_props = function let transform = function
| [] -> [] | Declaration ("color", color, imp) ->
Declaration ("color", short color, imp)
| v -> v
| ("color", c, i) :: tl -> let compress = Util.transform_stylesheet transform
("color", short c, i) :: compress_props tl
| hd :: tl -> hd :: compress_props tl
let rec compress = function
| [] -> []
| Ruleset (selectors, properties) :: tl ->
Ruleset (selectors, compress_props properties) :: compress tl
| hd :: tl ->
hd :: compress tl
...@@ -11,14 +11,7 @@ ...@@ -11,14 +11,7 @@
open Types open Types
open Util open Util
type term_t = Term of expr | Operator of string type term = Term of expr | Operator of string
let rec transform_value f = function
| Concat terms -> Concat (List.map (transform_value f) terms)
| Function (name, arg) -> Function (name, transform_value f arg)
| Unary (op, term) -> Unary (op, transform_value f term)
| Nary (op, terms) -> Nary (op, List.map (transform_value f) terms)
| value -> f value
let concat_terms terms = let concat_terms terms =
let rec transform_ops = function let rec transform_ops = function
......
...@@ -50,9 +50,9 @@ let string_of_media_feature = function ...@@ -50,9 +50,9 @@ let string_of_media_feature = function
| (feature, None) -> "(" ^ feature ^ ")" | (feature, None) -> "(" ^ feature ^ ")"
| (feature, Some value) -> "(" ^ feature ^ ": " ^ string_of_expr value ^ ")" | (feature, Some value) -> "(" ^ feature ^ ": " ^ string_of_expr value ^ ")"
let string_of_media_query query = let string_of_media_query =
let features_str = cat " and " string_of_media_feature in let features_str = cat " and " string_of_media_feature in
match query with function
| (None, None, []) -> "" | (None, None, []) -> ""
| (None, Some mtype, []) -> mtype | (None, Some mtype, []) -> mtype
| (Some pre, Some mtype, []) -> pre ^ " " ^ mtype | (Some pre, Some mtype, []) -> pre ^ " " ^ mtype
......
...@@ -53,6 +53,20 @@ type statement = ...@@ -53,6 +53,20 @@ type statement =
type stylesheet = statement list type stylesheet = statement list
type traversal_box =
| Expr of expr
| Declaration of declaration
| Selector of selector
| Media_expr of media_expr
| Media_query of media_query
| Descriptor_declaration of descriptor_declaration
| Keyframe_ruleset of keyframe_ruleset
| Supports_declaration of supports_declaration
| Condition of condition
| Statement of statement
| Stylesheet of stylesheet
| Clear
type loc = string * int * int * int * int type loc = string * int * int * int * int
exception Syntax_error of string exception Syntax_error of string
......
...@@ -94,3 +94,118 @@ let prerr_loc_msg verbose loc msg = ...@@ -94,3 +94,118 @@ let prerr_loc_msg verbose loc msg =
try prerr_loc loc try prerr_loc loc
with Sys_error _ -> () with Sys_error _ -> ()
end end
#define TRAV_ALL(id, constructor) \
trav_all_##id l = \
let rec filter_clear = function \
| [] -> [] \
| Clear :: tl -> filter_clear tl \
| constructor hd :: tl -> hd :: filter_clear tl \
| _ -> failwith ("expected " ^ #constructor ^ " or Clear") \
in \
filter_clear (List.map trav_##id l)
#define EXPECT(id, constructor) \
expect_##id value = \
match trav_##id value with \
| constructor decl -> decl \
| _ -> failwith ("expected " ^ #constructor)
let transform_stylesheet (f : traversal_box -> traversal_box) stylesheet =
let rec trav_expr = function
| Concat terms -> f (Expr (Concat (trav_all_expr terms)))
| Function (name, arg) -> f (Expr (Function (name, expect_expr arg)))
| Unary (op, opnd) -> f (Expr (Unary (op, expect_expr opnd)))
| Nary (op, opnds) -> f (Expr (Nary (op, trav_all_expr opnds)))
| value -> f (Expr value)
and EXPECT(expr, Expr)
and TRAV_ALL(expr, Expr) in
let trav_declaration (name, value, important) =
f (Declaration (name, expect_expr value, important))
in
let TRAV_ALL(declaration, Declaration) in
let trav_selector = function
| Simple _ as s -> f (Selector s)
| Combinator (left, com, right) ->
f (Selector (Combinator (left, com, right)))
in
let TRAV_ALL(selector, Selector) in
let trav_media_expr = function
| (_, None) as value ->
f (Media_expr value)
| (name, Some value) ->
let value =
match trav_expr value with
| Expr value -> Some value
| Clear -> None
| _ -> failwith "expected Expr or Clear"
in
f (Media_expr (name, value))
in
let TRAV_ALL(media_expr, Media_expr) in
let trav_media_query (prefix, mtype, queries) =
f (Media_query (prefix, mtype, trav_all_media_expr queries))
in
let TRAV_ALL(media_query, Media_query) in
let trav_descriptor_declaration (name, value) =
f (Descriptor_declaration (name, expect_expr value))
in
let TRAV_ALL(descriptor_declaration, Descriptor_declaration) in
let trav_keyframe_ruleset (selector, decls) =
f (Keyframe_ruleset (expect_expr selector, trav_all_declaration decls))
in
let TRAV_ALL(keyframe_ruleset, Keyframe_ruleset) in
let trav_supports_declaration (name, value) =
f (Supports_declaration (name, expect_expr value))
in
let EXPECT(supports_declaration, Supports_declaration) in
let rec trav_condition = function
| Not c -> f (Condition (Not (expect_condition c)))
| And l -> f (Condition (And (trav_all_condition l)))
| Or l -> f (Condition (Or (trav_all_condition l)))
| Decl d -> f (Condition (Decl (expect_supports_declaration d)))
and EXPECT(condition, Condition)
and TRAV_ALL(condition, Condition) in
let rec trav_statement = function
| Ruleset (selectors, decls) ->
let selectors = trav_all_selector selectors in
let decls = trav_all_declaration decls in
f (Statement (Ruleset (selectors, decls)))
| Media (queries, rulesets) ->
let queries = trav_all_media_query queries in
let rulesets = trav_all_statement rulesets in
f (Statement (Media (queries, rulesets)))
| Import (target, queries) ->
let target = expect_expr target in
let queries = trav_all_media_query queries in
f (Statement (Import (target, queries)))
| Page (pseudo, decls) ->
let decls = trav_all_declaration decls in
f (Statement (Page (pseudo, decls)))
| Font_face decls ->
let decls = trav_all_descriptor_declaration decls in
f (Statement (Font_face decls))
| Namespace (prefix, uri) ->
let uri = expect_expr uri in
f (Statement (Namespace (prefix, uri)))
| Keyframes (id, rules) ->
let rules = trav_all_keyframe_ruleset rules in
f (Statement (Keyframes (id, rules)))
| Supports (condition, statements) ->
let condition = expect_condition condition in
let statements = trav_all_statement statements in
f (Statement (Supports (condition, statements)))
| s ->
f (Statement s)
and TRAV_ALL(statement, Statement) in
trav_all_statement stylesheet
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