Initial commit

META

@@ -0,0 +1,8 @@
+name = "cass"
+version = "0.1"
+description = "Caml Style Sheets"
+requires = "camlp4,camlp4.lib"
+archive(byte) = "cass.cma"
+archive(native) = "cass.cmxa"
+archive(syntax, toploop) = "cass.cma,cass_top.cmo"
+archive(syntax, preprocessor) = "cass.cma"

Makefile

@@ -0,0 +1,38 @@
+FILES=\
+cass.cmxa cass.cma \
+cass_ast.mli cass_ast.cmi cass_ast.cmx \
+cass_parser.mli cass_parser.cmi cass_parser.cmx \
+cass_printer.mli cass_printer.cmi cass_printer.cmx \
+cass_quotations.cmi cass_quotations.cmx \
+cass_top.cmo
+
+BFILES=$(addprefix _build/,$(FILES))
+
+STUFF=$(shell ocamlfind query cass -r -format "-I %d %a" -predicates byte)
+
+all:
+	ocamlbuild cass.cma cass_top.cmo cass.cmxa
+
+install:
+	ocamlfind install cass META $(BFILES)
+
+uninstall:
+	ocamlfind remove cass
+
+clean:
+	ocamlbuild -clean
+	rm -rf test.exp test.cmo test.cmx test.cmi test.o
+
+#test.byte: XXX cannot make it work...
+#	 :ocamlbuild test.byte
+test:
+	(ocamlc -pp 'camlp4o _build/cass.cma' $(STUFF) test.ml -o _build/test || rm -rf test.cmx test.cmi) && \
+	rm -f test.cmx test.cmi && \
+	_build/test
+
+test.exp: test.ml
+	camlp4of _build/cass.cma test.ml -printer o > test.exp
+
+debug: all
+	camlp4of _build/cass.cma test.ml
+

_tags

@@ -0,0 +1,5 @@
+<cass_ast.ml*>: pkg_camlp4
+<cass_parser.ml*>: syntax_camlp4o,pkg_camlp4.extend
+<cass_quotations.ml*>: syntax_camlp4o,pkg_camlp4.quotations
+<cass_ast.ml*>: syntax_camlp4o,pkg_camlp4.quotations
+<test.ml>: syntax_camlp4o,pkg_cass

cass.mllib

@@ -0,0 +1,4 @@
+Cass_ast
+Cass_parser
+Cass_printer
+Cass_quotations

cass_ast.ml

@@ -0,0 +1,89 @@
+open Camlp4.PreCast (* for Ast refs in generated code *)
+
+(*
+  | Hash of string
+  | Function of string * any
+*)
+
+type t =
+  | String of string
+  | Number of float
+  | Dim of float * string
+
+  | Percent of float
+  | Div of t * t
+
+  | Colon
+  | Prop of string * t
+
+  | Bracket of t
+  | Square of t
+  | Curly of t * t
+
+  | Semi of t * t
+  | Comma of t * t
+  | Seq of t * t
+  | Nil
+
+  | Ant of Loc.t * string
+
+let rec meta_t _loc = function
+  | String s  -> <:expr< Cass_ast.String $`str:s$ >>
+  | Number f  -> <:expr< Cass_ast.Number $`flo:f$ >>
+  | Dim (f,s) -> <:expr< Cass_ast.Dim ($`flo:f$, $`str:s$) >>
+
+  | Percent f  -> <:expr< Cass_ast.Percent $`flo:f$ >>
+  | Div (t1,t2) -> <:expr< Cass_ast.Div ($meta_t _loc t1$, $meta_t _loc t2$) >>
+
+  | Colon      -> <:expr< Cass_ast.Colon >>
+  | Prop (s,t) -> <:expr< Cass_ast.Prop ($`str:s$, $meta_t _loc t$) >>
+
+  | Bracket t   -> <:expr< Cass_ast.Bracket $meta_t _loc t$ >>
+  | Square t    -> <:expr< Cass_ast.Square $meta_t _loc t$ >>
+  | Curly (n,t) -> <:expr< Cass_ast.Curly ($meta_t _loc n$, $meta_t _loc t$) >>
+
+  | Semi (a,b)  -> <:expr< Cass_ast.Semi ($meta_t _loc a$, $meta_t _loc b$) >>
+  | Comma (a,b) -> <:expr< Cass_ast.Comma ($meta_t _loc a$, $meta_t _loc b$) >>
+  | Seq (a,b)   -> <:expr< Cass_ast.Seq ($meta_t _loc a$, $meta_t _loc b$) >> 
+  | Nil         -> <:expr< Cass_ast.Nil >>
+
+  | Ant (l, str) -> Ast.ExAnt (l, str)
+
+module Comma = struct
+  let rec t_of_list = function
+    | [] -> Nil
+    | [e] -> e
+    | e::es -> Comma (e, t_of_list es)
+
+  let rec list_of_t x acc =
+    match x with
+    | Nil -> acc
+    | Comma (e1, e2) -> list_of_t e1 (list_of_t e2 acc)
+    | e -> e :: acc
+end
+
+module Semi = struct
+  let rec t_of_list = function
+    | [] -> Nil
+    | [e] -> e
+    | e::es -> Semi (e, t_of_list es)
+
+  let rec list_of_t x acc =
+    match x with
+    | Nil -> acc
+    | Semi (e1, e2) -> list_of_t e1 (list_of_t e2 acc)
+    | e -> e :: acc
+end
+
+module Seq = struct
+  let rec t_of_list = function
+    | [] -> Nil
+    | [e] -> e
+    | e::es -> Seq (e, t_of_list es)
+
+  let rec list_of_t x acc =
+    match x with
+    | Nil -> acc
+    | Seq (e1, e2) -> list_of_t e1 (list_of_t e2 acc)
+    | e -> e :: acc
+end

