diff options
| author | Pierre Weis <Pierre.Weis@inria.fr> | 2013-05-29 18:05:44 +0000 |
|---|---|---|
| committer | Pierre Weis <Pierre.Weis@inria.fr> | 2013-05-29 18:05:44 +0000 |
| commit | 1673c623b5eefc817e8c66b07ca295e8ecfa474c (patch) | |
| tree | 4acf06f56e5f77e1e6eb1e4b5614346af4a5ad7a /otherlibs/labltk | |
| parent | 626c696aeea1b4c4d8dbf7ff3bd9c170e8f4f752 (diff) | |
Wrong quoting chase.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13718 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'otherlibs/labltk')
| -rw-r--r-- | otherlibs/labltk/compiler/printer.ml | 80 |
1 files changed, 48 insertions, 32 deletions
diff --git a/otherlibs/labltk/compiler/printer.ml b/otherlibs/labltk/compiler/printer.ml index fe33ada36..e8bfeaa1f 100644 --- a/otherlibs/labltk/compiler/printer.ml +++ b/otherlibs/labltk/compiler/printer.ml @@ -22,7 +22,7 @@ let escape_string s = let more = ref 0 in for i = 0 to String.length s - 1 do match s.[i] with - | '\\' | '"' -> incr more + | '\\' | '\"' | '\'' -> incr more | _ -> () done; if !more = 0 then s else @@ -31,45 +31,52 @@ let escape_string s = for i = 0 to String.length s - 1 do let c = s.[i] in match c with - | '\\' | '"' -> res.[!j] <- '\\'; incr j; res.[!j] <- c; incr j + | '\\' | '\"' |'\'' -> res.[!j] <- '\\'; incr j; res.[!j] <- c; incr j | _ -> res.[!j] <- c; incr j done; - res;; + res +;; -let escape_char c = if c = '\'' then "\\'" else String.make 1 c;; +let escape_char c = if c = '\'' then "\\\'" else String.make 1 c;; let print_quoted_string s = printf "\"%s\"" (escape_string s);; -let print_quoted_char c = printf "'%s'" (escape_char c);; +let print_quoted_char c = printf "\'%s\'" (escape_char c);; let print_quoted_int i = - if i < 0 then printf "(%d)" i else printf "%d" i;; + if i < 0 then printf "(%d)" i else printf "%d" i +;; let print_quoted_float f = - if f <= 0.0 then printf "(%f)" f else printf "%f" f;; + if f <= 0.0 then printf "(%f)" f else printf "%f" f +;; (* Iterators *) let print_list f l = - printf "@[<1>["; - let rec pl = function - | [] -> printf "@;<0 -1>]@]" - | [x] -> f x; pl [] - | x :: xs -> f x; printf ";@ "; pl xs in - pl l;; + printf "@[<1>["; + let rec pl = function + | [] -> printf "@;<0 -1>]@]" + | [x] -> f x; pl [] + | x :: xs -> f x; printf ";@ "; pl xs in + pl l +;; let print_array f v = - printf "@[<2>[|"; - let l = Array.length v in - if l >= 1 then f v.(0); - if l >= 2 then - for i = 1 to l - 1 do - printf ";@ "; f v.(i) - done; - printf "@;<0 -1>|]@]";; + printf "@[<2>[|"; + let l = Array.length v in + if l >= 1 then f v.(0); + if l >= 2 then + for i = 1 to l - 1 do + printf ";@ "; f v.(i) + done; + printf "@;<0 -1>|]@]" +;; let print_option f = function | None -> print_string "None" - | Some x -> printf "@[<1>Some@ "; f x; printf "@]";; + | Some x -> printf "@[<1>Some@ "; f x; printf "@]" +;; let print_bool = function - | true -> print_string "true" | _ -> print_string "false";; + | true -> print_string "true" | _ -> print_string "false" +;; let print_poly x = print_string "<poly>";; @@ -97,7 +104,8 @@ let rec print_mltype = function printf "@[<1>(%s@ " "Function"; print_mltype m; printf ")@]" | As (m, s) -> printf "@[<1>(%s@ " "As"; printf "@[<1>("; print_mltype m; printf ",@ "; - print_quoted_string s; printf ")@]"; printf ")@]";; + print_quoted_string s; printf ")@]"; printf ")@]" +;; let rec print_template = function | StringArg s -> @@ -111,12 +119,14 @@ let rec print_template = function | OptionalArgs (s, l_t, l_t0) -> printf "@[<1>(%s@ " "OptionalArgs"; printf "@[<1>("; print_quoted_string s; printf ",@ "; print_list print_template l_t; - printf ",@ "; print_list print_template l_t0; printf ")@]"; printf ")@]";; + printf ",@ "; print_list print_template l_t0; printf ")@]"; printf ")@]" +;; (* Sorts of components *) let rec print_component_type = function | Constructor -> printf "Constructor" | Command -> printf "Command" - | External -> printf "External";; + | External -> printf "External" +;; (* Full definition of a component *) let rec print_fullcomponent = function @@ -128,13 +138,15 @@ let rec print_fullcomponent = function printf ";@]@ "; printf "@[<1>var_name =@ "; print_quoted_string s0; printf ";@]@ "; printf "@[<1>template =@ "; print_template t; printf ";@]@ "; printf "@[<1>result =@ "; print_mltype m; printf ";@]@ "; - printf "@[<1>safe =@ "; print_bool b; printf ";@]@ "; printf "@,}@]";; + printf "@[<1>safe =@ "; print_bool b; printf ";@]@ "; printf "@,}@]" +;; (* components are given either in full or abbreviated *) let rec print_component = function | Full f -> printf "@[<1>(%s@ " "Full"; print_fullcomponent f; printf ")@]" | Abbrev s -> - printf "@[<1>(%s@ " "Abbrev"; print_quoted_string s; printf ")@]";; + printf "@[<1>(%s@ " "Abbrev"; print_quoted_string s; printf ")@]" +;; (* A type definition *) (* @@ -142,7 +154,8 @@ let rec print_component = function an additional argument of type Widget. *) let rec print_parser_arity = function - | OneToken -> printf "OneToken" | MultipleToken -> printf "MultipleToken";; + | OneToken -> printf "OneToken" | MultipleToken -> printf "MultipleToken" +;; let rec print_type_def = function {parser_arity = p; constructors = l_f; subtypes = l_t_s_l_f; @@ -159,10 +172,12 @@ let rec print_type_def = function l_t_s_l_f; printf ";@]@ "; printf "@[<1>requires_widget_context =@ "; print_bool b; printf ";@]@ "; printf "@[<1>variant =@ "; print_bool b0; printf ";@]@ "; - printf "@,}@]";; + printf "@,}@]" +;; let rec print_module_type = function - | Widget -> printf "Widget" | Family -> printf "Family";; + | Widget -> printf "Widget" | Family -> printf "Family" +;; let rec print_module_def = function {module_type = m; commands = l_f; externals = l_f0; } -> @@ -170,4 +185,5 @@ let rec print_module_def = function printf ";@]@ "; printf "@[<1>commands =@ "; print_list print_fullcomponent l_f; printf ";@]@ "; printf "@[<1>externals =@ "; print_list print_fullcomponent l_f0; - printf ";@]@ "; printf "@,}@]";; + printf ";@]@ "; printf "@,}@]" +;; |