Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

General improvement to the lexer, the parser, the build system.

Now it is possible to use quotations in css.ml to write library functions (as gradient or rounded).
  • Loading branch information...
commit 4f290be96b4b0dae879e2a44dc35ccdbd7d2048b 1 parent 28d5749
Thomas Gazagnaire authored
12 Makefile
@@ -12,7 +12,8 @@ BFILES=$(addprefix _build/,$(FILES))
12 12 STUFF=$(shell ocamlfind query cass -r -format "-I %d %a" -predicates byte)
13 13
14 14 all:
15   - ocamlbuild cass.cma cass_top.cmo cass.cmxa css.cmo css.cmx
  15 + ocamlbuild cass.cma cass_top.cmo cass.cmxa
  16 + ocamlbuild -pp "camlp4orf cass.cma" css.cmo css.cmx
16 17
17 18 install:
18 19 ocamlfind install cass META $(BFILES)
@@ -25,11 +26,12 @@ clean:
25 26 rm -rf test.exp test.cmo test.cmx test.cmi test.o
26 27
27 28 test:
28   - ocamlbuild test.byte
29   - ./test.byte
  29 + ocamlbuild -pp "camlp4orf cass.cma" test.byte --
30 30
31   -test.exp: test.ml
32   - camlp4of _build/cass.cma test.ml -printer o > test.exp
  31 +.PHONY: text_exp
  32 +test_exp: test.ml
  33 + camlp4of _build/cass.cma test.ml -printer o > test_exp.ml
  34 + ocamlc -annot -I _build/ css.cmo test_exp.ml -o test_exp
33 35
34 36 debug: all
35 37 camlp4of _build/cass.cma test.ml
1  _tags
@@ -3,4 +3,3 @@
3 3 <cass_parser.ml*>: syntax_camlp4o,pkg_camlp4.extend
4 4 <cass_quotations.ml*>: syntax_camlp4o,pkg_camlp4.quotations
5 5 <cass_ast.ml*>: syntax_camlp4o,pkg_camlp4.quotations
6   -<test.ml>: syntax_camlp4o,pkg_cass
41 cass_lexer.mll
@@ -32,31 +32,32 @@
32 32 Cass_location.newline ()
33 33 }
34 34
35   -let all = [^ ' ' '\t' '\r' '\n' ';' ',' '{' '}' '$' '"' '\'']
  35 +let all = [^ ' ' '\t' '\r' '\n' '{' '}' '(' ')' ';' ',' '$' '"' '\'' '=']
36 36
37 37 (* very very simple HTML lexer *)
38 38 rule token = parse
39   - | [' ' '\t']* { update lexbuf; token lexbuf }
40   - | '\n' { newline lexbuf; token lexbuf }
41   - | '{' { debug "{"; update lexbuf; OPEN }
42   - | '}' { debug "}"; CLOSE }
43   - | '(' { debug "("; LEFT }
44   - | ')' { debug ")"; RIGHT }
45   - | ',' { debug ","; update lexbuf; COMMA }
46   - | ';' { debug ";"; update lexbuf; SEMI }
47   - | '$' { debug "$*$"; update lexbuf; DOLLAR (dollar lexbuf) }
48   - | '"' { debug "\"*\""; update lexbuf; STRING (Printf.sprintf "\"%s\"" (dquote lexbuf)) }
49   - | '\'' { debug "\'"; update lexbuf; STRING (Printf.sprintf "\"%s\"" (quote lexbuf)) }
50   - | "/*" { comments lexbuf; token lexbuf }
51   - | eof { debug "EOF"; update lexbuf; EOF }
52   - | all* as x { debug "%s" x; update lexbuf;
53   - if x.[String.length x - 1] = ':' then
54   - PROP (String.sub x 0 (String.length x - 1))
55   - else
56   - STRING x }
  39 + | [' ' '\t' '\r']* { update lexbuf; token lexbuf }
  40 + | '\n' { newline lexbuf; token lexbuf }
  41 + | '{' { debug "{"; update lexbuf; OPEN }
  42 + | '}' { debug "}"; CLOSE }
  43 + | '(' { debug "("; LEFT }
  44 + | ')' { debug ")"; RIGHT }
  45 + | ',' { debug ","; update lexbuf; COMMA }
  46 + | ';' { debug ";"; update lexbuf; SEMI }
  47 + | '$' { debug "$*$"; update lexbuf; DOLLAR (dollar lexbuf) }
  48 + | '"' { debug "\"*\""; update lexbuf; STRING (Printf.sprintf "\"%s\"" (dquote lexbuf)) }
  49 + | '\'' { debug "\'"; update lexbuf; STRING (Printf.sprintf "\"%s\"" (quote lexbuf)) }
  50 + | '=' { debug "="; EQ }
  51 + | "/*" { comments lexbuf; token lexbuf }
  52 + | eof { debug "EOF"; update lexbuf; EOF }
  53 + | all* as x { debug "%s" x; update lexbuf;
  54 + if x.[String.length x - 1] = ':' then
  55 + PROP (String.sub x 0 (String.length x - 1))
  56 + else
  57 + STRING x }
