109 lines
		
	
	
		
			3 KiB
		
	
	
	
		
			OCaml
		
	
	
	
	
	
		
		
			
		
	
	
			109 lines
		
	
	
		
			3 KiB
		
	
	
	
		
			OCaml
		
	
	
	
	
	
|   | (*
 | ||
|  |  * Copyright (c) 1997-1999 Massachusetts Institute of Technology | ||
|  |  * Copyright (c) 2003, 2007-14 Matteo Frigo | ||
|  |  * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology | ||
|  |  * | ||
|  |  * This program is free software; you can redistribute it and/or modify | ||
|  |  * it under the terms of the GNU General Public License as published by | ||
|  |  * the Free Software Foundation; either version 2 of the License, or | ||
|  |  * (at your option) any later version. | ||
|  |  * | ||
|  |  * This program 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 General Public License for more details. | ||
|  |  * | ||
|  |  * You should have received a copy of the GNU General Public License | ||
|  |  * along with this program; if not, write to the Free Software | ||
|  |  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA | ||
|  |  * | ||
|  |  *) | ||
|  | 
 | ||
|  | type variable =  | ||
|  |       (* temporary variables generated automatically *) | ||
|  |   | Temporary of int | ||
|  |       (* memory locations, e.g., array elements *) | ||
|  |   | Locative of (Unique.unique * Unique.unique * | ||
|  | 		   (int -> string) * int * string) | ||
|  |       (* constant values, e.g., twiddle factors *) | ||
|  |   | Constant of (Unique.unique * string) | ||
|  | 
 | ||
|  | let hash v = Hashtbl.hash v | ||
|  | 
 | ||
|  | let same a b = (a == b) | ||
|  | 
 | ||
|  | let is_constant = function | ||
|  |   | Constant _ -> true | ||
|  |   | _ -> false | ||
|  | 
 | ||
|  | let is_temporary = function | ||
|  |   | Temporary _ -> true | ||
|  |   | _ -> false | ||
|  | 
 | ||
|  | let is_locative = function | ||
|  |   | Locative _ -> true | ||
|  |   | _ -> false | ||
|  | 
 | ||
|  | let same_location a b =  | ||
|  |   match (a, b) with | ||
|  |   | (Locative (location_a, _, _, _, _), Locative (location_b, _, _, _, _)) -> | ||
|  |       Unique.same location_a location_b | ||
|  |   | _ -> false | ||
|  | 
 | ||
|  | let same_class a b =  | ||
|  |   match (a, b) with | ||
|  |   | (Locative (_, class_a, _, _, _), Locative (_, class_b, _, _, _)) -> | ||
|  |       Unique.same class_a class_b | ||
|  |   | (Constant (class_a, _), Constant (class_b, _)) -> | ||
|  |       Unique.same class_a class_b | ||
|  |   | _ -> false | ||
|  | 
 | ||
|  | let make_temporary = | ||
|  |   let tmp_count = ref 0 | ||
|  |   in fun () -> begin | ||
|  |     tmp_count := !tmp_count + 1; | ||
|  |     Temporary !tmp_count | ||
|  |   end | ||
|  | 
 | ||
|  | let make_constant class_token name =  | ||
|  |   Constant (class_token, name) | ||
|  | 
 | ||
|  | let make_locative location_token class_token name i vs = | ||
|  |   Locative (location_token, class_token, name, i, vs) | ||
|  | 
 | ||
|  | let vstride_of_locative = function | ||
|  |   | Locative (_, _, _, _, vs) -> vs | ||
|  |   | _ -> failwith "vstride_of_locative" | ||
|  | 
 | ||
|  | (* special naming conventions for variables *) | ||
|  | let rec base62_of_int k =  | ||
|  |   let x = k mod 62  | ||
|  |   and y = k / 62 in | ||
|  |   let c =  | ||
|  |     if x < 10 then  | ||
|  |       Char.chr (x + Char.code '0') | ||
|  |     else if x < 36 then | ||
|  |       Char.chr (x + Char.code 'a' - 10) | ||
|  |     else  | ||
|  |       Char.chr (x + Char.code 'A' - 36) | ||
|  |   in | ||
|  |   let s = String.make 1 c in | ||
|  |   let r = if y == 0 then "" else base62_of_int y in | ||
|  |   r ^ s | ||
|  | 
 | ||
|  | let varname_of_int k = | ||
|  |   if !Magic.compact then | ||
|  |     base62_of_int k | ||
|  |   else | ||
|  |     string_of_int k | ||
|  | 
 | ||
|  | let unparse = function | ||
|  |   | Temporary k -> "T" ^ (varname_of_int k) | ||
|  |   | Constant (_, name) -> name | ||
|  |   | Locative (_, _, name, i, _) -> name i | ||
|  | 
 | ||
|  | let unparse_for_alignment m = function | ||
|  |   | Locative (_, _, name, i, _) -> name (i mod m) | ||
|  |   | _ -> failwith "unparse_for_alignment" | ||
|  | 
 |