cass_ast.mli

@@ -0,0 +1,40 @@
+open Camlp4.PreCast
+
+type t =
+  | String of string
+  | Number of float
+  | Dim of float * string
+
+  | Percent of float
+  | Div of t * t
+
+  | Colon
+  | Prop of string * t
+
+  | Bracket of t
+  | Square of t
+  | Curly of t * t
+
+  | Semi of t * t
+  | Comma of t * t
+  | Seq of t * t
+  | Nil
+
+  | Ant of Loc.t * string
+
+val meta_t : Ast.loc -> t -> Ast.expr
+
+module Comma : sig
+  val t_of_list : t list -> t
+  val list_of_t : t -> t list -> t list
+end
+
+module Semi : sig
+  val t_of_list : t list -> t
+  val list_of_t : t -> t list -> t list
+end
+
+module Seq : sig
+  val t_of_list : t list -> t
+  val list_of_t : t -> t list -> t list
+end

cass_parser.ml

@@ -0,0 +1,64 @@
+open Camlp4.PreCast
+open Cass_ast
+
+module Gram = MakeGram(Lexer)
+
+let cass_eoi = Gram.Entry.mk "cass_eoi"
+
+let parse_cass_eoi loc s = Gram.parse_string cass_eoi loc s
+
+let debug = ref false
+
+let debug (fmt: ('a , unit, string, unit) format4) =
+	if !debug then
+		Printf.kprintf (fun s -> print_string s) fmt
+	else
+		Printf.kprintf (fun s -> ()) fmt
+
+
+EXTEND Gram
+  GLOBAL: cass_eoi;
+
+  str: [[
+	  s = LIDENT    -> debug "LIDENT(%s) " s; s
+	| s = UIDENT    -> debug "UIDENT(%s) " s; s
+	| "-"; s = SELF -> debug "-(%s) " s; "-" ^ s
+	| "#"; s = SELF -> debug "#(%s) " s; "#" ^ s
+    | s1 = SELF; "-"; s2 = SELF -> debug "(%s-%s) " s1 s2; s1 ^ s2
+    | s = STRING    -> debug "STRING(%S) " s; "\"" ^ s ^ "\""
+  ]];
+
+  number: [[
+      i = INT   -> debug "INT(%s) " i; float_of_string i
+    | f = FLOAT -> debug "FLOAT(%s) " f; float_of_string f
+ ]];
+
+  cass_seq: [[
+      hd = cass ->  hd
+    | hd = cass ; tl = SELF -> debug "SEQ "; Seq (hd, tl)
+  ]];
+
+  cass: [[
+      s = str -> String s
+
+    | n = number; "%"      -> debug "PERCENT(%g) " n; Percent n
+    | s = number ; d = str -> debug "DIM(%g%s) " s d; Dim (s, d)
+    | n = number           -> Number n
+
+    | ":"                         -> debug "COLON "; Colon
+    | s = str; ":" ; e = cass_seq -> debug "PROP "; Prop (s, e)
+
+    | "["; es = SELF; "]" -> debug "SQUARE "; Square es
+    | e1 = SELF; "{"; e2 = SELF; "}" -> debug "CURLY "; Curly (e1, e2)
+    | "("; es = SELF; ")" -> debug "EXPR "; Bracket es
+
+    | e1 = SELF; ";"; e2 = SELF -> debug "SEMI "; Semi (e1, e2)
+    | e1 = SELF; ";"            -> debug "SEMI "; Semi (e1, Nil)
+    | e1 = SELF; ","; e2 = SELF -> debug "COMMA "; Comma (e1, e2)
+
+    | `ANTIQUOT (""|"int"|"flo"|"str"|"list"|"alist" as n, s) ->
+        debug "ANTI(%s,%s) " n s; Ant (_loc, n ^ ":" ^ s)
+  ]];
+
+  cass_eoi: [[ x = cass; EOI -> debug "\n"; x ]];
+END

cass_parser.mli

@@ -0,0 +1 @@
+val parse_cass_eoi : Camlp4.PreCast.Ast.Loc.t -> string -> Cass_ast.t

cass_printer.ml

@@ -0,0 +1,36 @@
+open Format
+open Cass_ast
+
+let rec t_ ppf = function
+  | String s  -> fprintf ppf "%S" s
+  | Number n  -> fprintf ppf "%g" n
+  | Dim (f,d) -> fprintf ppf "%g%S" f d
+
+  | Percent f    -> fprintf ppf "%g%%" f
+  | Div (t1, t2) -> fprintf ppf "%a/@;<1 2>%a" t t1 t t2
+
+  | Colon        -> fprintf ppf ":"
+  | Prop (s, t') -> fprintf ppf "@[<h>%S@ :@ %a@]" s t t'
+
+  | Bracket t'     -> fprintf ppf "@[<hv>(@;<1 2>%a@ )@]" t t'
+  | Square t'      -> fprintf ppf "@[<hv>[@;<1 2>%a@ ]@]" t t'
+  | Curly (t1, t2) -> fprintf ppf "%a @[<hv>{@;<1 2>%a@ }@]" t t1 t t2
+
+  | Semi (t', Nil) -> t ppf t'
+  | Semi (t1, t2) -> fprintf ppf "%a;@;<1 2>%a" t t1 t t2
+
+  | Comma (t', Nil) -> t ppf t'
+  | Comma (t1, t2) -> fprintf ppf "%a,@;<1 2>%a" t t1 t t2
+
+  | Seq (t', Nil) -> t ppf t'
+  | Seq (t1, t2) -> fprintf ppf "%a @;<1 2>%a" t t1 t t2
+
+  | Nil -> ()
+
+  | Ant (_, s) -> fprintf ppf "$%s$" s
+
+and t ppf t = t_ ppf t (*t_of_list (list_of_t t [])*)
+
+let to_string t' =
+  t str_formatter t';
+  flush_str_formatter ()

cass_printer.mli

@@ -0,0 +1,2 @@
+val t : Format.formatter -> Cass_ast.t -> unit
+val to_string : Cass_ast.t -> string

cass_quotations.ml

@@ -0,0 +1,52 @@
+open Camlp4.PreCast
+
+module Q = Syntax.Quotation
+module AQ = Syntax.AntiquotSyntax
+
+let destruct_aq s =
+  let pos = String.index s ':' in
+  let len = String.length s in
+  let name = String.sub s 0 pos
+  and code = String.sub s (pos + 1) (len - pos - 1) in
+  name, code
+
+let aq_expander =
+object
+  inherit Ast.map as super
+  method expr =
+    function
+      | Ast.ExAnt (_loc, s) ->
+          let n, c = destruct_aq s in
+          let e = AQ.parse_expr _loc c in
+          begin match n with
+            | "int" -> <:expr< Cass_ast.Number (float_of_int $e$) >> (* e is an int *)
+            | "flo" -> <:expr< Cass_ast.Numner $e$ >> (* e is a float *)
+            | "str" -> <:expr< Cass_ast.String $e$ >> (* e is a string *)
+            | "list" -> <:expr< Cass_ast.Comma.t_of_list $e$ >> 
+            | "alist" -> <:expr< Cass_ast.Semi.t_of_list (List.map (fun (str,elt) -> Cass_ast.Colon (str, elt)) $e$) >> 
+            | _ -> e
+          end
+      | e -> super#expr e
+end
+
+let parse_quot_string loc s =
+  let q = !Camlp4_config.antiquotations in
+  Camlp4_config.antiquotations := true;
+  let res = Cass_parser.parse_cass_eoi loc s in
+  Camlp4_config.antiquotations := q;
+  res
+
+let expand_expr loc _ s =
+  let ast = parse_quot_string loc s in
+  let meta_ast = Cass_ast.meta_t loc ast in
+  aq_expander#expr meta_ast
+
+let expand_str_item loc _ s =
+  let exp_ast = expand_expr loc None s in
+  <:str_item@loc< $exp:exp_ast$ >>
+
+;;
+
+Q.add "css" Q.DynAst.expr_tag expand_expr;
+Q.add "css" Q.DynAst.str_item_tag expand_str_item;
+Q.default := "css"

cass_top.ml

@@ -0,0 +1,9 @@
+(* following Ocamlnet's netstring_top.ml *)
+
+let exec s =
+  let l = Lexing.from_string s in
+  let ph = !Toploop.parse_toplevel_phrase l in
+  assert(Toploop.execute_phrase false Format.err_formatter ph)
+;;
+
+exec "#install_printer Jq_printer.t;;";;