diff options
| author | Graydon Hoare <[email protected]> | 2010-07-27 19:21:51 -0700 |
|---|---|---|
| committer | Graydon Hoare <[email protected]> | 2010-07-27 19:21:51 -0700 |
| commit | 80307576245aabf00285db020bbfbc4c3a891766 (patch) | |
| tree | 7e408956ca3e895844dd30a1afddf64d83157da0 /src/boot | |
| parent | Calm some LLVM indigestion of last change. (diff) | |
| download | rust-80307576245aabf00285db020bbfbc4c3a891766.tar.xz rust-80307576245aabf00285db020bbfbc4c3a891766.zip | |
Switch machine-type lexemes to use suffixes. Remove support for foo(bar) as a cast notation. Closes #129.
Diffstat (limited to 'src/boot')
| -rw-r--r-- | src/boot/driver/main.ml | 1 | ||||
| -rw-r--r-- | src/boot/driver/session.ml | 3 | ||||
| -rw-r--r-- | src/boot/fe/ast.ml | 17 | ||||
| -rw-r--r-- | src/boot/fe/cexp.ml | 4 | ||||
| -rw-r--r-- | src/boot/fe/lexer.mll | 50 | ||||
| -rw-r--r-- | src/boot/fe/pexp.ml | 104 | ||||
| -rw-r--r-- | src/boot/fe/token.ml | 16 | ||||
| -rw-r--r-- | src/boot/llvm/lltrans.ml | 6 | ||||
| -rw-r--r-- | src/boot/me/semant.ml | 2 | ||||
| -rw-r--r-- | src/boot/me/trans.ml | 6 | ||||
| -rw-r--r-- | src/boot/me/type.ml | 2 |
11 files changed, 79 insertions, 132 deletions
diff --git a/src/boot/driver/main.ml b/src/boot/driver/main.ml index b9045485..9af7ee0b 100644 --- a/src/boot/driver/main.ml +++ b/src/boot/driver/main.ml @@ -50,6 +50,7 @@ let (sess:Session.sess) = Session.sess_log_obj = false; Session.sess_log_lib = false; Session.sess_log_out = stdout; + Session.sess_log_err = stderr; Session.sess_trace_block = false; Session.sess_trace_drop = false; Session.sess_trace_tag = false; diff --git a/src/boot/driver/session.ml b/src/boot/driver/session.ml index 210dd7be..d9e57b02 100644 --- a/src/boot/driver/session.ml +++ b/src/boot/driver/session.ml @@ -32,6 +32,7 @@ type sess = mutable sess_log_obj: bool; mutable sess_log_lib: bool; mutable sess_log_out: out_channel; + mutable sess_log_err: out_channel; mutable sess_trace_block: bool; mutable sess_trace_drop: bool; mutable sess_trace_tag: bool; @@ -79,7 +80,7 @@ let log name flag chan = let fail sess = sess.sess_failed <- true; - Printf.fprintf sess.sess_log_out + Printf.fprintf sess.sess_log_err ;; diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml index 767a6426..651b1e65 100644 --- a/src/boot/fe/ast.ml +++ b/src/boot/fe/ast.ml @@ -333,10 +333,11 @@ and expr = and lit = | LIT_nil | LIT_bool of bool - | LIT_mach of (ty_mach * int64 * string) - | LIT_int of (int64 * string) - | LIT_uint of (int64 * string) + | LIT_mach_int of (ty_mach * int64) + | LIT_int of int64 + | LIT_uint of int64 | LIT_char of int + (* FIXME: No support for LIT_mach_float or LIT_float yet. *) and lval_component = @@ -835,13 +836,15 @@ and fmt_lit (ff:Format.formatter) (l:lit) : unit = | LIT_nil -> fmt ff "()" | LIT_bool true -> fmt ff "true" | LIT_bool false -> fmt ff "false" - | LIT_mach (m, _, s) -> + | LIT_mach_int (m, i) -> begin + fmt ff "%Ld" i; fmt_mach ff m; - fmt ff "(%s)" s end - | LIT_int (_,s) -> fmt ff "%s" s - | LIT_uint (_,s) -> fmt ff "%s" s + | LIT_int i -> fmt ff "%Ld" i + | LIT_uint i -> + fmt ff "%Ld" i; + fmt ff "u" | LIT_char c -> fmt ff "'%s'" (Common.escaped_char c) and fmt_domain (ff:Format.formatter) (d:domain) : unit = diff --git a/src/boot/fe/cexp.ml b/src/boot/fe/cexp.ml index 5d3a99ef..fc849b28 100644 --- a/src/boot/fe/cexp.ml +++ b/src/boot/fe/cexp.ml @@ -527,7 +527,9 @@ and eval_pexp (env:env) (exp:Pexp.pexp) : pval = | Pexp.PEXP_lit (Ast.LIT_bool b) -> PVAL_bool b - | Pexp.PEXP_lit (Ast.LIT_int (i, _)) -> + | Pexp.PEXP_lit (Ast.LIT_int i) + | Pexp.PEXP_lit (Ast.LIT_uint i) + | Pexp.PEXP_lit (Ast.LIT_mach_int (_, i)) -> PVAL_num i | Pexp.PEXP_str s -> diff --git a/src/boot/fe/lexer.mll b/src/boot/fe/lexer.mll index 090da25f..bb1d881e 100644 --- a/src/boot/fe/lexer.mll +++ b/src/boot/fe/lexer.mll @@ -22,7 +22,24 @@ Lexing.pos_bol = p.Lexing.pos_cnum } ;; + let mach_suf_table = Hashtbl.create 0 + ;; + let _ = + List.iter (fun (suf, ty) -> Common.htab_put mach_suf_table suf ty) + [ ("u8", Common.TY_u8); + ("i8", Common.TY_i8); + ("u16", Common.TY_u16); + ("i16", Common.TY_i16); + ("u32", Common.TY_u32); + ("i32", Common.TY_i32); + ("u64", Common.TY_u64); + ("i64", Common.TY_i64); + ("f32", Common.TY_f32); + ("f64", Common.TY_f64); ] + ;; + let keyword_table = Hashtbl.create 100 + ;; let _ = List.iter (fun (kwd, tok) -> Common.htab_put keyword_table kwd tok) [ ("mod", MOD); @@ -129,6 +146,9 @@ let dec = decdig ['0'-'9' '_']* let exp = ['e''E']['-''+']? dec let flo = (dec '.' dec (exp?)) | (dec exp) +let mach_float_suf = "f32"|"f64" +let mach_int_suf = ['u''i']('8'|"16"|"32"|"64") + let ws = [ ' ' '\t' '\r' ] let id = ['a'-'z' 'A'-'Z' '_']['a'-'z' 'A'-'Z' '0'-'9' '_']* @@ -197,19 +217,29 @@ rule token = parse { try Hashtbl.find keyword_table i with - Not_found -> IDENT (i) - } + Not_found -> IDENT (i) } + +| (bin|hex|dec) as n { LIT_INT (Int64.of_string n) } +| ((bin|hex|dec) as n) 'u' { LIT_UINT (Int64.of_string n) } +| ((bin|hex|dec) as n) + (mach_int_suf as s) { try + let tm = + Hashtbl.find mach_suf_table s + in + LIT_MACH_INT + (tm, Int64.of_string n) + with + Not_found -> + fail lexbuf + "bad mach-int suffix" } -| bin as n { LIT_INT (Int64.of_string n, n) } -| hex as n { LIT_INT (Int64.of_string n, n) } -| dec as n { LIT_INT (Int64.of_string n, n) } -| flo as n { LIT_FLO n } +| flo as n { LIT_FLOAT (float_of_string n) } -| '\'' { char lexbuf } -| '"' { let buf = Buffer.create 32 in - str buf lexbuf } +| '\'' { char lexbuf } +| '"' { let buf = Buffer.create 32 in + str buf lexbuf } -| eof { EOF } +| eof { EOF } and str buf = parse _ as ch diff --git a/src/boot/fe/pexp.ml b/src/boot/fe/pexp.ml index 72fa9d7e..1532a47a 100644 --- a/src/boot/fe/pexp.ml +++ b/src/boot/fe/pexp.ml @@ -466,7 +466,9 @@ and parse_rec_body (ps:pstate) : pexp' = (*((Ast.ident * pexp) array) =*) and parse_lit (ps:pstate) : Ast.lit = match peek ps with - LIT_INT (n,s) -> (bump ps; Ast.LIT_int (n,s)) + LIT_INT i -> (bump ps; Ast.LIT_int i) + | LIT_UINT i -> (bump ps; Ast.LIT_uint i) + | LIT_MACH_INT (tm, i) -> (bump ps; Ast.LIT_mach_int (tm, i)) | LIT_CHAR c -> (bump ps; Ast.LIT_char c) | LIT_BOOL b -> (bump ps; Ast.LIT_bool b) | _ -> raise (unexpected ps) @@ -602,106 +604,6 @@ and parse_bottom_pexp (ps:pstate) : pexp = let bpos = lexpos ps in span ps apos bpos (PEXP_lval (PLVAL_ext_deref inner)) - | (INT | UINT | CHAR | BOOL) as tok -> - begin - bump ps; - expect ps LPAREN; - match peek ps with - (LIT_INT _ | LIT_CHAR _ | LIT_BOOL _) as tok2 -> - bump ps; - expect ps RPAREN; - let i = match tok2 with - LIT_INT i -> i - | LIT_CHAR c -> (Int64.of_int c, - Common.escaped_char c) - | LIT_BOOL b -> if b then (1L, "1") else (0L, "0") - | _ -> bug () "expected int/char literal" - in - let bpos = lexpos ps in - span ps apos bpos - (PEXP_lit - (match tok with - INT -> Ast.LIT_int i - | UINT -> Ast.LIT_uint i - | CHAR -> - Ast.LIT_char - (Int64.to_int (fst i)) - | BOOL -> Ast.LIT_bool (fst i <> 0L) - | _ -> bug () "expected int/uint/char/bool token")) - - | _ -> - let pexp = parse_pexp ps in - expect ps RPAREN; - let bpos = lexpos ps in - let t = - match tok with - INT -> Ast.TY_int - | UINT -> Ast.TY_uint - | CHAR -> Ast.TY_char - | BOOL -> Ast.TY_bool - | _ -> bug () "expected int/uint/char/bool token" - in - let t = span ps apos bpos t in - span ps apos bpos - (PEXP_unop ((Ast.UNOP_cast t), pexp)) - end - - | MACH m -> - let literal (num, str) = - let _ = bump ps in - let _ = expect ps RPAREN in - let bpos = lexpos ps in - let check_range (lo:int64) (hi:int64) : unit = - if (num < lo) or (num > hi) - then raise (err (Printf.sprintf - "integral literal %Ld out of range [%Ld,%Ld]" - num lo hi) ps) - else () - in - begin - match m with - TY_u8 -> check_range 0L 0xffL - | TY_u16 -> check_range 0L 0xffffL - | TY_u32 -> check_range 0L 0xffffffffL - (* | TY_u64 -> ... *) - | TY_i8 -> check_range (-128L) 127L - | TY_i16 -> check_range (-32768L) 32767L - | TY_i32 -> check_range (-2147483648L) 2147483647L - (* - | TY_i64 -> ... - | TY_f32 -> ... - | TY_f64 -> ... - *) - | _ -> () - end; - span ps apos bpos - (PEXP_lit - (Ast.LIT_mach - (m, num, str))) - - in - begin - bump ps; - expect ps LPAREN; - match peek ps with - LIT_INT (n,s) -> literal (n,s) - | MINUS -> - begin - bump ps; - match peek ps with - LIT_INT (n,s) -> - literal (Int64.neg n, "-" ^ s) - | _ -> raise (unexpected ps) - end - | _ -> - let pexp = parse_pexp ps in - expect ps RPAREN; - let bpos = lexpos ps in - let t = span ps apos bpos (Ast.TY_mach m) in - span ps apos bpos - (PEXP_unop ((Ast.UNOP_cast t), pexp)) - end - | POUND -> bump ps; let name = parse_name ps in diff --git a/src/boot/fe/token.ml b/src/boot/fe/token.ml index cb3bb0b0..64aef2a4 100644 --- a/src/boot/fe/token.ml +++ b/src/boot/fe/token.ml @@ -103,8 +103,11 @@ type token = | JOIN (* Literals *) - | LIT_INT of (int64 * string) - | LIT_FLO of string + | LIT_INT of int64 + | LIT_UINT of int64 + | LIT_FLOAT of float + | LIT_MACH_INT of Common.ty_mach * int64 + | LIT_MACH_FLOAT of Common.ty_mach * float | LIT_STR of string | LIT_CHAR of int | LIT_BOOL of bool @@ -253,8 +256,13 @@ let rec string_of_tok t = | JOIN -> "join" (* Literals *) - | LIT_INT (_,s) -> s - | LIT_FLO n -> n + | LIT_INT i -> Int64.to_string i + | LIT_UINT i -> (Int64.to_string i) ^ "u" + | LIT_FLOAT s -> string_of_float s + | LIT_MACH_INT (tm, i) -> + (Int64.to_string i) ^ (Common.string_of_ty_mach tm) + | LIT_MACH_FLOAT (tm, f) -> + (string_of_float f) ^ (Common.string_of_ty_mach tm) | LIT_STR s -> ("\"" ^ (String.escaped s) ^ "\"") | LIT_CHAR c -> ("'" ^ (Common.escaped_char c) ^ "'") | LIT_BOOL b -> if b then "true" else "false" diff --git a/src/boot/llvm/lltrans.ml b/src/boot/llvm/lltrans.ml index e191ce01..ee192725 100644 --- a/src/boot/llvm/lltrans.ml +++ b/src/boot/llvm/lltrans.ml @@ -746,12 +746,12 @@ let trans_crate Ast.LIT_nil -> llnil | Ast.LIT_bool value -> Llvm.const_int (Llvm.i1_type llctx) (if value then 1 else 0) - | Ast.LIT_mach (mty, value, _) -> + | Ast.LIT_mach_int (mty, value) -> let llty = trans_mach_ty mty in Llvm.const_of_int64 llty value (mach_is_signed mty) - | Ast.LIT_int (value, _) -> + | Ast.LIT_int value -> Llvm.const_of_int64 (Llvm.i32_type llctx) value true - | Ast.LIT_uint (value, _) -> + | Ast.LIT_uint value -> Llvm.const_of_int64 (Llvm.i32_type llctx) value false | Ast.LIT_char ch -> Llvm.const_int (Llvm.i32_type llctx) ch diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml index 7a9aa922..16331e36 100644 --- a/src/boot/me/semant.ml +++ b/src/boot/me/semant.ml @@ -1204,7 +1204,7 @@ let rec atom_type (cx:ctxt) (at:Ast.atom) : Ast.ty = | Ast.ATOM_literal {node=(Ast.LIT_bool _); id=_} -> Ast.TY_bool | Ast.ATOM_literal {node=(Ast.LIT_char _); id=_} -> Ast.TY_char | Ast.ATOM_literal {node=(Ast.LIT_nil); id=_} -> Ast.TY_nil - | Ast.ATOM_literal {node=(Ast.LIT_mach (m,_,_)); id=_} -> Ast.TY_mach m + | Ast.ATOM_literal {node=(Ast.LIT_mach_int (m,_)); id=_} -> Ast.TY_mach m | Ast.ATOM_lval lv -> lval_ty cx lv ;; diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml index 5584b485..55ccadf7 100644 --- a/src/boot/me/trans.ml +++ b/src/boot/me/trans.ml @@ -1268,9 +1268,9 @@ let trans_visitor | Ast.LIT_bool false -> imm_false | Ast.LIT_bool true -> imm_true | Ast.LIT_char c -> imm_of_ty (Int64.of_int c) TY_u32 - | Ast.LIT_int (i, _) -> simm i - | Ast.LIT_uint (i, _) -> imm i - | Ast.LIT_mach (m, n, _) -> imm_of_ty n m + | Ast.LIT_int i -> simm i + | Ast.LIT_uint i -> imm i + | Ast.LIT_mach_int (m, n) -> imm_of_ty n m and trans_atom (atom:Ast.atom) : Il.operand = iflog diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml index ce5cf9f4..57fdc457 100644 --- a/src/boot/me/type.ml +++ b/src/boot/me/type.ml @@ -223,7 +223,7 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) = match lit with Ast.LIT_nil -> Ast.TY_nil | Ast.LIT_bool _ -> Ast.TY_bool - | Ast.LIT_mach (mty, _, _) -> Ast.TY_mach mty + | Ast.LIT_mach_int (mty, _) -> Ast.TY_mach mty | Ast.LIT_int _ -> Ast.TY_int | Ast.LIT_uint _ -> Ast.TY_uint | Ast.LIT_char _ -> Ast.TY_char |