Permalink
Browse files

Initial commit

  • Loading branch information...
0 parents commit 82083cb55c4a71f36cdd7eb770349761fa9f4cfb Thomas Gazagnaire committed Oct 3, 2010
Showing with 451 additions and 0 deletions.
  1. +8 −0 META
  2. +38 −0 Makefile
  3. +5 −0 _tags
  4. +4 −0 cass.mllib
  5. +89 −0 cass_ast.ml
  6. +40 −0 cass_ast.mli
  7. +64 −0 cass_parser.ml
  8. +1 −0 cass_parser.mli
  9. +36 −0 cass_printer.ml
  10. +2 −0 cass_printer.mli
  11. +52 −0 cass_quotations.ml
  12. +9 −0 cass_top.ml
  13. +86 −0 myocamlbuild.ml
  14. +17 −0 test.ml
8 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"
@@ -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
+
5 _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
@@ -0,0 +1,4 @@
+Cass_ast
+Cass_parser
+Cass_printer
+Cass_quotations
@@ -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
@@ -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
@@ -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
@@ -0,0 +1 @@
+val parse_cass_eoi : Camlp4.PreCast.Ast.Loc.t -> string -> Cass_ast.t
@@ -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 ()
@@ -0,0 +1,2 @@
+val t : Format.formatter -> Cass_ast.t -> unit
+val to_string : Cass_ast.t -> string
@@ -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"
@@ -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;;";;
Oops, something went wrong.

0 comments on commit 82083cb

Please sign in to comment.