Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

226 lines (189 sloc) 6.922 kB
(*
Copyright © 2011 MLstate
This file is part of OPA.
OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.
OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.
You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
(* CF mli *)
module Char = BaseChar
module String = BaseString
type uniq = Fresh.t_fresh
type t =
| Source of string
| FakeSource of string
(* like source, except that
* they can be 'renamed' (to_string can do operations on them)
* because they won't ever be used to refer to external identifiers
* (like "Pervasives") *)
| Internal of uniq
type t' = t
(** compare : uniqs and strings are comparable with Pervasives *)
let compare i1 i2 =
match i1,i2 with
| Source s1, Source s2 -> compare s1 s2
| Source _, _ -> -1
| _, Source _ -> 1
| FakeSource s1, FakeSource s2 -> compare s1 s2
| FakeSource _, _ -> -1
| _, FakeSource _ -> 1
| Internal (i1,_,_,package1), Internal (i2,_,_,package2) ->
(match compare i1 i2 with
| 0 -> String.compare package1 package2
| c -> c)
let equal x y =
match x, y with
| Source s1, Source s2 -> s1 = s2
| FakeSource s1, FakeSource s2 -> s1 = s2
| Internal (i1,_,_,package1), Internal (i2,_,_,package2) ->
i1 = i2 && package1 = package2
| _ -> false
let hash = function
| Source s -> Hashtbl.hash s
| FakeSource s -> Hashtbl.hash s
| Internal (i, _, _, package) -> Hashtbl.hash i + Hashtbl.hash package
module IHashtbl = Hashtbl.Make (struct type t = t' let hash = hash let equal = equal end)
let _alpha_protection = ref false
let active_alpha_protection () = _alpha_protection := true
let source x =
if !_alpha_protection
then assert false (* [ qml_Ast.ml; #54190 ] no source allowed after an alpha conv *)
else Source x
let fake_source x = FakeSource x
let pattern = "^\\(\\([-+^@!&]+[-.+^*/<>=&|]*\\)\\|\\([*/<>=]+[-.+^*/<>=&|]*\\)\\|\\([|][-.+^*/<>=&|]+\\)\\)$"
let regexp = Str.regexp pattern
let is_operator_string s =
(* the regexp was taken from libqmlcompil/qmlMainParser/qmlMainParser.trx -- but is now desynchronized
it's be better to have something simpler, like:
match s.[0] with '_' | 'a'..'z' | 'A'..'Z' -> false | _ -> true
but the main point is the synchronisation with the parser (printed code should reparse) *)
Str.string_match regexp s 0
let is_operator = function
| Source s -> is_operator_string s
| _ -> false
let maybe_digest n =
let digest s = String.sub (Digest.to_hex (Digest.string s)) 0 8 in
if Base.String.is_word n && not (is_operator_string n) then n else digest n
let print id n d =
Printf.sprintf "_v%d_%s%s%s" id n (if d = "" then "" else "_") d
let original_name = function
| FakeSource n
| Source n -> n
| Internal (_, _, n, _) -> n
let start_with_n_underscore s =
let i = ref 0 in
let n = String.length s in
while !i < n && s.[!i] = '_' do incr i done;
!i
let renaming_should_warn_when i =
let s = original_name i in
(* not warning on xmlns: it is a bit hacky, we should be able
* to say that we don't want warnings for a specific ident instead *)
if String.is_prefix "xmlns:" s then
`never
else
match start_with_n_underscore s with
| 0 -> `unused
| 1 -> `used
| _ -> `never
(** see note *)
let to_string =
#<If:TESTING>
original_name (* making sure we don't have _v34_f in tests refs *)
#<Else>
function
| FakeSource n
| Source n -> if Base.String.is_word n || is_operator_string n then n else "`" ^ n ^ "`"
| Internal (_, id, n, d) ->
let n = print id n d in
if Base.String.is_word n then n else "`" ^ n ^ "`"
#<End>
let opa_syntax ?(dont_protect_operator=false) id =
#<If:TESTING>
original_name id (* making sure we don't have _v34_f in tests refs *)
#<Else>
let n =
match id with
| FakeSource n
| Source n -> n
| Internal (_, id, n, d) -> print id n d
in
if Base.String.is_word n || (dont_protect_operator && is_operator_string n)
then n else "`" ^ n ^ "`"
#<End>
let to_uniq_string = function
| FakeSource _
| Source _ -> assert false
| Internal (_, id, n, d) -> print id n d
(** Fixed : don't allow anonymous internal *)
(** /!\ Keep the name of ident safe for qml, and ocaml generation (it would break compilers) *)
let next =
let get = Fresh.fresh_named_factory (fun i -> i) in
fun ?(filename="") ?(descr="") n ->
(* the description need to contain the package name for separate compilation *)
let descr = (* TODO: remove this check once s2 is removed *)
if ObjectFiles.Arg.is_separated () then
ObjectFiles.get_current_package_name ()
else
filename ^ descr in
let fresh = get ~name:n ~descr () in
Internal fresh
let get_package_name = function
| Internal (_,_,_,d) -> d
| FakeSource s
| Source s -> Base.invalid_argf "Ident.get_package_name: %s" s
let safe_get_package_name = function
| Internal (_,_,_,d) -> Some d
| FakeSource _
| Source _ -> None
let nextf = fun ?filename ?descr fmt -> Printf.ksprintf (next ?filename ?descr) fmt
let escape =
let valid_chars = function
| '_'
| 'a'..'z'
| 'A'..'Z'
| '0'..'9' -> true | _ -> false in
let escape_char = '\'' in
String.escape ~valid_chars ~escape_char
(** BIG BIG warning : do not print ` in function stident used in libconvert !
or some ident will have really ` in it *)
let stident = function
| Source n -> n
| FakeSource n -> "s"^escape n
| Internal (_, id, n, d) -> print id (maybe_digest n) (maybe_digest d)
let memo_stident = IHashtbl.create 1024
let stident id =
try
IHashtbl.find memo_stident id
with
| Not_found ->
let s = stident id in
IHashtbl.add memo_stident id s ;
s
let refresh ?(map=fun s -> s) y =
match y with
| Source n -> next (map n)
| FakeSource s -> next (map s)
| Internal (_, _, n, d) -> next ~descr:d (map n)
let refreshf ~map y = refresh ~map:(Printf.sprintf map) y
let concrete_string = function
| Source n -> Printf.sprintf "Source(%s)" n
| FakeSource s -> Printf.sprintf "FakeSource(%s)" s
| Internal (argh, i, n, d) -> Printf.sprintf "Internal(%d, %d, %s , %s)" argh i n d
let light_ident = function
| FakeSource n
| Source n -> n
| Internal (_, id, n, _) -> Printf.sprintf "_v%d_%s" id n
let is_universal_ident s =
(String.length s > 0)
&& not (Char.is_digit s.[0])
&& (
let valid c = Char.is_alpha c || Char.is_digit c || c = '_' in
String.for_all valid s
)
Jump to Line
Something went wrong with that request. Please try again.