57 58
58 59 and dollar = parse
59   - | ([^ '$']* as str) '$' { update lexbuf; str }
  60 + | ([^ '$']* as str) '$' { update lexbuf; Printf.eprintf "[LEXER] %s\n" str; str }
60 61
61 62 and dquote = parse
62 63 | ([^ '"']* as str) '"' { update lexbuf; str }
20 cass_parser.mly
@@ -33,9 +33,10 @@
33 33 Printf.kprintf (fun s -> ()) fmt
34 34 %}
35 35
36   -%token COMMA SEMI OPEN CLOSE EOF LEFT RIGHT
  36 +%token COMMA SEMI OPEN CLOSE EOF LEFT RIGHT EQ
37 37 %token <string> STRING DOLLAR PROP
38 38
  39 +%left EQ
39 40 %left COMMA
40 41 %left SEMI
41 42 %left OPEN CLOSE
@@ -50,10 +51,17 @@
50 51
51 52 %%
52 53
  54 + arg:
  55 + | one EQ one { debug "EQ"; Seq($1, Seq(String "=", $3)) }
  56 + | one LEFT args RIGHT { debug "FUN"; Fun($1, $3) }
  57 + | one arg { debug "SEQ"; Seq($1, $2) }
  58 + | one { $1 }
  59 +;
  60 +
53 61 args:
54   - | one COMMA args { Comma ($1, $3) }
55   - | one { $1 }
56   - ;
  62 + | arg COMMA args { Comma($1, $3) }
  63 + | arg { $1 }
  64 +;
57 65
58 66 one:
59 67 | STRING { debug "STRING(%s)" $1; String $1 }
@@ -76,7 +84,7 @@
76 84 ;
77 85
78 86 rule:
79   - | PROP exprs SEMI { debug "COLON"; Rule (String $1, $2) }
  87 + | PROP exprs SEMI { debug "RULE(%s)" $1; Rule (String $1, $2) }
80 88 | DOLLAR SEMI { debug "DOLLAR(%s)" $1; Ant (Cass_location.get (), $1) }
81 89 ;
82 90
@@ -86,7 +94,7 @@
86 94 ;
87 95
88 96 decl:
89   - | exprs OPEN rules CLOSE { debug "COLON"; Decl ($1, $3) }
  97 + | exprs OPEN rules CLOSE { debug "DECL"; Decl ($1, $3) }
90 98 | DOLLAR { debug "DOLLAR(%s)" $1; Ant (Cass_location.get (), $1) }
91 99 ;
92 100
2  cass_quotations.ml
@@ -22,6 +22,8 @@ module AQ = Syntax.AntiquotSyntax
22 22 let destruct_aq s =
23 23 try
24 24 let pos = String.index s ':' in
  25 + let space = String.index s ' ' in
  26 + if space < pos then raise Not_found;
25 27 let len = String.length s in
26 28 let name = String.sub s 0 pos
27 29 and code = String.sub s (pos + 1) (len - pos - 1) in
143 css.ml
@@ -14,88 +14,87 @@
14 14 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15 15 *)
16 16
17   -type t =
18   - | String of string
19   - | Decl of t * t
20   - | Rule of t * t
21   - | Fun of t * t
22   - | Comma of t * t
23   - | Seq of t * t
24   - | Nil
  17 +module Css = struct
  18 + type t =
  19 + | String of string
  20 + | Decl of t * t
  21 + | Rule of t * t
  22 + | Fun of t * t
  23 + | Comma of t * t
  24 + | Seq of t * t
  25 + | Nil
25 26
26   -module Comma = struct
27   - let rec t_of_list = function
28   - | [] -> Nil
29   - | [e] -> e
30   - | e::es -> Comma (e, t_of_list es)
  27 + module Comma = struct
  28 + let rec t_of_list = function
  29 + | [] -> Nil
  30 + | [e] -> e
  31 + | e::es -> Comma (e, t_of_list es)
31 32
32   - let rec list_of_t x acc =
33   - match x with
34   - | Nil -> acc
35   - | Comma (e1, e2) -> list_of_t e1 (list_of_t e2 acc)
36   - | e -> e :: acc
37   -end
  33 + let rec list_of_t x acc =
  34 + match x with
  35 + | Nil -> acc
  36 + | Comma (e1, e2) -> list_of_t e1 (list_of_t e2 acc)
  37 + | e -> e :: acc
  38 + end
38 39
39   -module Seq = struct
40   - let rec t_of_list = function
41   - | [] -> Nil
42   - | [e] -> e
43   - | e::es -> Seq (e, t_of_list es)
  40 + module Seq = struct
  41 + let rec t_of_list = function
  42 + | [] -> Nil
  43 + | [e] -> e
  44 + | e::es -> Seq (e, t_of_list es)
44 45
45   - let rec list_of_t x acc =
46   - match x with
47   - | Nil -> acc
48   - | Seq (e1, e2) -> list_of_t e1 (list_of_t e2 acc)
49   - | e -> e :: acc
50   -end
  46 + let rec list_of_t x acc =
  47 + match x with
  48 + | Nil -> acc
  49 + | Seq (e1, e2) -> list_of_t e1 (list_of_t e2 acc)
  50 + | e -> e :: acc
  51 + end
