Skip to content
Snippets Groups Projects
Commit 5c088307 authored by Taddeüs Kroes's avatar Taddeüs Kroes
Browse files

First version of parser that compiles (still conflicts to resolve)

parent bbb79f6f
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
lexer.mll
+ 18
− 27
View file @ 5c088307
......@@ -3,8 +3,7 @@
* http://www.w3.org/TR/CSS2/syndata.html#tokenization *)
open Lexing
open Parser
exception SyntaxError of string
open Types
let next_line lexbuf =
let pos = lexbuf.lex_curr_p in
......@@ -51,15 +50,15 @@ rule token = parse
| "<!--" { CDO }
| "-->" { CDC }
| "~=" { INCLUDES }
| "|=" { DASHMATCH }
| ['~''|']?'=' as op { RELATION op }
| ['>''~'] as c { COMBINATOR (Char.escaped c) }
| mystring { STRING }
| badstring { BAD_STRING }
| mystring as s { STRING s }
| badstring as s { raise (SyntaxError "bad string") }
| ident as id { IDENT id }
| '#' (name as name) { HASH name }
| '#' (name as nm) { HASH nm }
| "@import" { IMPORT_SYM }
| "@page" { PAGE_SYM }
......@@ -68,32 +67,17 @@ rule token = parse
| '!' (w | comment)* "important" { IMPORTANT_SYM }
| (num as n) "em" { EMS (int_of_string n) }
| (num as n) "ex" { EXS (int_of_string n) }
| (num as n) "px" { LENGTH (int_of_string n, "px") }
| (num as n) "cm" { LENGTH (int_of_string n, "cm") }
| (num as n) "mm" { LENGTH (int_of_string n, "mm") }
| (num as n) "in" { LENGTH (int_of_string n, "in") }
| (num as n) "pt" { LENGTH (int_of_string n, "pt") }
| (num as n) "pc" { LENGTH (int_of_string n, "pc") }
| (num as n) "deg" { ANGLE (int_of_string n, "deg") }
| (num as n) "rad" { ANGLE (int_of_string n, "rad") }
| (num as n) "grad" { ANGLE (int_of_string n, "grad") }
| (num as n) "ms" { TIME (int_of_string n, "ms") }
| (num as n) "s" { TIME (int_of_string n, "s") }
| (num as n) "hz" { FREQ (int_of_string n, "hz") }
| (num as n) "khz" { FREQ (int_of_string n, "khz") }
| (num as n) "%" { PERCENTAGE (int_of_string n) }
| (num as n) (ident as dim) { DIMENSION (int_of_string n, dim) }
| num as n { NUMBER (int_of_string n) }
| (num as n) ("em"|"ex"|"px"|"cm"|"mm"|"in"|"pt"|"pc"|"deg"|"rad"|"grad"|
"ms"|"s"|"hz"|"khz"|"%"|ident as u)
{ UNIT_VALUE (float_of_string n, u) }
| num as n { NUMBER (float_of_string n) }
| "url(" w (mystring as uri) w ")" { URI uri }
| "url(" w (url as uri) w ")" { URI uri }
| baduri as uri { BAD_URI uri }
| baduri as uri { raise (SyntaxError "bad uri") }
| (ident as fn) '(' { FUNCTION fn }
| '(' { LPAREN }
| ')' { RPAREN }
| '{' { LBRACE }
| '}' { RBRACE }
......@@ -101,6 +85,13 @@ rule token = parse
| ']' { RBRACK }
| ';' { SEMICOL }
| ':' { COLON }
| ',' { COMMA }
| '.' { DOT }
| '+' { PLUS }
| '-' { MINUS }
| '/' { SLASH }
| '*' { STAR }
(*
| _ as c { raise (SyntaxError ("illegal string character: " ^ Char.escaped c)) }
......
parse.ml
+ 1
− 1
View file @ 5c088307
......@@ -27,7 +27,7 @@ let parse_input display_name content =
let lexbuf = Lexing.from_string content in
lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = display_name };
try Parser.stylesheet Lexer.token lexbuf with
| Lexer.SyntaxError msg ->
| SyntaxError msg ->
raise (LocError (shift_back lexbuf, msg))
| Parser.Error ->
raise (LocError (shift_back lexbuf, "syntax error"))
parser.mly
+ 127
− 40
View file @ 5c088307
......@@ -2,61 +2,148 @@
open Lexing
open Types
let prop2str (name, value) = name ^ ":" ^ Stringify.value2str value
let filter_none l =
let rec filter l = function
| [] -> []
| None :: tl -> filter l tl
| Some hd :: tl -> filter (hd :: l) tl
in
List.rev (filter [] l)
%}
(* Tokens *)
%token S CDO CDC INCLUDES DASHMATCH STRING BAD_STRING IMPORT_SYM PAGE_SYM
%token MEDIA_SYM CHARSET_SYM IMPORTANT_SYM
%token LPAREN RPAREN LBRACE RBRACE LBRACK RBRACK SEMICOL COLON
%token <int> EMS EXS PERCENTAGE NUMBER
%token <int * string> LENGTH ANGLE TIME FREQ DIMENSION
%token <string> IDENT HASH URI BAD_URI FUNCTION
%token S CDO CDC IMPORT_SYM PAGE_SYM MEDIA_SYM CHARSET_SYM
%token IMPORTANT_SYM
%token <float> NUMBER
%token <float * string> UNIT_VALUE
%token <string> COMBINATOR RELATION STRING IDENT HASH URI FUNCTION
%token RPAREN LBRACE RBRACE LBRACK RBRACK SEMICOL COLON COMMA DOT PLUS MINUS
%token SLASH STAR
(* Start symbol *)
%type <Types.decl list> stylesheet
%type <Types.stylesheet> stylesheet
%start stylesheet
%%
(* Left-recursive list (use List.rev to obtain correctly ordered list) *)
(*
llist(x):
| { [] }
| tl=llist(x) hd=x { hd :: tl }
*)
%inline mylist(sep, x):
| l=separated_list(sep, delimited(S*, x, S*))
{ l }
cd: CDO S* | CDC S* {}
%inline statement: r=ruleset | r=media | r=page { r }
stylesheet:
| ( CDO | CDC | S | statement )*
| charset = charset? S* cd*
imports = terminated(import, cd*)*
statements = terminated(statement, cd*)*
{ let charset = match charset with None -> [] | Some c -> [c] in
charset @ imports @ statements }
charset:
| CHARSET_SYM set=STRING SEMICOL
{ Charset set }
%inline string_or_uri: s=STRING | s=URI { s }
import:
| IMPORT_SYM S* tgt=string_or_uri media=mylist(COMMA, IDENT) SEMICOL S*
{ Import (tgt, media) }
statement:
| ruleset
| at_rule
media:
| MEDIA_SYM S* queries=mylist(COMMA, IDENT) LBRACE S* rulesets=ruleset* RBRACE S*
{ Media (queries, rulesets) }
at_rule:
| ATKEYWORD S* any* ( block | SEMICOL S* )
page:
| PAGE_SYM S* pseudo=pseudo_page? decls=decls_block
{ Page (pseudo, decls) }
block:
| LBRACE S* ( any | block | ATKEYWORD S* | SEMICOL S* )* RBRACE S*
pseudo_page:
| COLON pseudo=IDENT S*
{ pseudo }
decls_block:
| LBRACE S* decls=mylist(SEMICOL, declaration?) RBRACE S*
{ filter_none decls }
ruleset:
| selectors=any+ LBRACE S* declaration? ( SEMICOL S* declaration? )* RBRACE S*
| selectors_hd = selector
selectors_tl = separated_list(COMMA, preceded(S*, selector))
decls = decls_block
{ Ruleset (selectors_hd :: selectors_tl, decls) }
%inline combinator:
| S* PLUS S* { ["+"] }
| S* c=COMBINATOR S* { [c] }
| S+ { [] }
selector:
| hd=simple_selector comb=combinator tl=selector
{ hd :: comb @ tl }
| simple=simple_selector
{ [simple] }
simple_selector:
| elem=element_name addons=element_addon*
{ elem ^ String.concat "" addons }
| addons=element_addon+
{ String.concat "" addons }
element_addon:
| a=HASH | a=cls | a=attrib | a=pseudo
{ a }
cls:
| DOT name=IDENT
{ "." ^ name }
element_name:
| tag=IDENT { tag }
| STAR { "*" }
%inline rel_value:
| S* id=IDENT S* { id }
| S* s=STRING S* { s }
attrib:
| LBRACK S* left=IDENT S* right=pair(RELATION, rel_value)? RBRACK
{ left ^ (match right with None -> "" | Some (rel, term) -> rel ^ term) }
pseudo:
| COLON id=IDENT
{ ":" ^ id }
| COLON f=FUNCTION S* arg=terminated(IDENT, S*)? RPAREN
{ let arg = match arg with None -> "" | Some id -> id in
":" ^ f ^ "(" ^ arg ^ ")" }
declaration:
| name=IDENT S* COLON S* value=value
{ Property (name, value) }
value:
| ( any | block | ATKEYWORD S* )+
any:
| ( IDENT | NUMBER | PERCENTAGE | DIMENSION | STRING | DELIM | URI | HASH |
UNICODE-RANGE | INCLUDES | DASHMATCH | COLON | FUNCTION S* (any|unused)*
RPAREN | LPAREN S* (any|unused)* RPAREN | LBRACK S* (any|unused)* RBRACK) S*
unused:
| block
| ATKEYWORD S*
| SEMICOL S*
| CDO S*
| CDC S*
| name=IDENT S* COLON S* value=expr IMPORTANT_SYM S*
{ (name, Prio value) }
| name=IDENT S* COLON S* value=expr
{ (name, value) }
%inline unary_operator:
| MINUS { "-" }
| PLUS { "+" }
expr:
| left=expr right=expr
{ Concat [left; right] }
| left=expr SLASH S* right=expr
{ Binop (left, "/", right) }
| op=unary_operator n=NUMBER S*
{ Unop (op, Number n) }
| op=unary_operator v=UNIT_VALUE S*
{ let (n, u) = v in Unop (op, Unit (n, u)) }
| n=NUMBER S*
{ Number n }
| v=UNIT_VALUE S*
{ let (n, u) = v in Unit (n, u) }
| str=STRING S*
{ Strlit str }
| id=IDENT S*
{ Ident id }
| uri=URI S*
{ Uri uri }
| fn=FUNCTION S* args=separated_list(COMMA, terminated(expr, S*)) RPAREN S*
{ Function (fn, args) }
| hex=HASH S*
{ if Str.string_match (Str.regexp "\\d{3}\\d{3}?") hex 0
then Hexcolor hex
else raise (SyntaxError ("invalid color #" ^ hex)) }
stringify.ml
+ 35
− 23
View file @ 5c088307
......@@ -9,40 +9,52 @@ let rec cat sep fn = function
| [hd] -> fn hd
| hd :: tl -> fn hd ^ sep ^ cat sep fn tl
let rec value2str = function
| Lit lit -> lit
| Str str -> "\"" ^ str ^ "\""
| Lst values -> cat " " value2str values
| Dim (x, u) when float_of_int (int_of_float x) = x ->
string_of_int (int_of_float x) ^ u
| Dim (x, u) -> string_of_float x ^ u
| Fn (name, arg) -> name ^ "(" ^ value2str arg ^ ")"
| Imp -> "!important"
let prop2str (name, value) = name ^ ": " ^ value2str value ^ ";"
let string_of_num n =
if float_of_int (int_of_float n) = n
then string_of_int (int_of_float n)
else string_of_float n
let rec string_of_value = function
| Ident id -> id
| Strlit str -> "\"" ^ str ^ "\""
| Uri uri when String.contains uri ')' -> "url(\"" ^ uri ^ "\")"
| Uri uri -> "url(" ^ uri ^ ")"
| Concat values -> cat " " string_of_value values
| Number n -> string_of_num n
| Unit (n, u) -> string_of_num n ^ u
| Function (name, args) -> name ^ "(" ^ cat "," string_of_value args ^ ")"
| Hexcolor hex -> "#" ^ hex
| Unop (op, opnd) -> op ^ string_of_value opnd
| Binop (left, op, right) -> string_of_value left ^ op ^ string_of_value right
| Prio value -> string_of_value value ^ " !important"
let string_of_declaration (name, value) =
name ^ ": " ^ string_of_value value ^ ";"
let block body = " {\n" ^ indent body ^ "\n}"
let rec decl2str = function
| Group (selectors, props) ->
cat ", " (String.concat " ") selectors ^ block (cat "\n" prop2str props)
| Media (queries, groups) ->
"@media " ^ String.concat ", " queries ^ block (cat "\n\n" decl2str groups)
let rec string_of_statement = function
| Ruleset (selectors, decls) ->
cat ", " (String.concat " ") selectors ^
block (cat "\n" string_of_declaration decls)
| Media (queries, rulesets) ->
"@media " ^ String.concat ", " queries ^
block (cat "\n\n" string_of_statement rulesets)
| Import (filename, []) ->
"@import \"" ^ filename ^ "\";"
| Import (filename, queries) ->
"@import \"" ^ filename ^ "\" " ^ String.concat ", " queries ^ ";"
| Charset charset ->
"@charset \"" ^ charset ^ "\";"
| Page (None, props) ->
"@page" ^ block (cat "\n" prop2str props)
| Page (Some query, props) ->
"@page " ^ query ^ block (cat "\n" prop2str props)
| Fontface props ->
"@font-face " ^ block (cat "\n" prop2str props)
| Page (None, decls) ->
"@page" ^ block (cat "\n" string_of_declaration decls)
| Page (Some pseudo, decls) ->
"@page :" ^ pseudo ^ block (cat "\n" string_of_declaration decls)
| Fontface decls ->
"@font-face " ^ block (cat "\n" string_of_declaration decls)
| Namespace (None, uri) ->
"@namespace \"" ^ uri ^ "\";"
| Namespace (Some prefix, uri) ->
"@namespace " ^ prefix ^ " \"" ^ uri ^ "\";"
let decls2str = cat "\n\n" decl2str
let string_of_stylesheet = cat "\n\n" string_of_statement
types.ml
+ 31
− 15
View file @ 5c088307
type value =
| Lit of string
| Str of string
| Lst of value list
| Dim of float * string
| Fn of string * value
| Imp
| Ident of string
| Strlit of string
| Uri of string
| Concat of value list
| Number of float
| Unit of float * string
| Function of string * value list
| Hexcolor of string
| Unop of string * value
| Binop of value * string * value
| Prio of value
type prop = string * value
type declaration = string * value
type selector = string list
type decl =
| Group of selector list * prop list (* <selectors> { <props> } *)
| Media of string list * decl list (* @media <queries> { <groups> } *)
| Import of string * string list (* @import "<file>" [<media>]; *)
| Charset of string (* @charset "<charset>"; *)
| Page of string option * prop list (* @page [<query>] { <props> } *)
| Fontface of prop list (* @font-face { <props> } *)
| Namespace of string option * string (* @namespace [<prefix>] "<uri>"; *)
type statement =
| Ruleset of selector list * declaration list
(* <selectors> { <declarations> } *)
| Media of string list * statement list
(* @media <queries> { <rulesets> } *)
| Import of string * string list
(* @import "<file>" [<media>]; *)
| Charset of string
(* @charset "<charset>"; *)
| Page of string option * declaration list
(* @page [<pseudo_page>] { <declarations> } *)
| Fontface of declaration list
(* @font-face { <declarations> } *)
| Namespace of string option * string
(* @namespace [<prefix>] "<uri>"; *)
(* TODO: @document, @keyframes, @supports *)
type stylesheet = statement list
type args = {
mutable infiles : string list;
mutable outfile : string option;
......@@ -28,4 +42,6 @@ type args = {
type loc = string * int * int * int * int
exception SyntaxError of string
exception LocError of loc * string
util.ml
+ 1
− 1
View file @ 5c088307
......@@ -23,7 +23,7 @@ let input_buffered ic chunksize =
read_all (String.create chunksize) chunksize 0
let output_css oc decls =
output_string oc (Stringify.decls2str decls);
output_string oc (Stringify.string_of_stylesheet decls);
output_char oc '\n'
let print_css = output_css stdout
......
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