aboutsummaryrefslogtreecommitdiff
path: root/src/boot/fe
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot/fe')
-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
5 files changed, 68 insertions, 123 deletions
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"
generated by cgit v1.2.3 (git 2.25.1) at 2026-03-11 21:05:18 +0000