51 52
52   -open Printf
53   -open Format
  53 + open Printf
  54 + open Format
54 55
55   -(* XXX: fix the formatter *)
56   -let rec t ppf = function
57   - | String s -> fprintf ppf "%s" s
58   - | Decl (t1, t2) -> fprintf ppf "%a {\n%a}\n" t t1 t t2
59   - | Rule (t1, t2) -> fprintf ppf "\t%a: %a;\n" t t1 t t2
60   - | Fun (t1, t2) -> fprintf ppf "%a(%a)" t t1 t t2
  56 + (* XXX: fix the formatter *)
  57 + let rec t ppf = function
  58 + | String s -> fprintf ppf "%s" s
  59 + | Decl (t1, t2) -> fprintf ppf "%a {\n%a}\n" t t1 t t2
  60 + | Rule (t1, t2) -> fprintf ppf "\t%a: %a;\n" t t1 t t2
  61 + | Fun (t1, t2) -> fprintf ppf "%a(%a)" t t1 t t2
61 62
62   - | Comma (t1, Nil) -> t ppf t1
63   - | Comma (t1, t2) -> fprintf ppf "%a, %a" t t1 t t2
  63 + | Comma (t1, Nil) -> t ppf t1
  64 + | Comma (t1, t2) -> fprintf ppf "%a, %a" t t1 t t2
64 65
65   - | Seq (t1, Nil) -> t ppf t1
66   - | Seq (t1, t2) -> fprintf ppf "%a %a" t t1 t t2
  66 + | Seq (t1, Nil) -> t ppf t1
  67 + | Seq (t1, t2) -> fprintf ppf "%a %a" t t1 t t2
67 68
68   - | Nil -> ()
  69 + | Nil -> ()
  70 +
  71 + let to_string t1 =
  72 + t str_formatter t1;
  73 + flush_str_formatter ()
  74 +end
69 75
70   -let to_string t1 =
71   - t str_formatter t1;
72   - flush_str_formatter ()
  76 +open Css
73 77
74 78 (* From http://www.webdesignerwall.com/tutorials/cross-browser-css-gradient/ *)
75   -let gradient ~default ~low ~high =
76   - let rule p k = Rule (String p, k) in
77   - let rules = [
78   - rule "background" default; (* for non-css3 browsers *)
79   - rule "filter"
80   - (Fun
81   - (String "progid:DXImageTransform.Microsoft.gradient",
82   - Comma( Seq(String "startColorstr=", high),
83   - Seq(String "endColorstr=", low)))); (* for IE *)
84   -
85   - rule "background"
86   - (Fun (String "-webkit-gradient",
87   - Comma.t_of_list
88   - [ String "linear";
89   - Seq (String "left", String "top");
90   - Seq (String "left", String "bottom");
91   - Fun (String "from", high);
92   - Fun (String "to", low)])); (* for webkit browsers *)
  79 +let gradient ~(low : t) ~(high : t) : t =
  80 + let r = <:css<
  81 + background: $low$; /* for non-css3 browsers */
  82 + filter: progid:DXImageTransform.Microsoft.gradient(startColorstr=$high$, endColorstr=$low$); /* for IE */
  83 + background: -webkit-gradient(linear, left top, left bottom, from($high$), to($low$)); /* for webkit browsers */
  84 + background: -moz-linear-gradient(top, $high$, $low$); /* for firefox 3.6+ */
  85 + >> in
  86 +
  87 +Printf.eprintf "[GRADIENT]: %s\n" (to_string r); r
93 88
94   - rule "background"
95   - (Fun (String "-moz-linear-gradient",
96   - Comma.t_of_list
97   - [ String "top";
98   - high;
99   - low ])); (* for firefox 3.6+ *)
100   - ] in
101   - Seq.t_of_list rules
  89 +let rounded : t =
  90 + <:css<
  91 + text-shadow: 0 1px 1px rgba(0,0,0,.3);
  92 + -webkit-border-radius: .5em;
  93 + -moz-border-radius: .5em;
  94 + border-radius: .5em;
  95 + -webkit-box-shadow: 0 1px 2px rgba(0,0,0,.2);
  96 + -moz-box-shadow: 0 1px 2px rgba(0,0,0,.2);
  97 + box-shadow: 0 1px 2px rgba(0,0,0,.2);
  98 + >>
  99 +
  100 +include Css
4 test.ml
@@ -9,8 +9,8 @@ let props = <:css<
9 9 let c2 = <:css<
10 10 body { $props$;
11 11 font: "helvetica neue", "helvetica", "arial", sans-serif;
12   - $Css.gradient color1 color1 color2$;
13   -}
  12 + $Css.gradient ~low:color1 ~high:color2$;
  13 + }
14 14 >>
15 15
16 16 let s = Css.to_string c2

0 comments on commit 4f290be

Please sign in to comment.
Something went wrong with that request. Please try again.