dtlc

dependently-typed lambda calculus toy
git clone git://git.rr3.xyz/dtlc
Log | Files | Refs | README | LICENSE

name.ml (1270B)


      1 let non_start
      2 : char -> bool
      3 = fun c -> false 
      4 	|| ('0' <= c && c <= '9')
      5 	|| c = '\''
      6 	|| c = '"'
      7 
      8 let non_cont
      9 : char -> bool
     10 = fun c -> false
     11 	|| c < '\''
     12 	|| ('\'' < c && c < '0')
     13 	|| ('9' < c && c < 'A')
     14 	|| ('Z' < c && c < '_')
     15 	|| ('z' < c && c < '\x7F')
     16 
     17 module Var = struct
     18 	type var = Of of string
     19 	type t = var
     20 
     21 	module Ord = struct
     22 		type t = var
     23 		let compare (Of x) (Of y) = String.compare x y
     24 	end
     25 
     26 	module Map = Map.Make(Ord)
     27 
     28 	module Set = Set.Make(Ord)
     29 
     30 	let requires_quotes
     31 	: var -> bool
     32 	= fun (Of s) -> false
     33 		|| String.length s = 0
     34 		|| non_start s.[0]
     35 		|| String.exists non_cont s
     36 
     37 	let pp_print
     38 	: Format.formatter -> var -> unit
     39 	= fun ppf (Of s as name) ->
     40 		if requires_quotes name then
     41 			Format.fprintf ppf "`%s`" s
     42 		else
     43 			Format.fprintf ppf "%s" s
     44 end
     45 
     46 module Tag = struct
     47 	type tag = Of of string
     48 	type t = tag
     49 
     50 	module Ord = struct
     51 		type t = tag
     52 		let compare (Of x) (Of y) = String.compare x y
     53 	end
     54 		
     55 	module Map = Map.Make(Ord)
     56 
     57 	let requires_quotes
     58 	: tag -> bool
     59 	= fun (Of s) -> false
     60 		|| String.length s = 0
     61 		|| String.exists non_cont s
     62 
     63 	let pp_print
     64 	: Format.formatter -> tag -> unit
     65 	= fun ppf (Of s as name) ->
     66 		if requires_quotes name then
     67 			Format.fprintf ppf "%@`%s`" s
     68 		else
     69 			Format.fprintf ppf "%@%s" s
     70 end