about summary refs log tree commit diff
path: root/src/boot
diff options
context:
space:
mode:
authorGraydon Hoare <graydon@mozilla.com>2010-07-27 19:21:51 -0700
committerGraydon Hoare <graydon@mozilla.com>2010-07-27 19:21:51 -0700
commit80307576245aabf00285db020bbfbc4c3a891766 (patch)
tree7e408956ca3e895844dd30a1afddf64d83157da0 /src/boot
parent6662aeb779d3e44886c466378578ebe1979de15a (diff)
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.ml1
-rw-r--r--src/boot/driver/session.ml3
-rw-r--r--src/boot/fe/ast.ml17
-rw-r--r--src/boot/fe/cexp.ml4
-rw-r--r--src/boot/fe/lexer.mll50
-rw-r--r--src/boot/fe/pexp.ml104
-rw-r--r--src/boot/fe/token.ml16
-rw-r--r--src/boot/llvm/lltrans.ml6
-rw-r--r--src/boot/me/semant.ml2
-rw-r--r--src/boot/me/trans.ml6
-rw-r--r--src/boot/me/type.ml2
11 files changed, 79 insertions, 132 deletions
diff --git a/src/boot/driver/main.ml b/src/boot/driver/main.ml
index b90454858fc..9af7ee0b7a7 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 210dd7be33a..d9e57b02ac2 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 767a64265ca..651b1e653d7 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 5d3a99ef962..fc849b283e9 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 090da25f854..bb1d881e617 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 72fa9d7ed52..1532a47a612 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 cb3bb0b0197..64aef2a421c 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 e191ce0143c..ee1927257e8 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 7a9aa922e6e..16331e3611b 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 5584b48587b..55ccadf77ce 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 ce5cf9f478b..57fdc4574f4 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