Improve operator lexing
This commit is contained in:
		
							parent
							
								
									4efb65c5cd
								
							
						
					
					
						commit
						20e324f4c2
					
				
					 3 changed files with 27 additions and 23 deletions
				
			
		
							
								
								
									
										15
									
								
								lex.ml
									
										
									
									
									
								
							
							
						
						
									
										15
									
								
								lex.ml
									
										
									
									
									
								
							| 
						 | 
				
			
			@ -26,6 +26,21 @@ let is_ident_start =
 | 
			
		|||
let is_ident =
 | 
			
		||||
  either is_ident_start is_digit
 | 
			
		||||
 | 
			
		||||
let expect_token str tok seq =
 | 
			
		||||
  let rec aux ts seq =
 | 
			
		||||
    match ts (), seq () with
 | 
			
		||||
    | Seq.Nil, _ -> Some seq
 | 
			
		||||
    | Seq.Cons _, Seq.Nil -> None
 | 
			
		||||
    | Seq.Cons (a, ts), Seq.Cons (b, seq) ->
 | 
			
		||||
      if a = b then aux ts seq else None
 | 
			
		||||
  in
 | 
			
		||||
  let str = String.to_seq str in
 | 
			
		||||
  aux str seq |> Option.map (fun s -> tok, s)
 | 
			
		||||
 | 
			
		||||
let find_token seq =
 | 
			
		||||
  !Token.tokens |> List.find_map
 | 
			
		||||
    (fun (s, t) -> expect_token s t seq)
 | 
			
		||||
 | 
			
		||||
(* same as take_while f seq, drop_while f seq *)
 | 
			
		||||
let rec partition_while f seq : 'a Seq.t * 'a Seq.t =
 | 
			
		||||
  match seq () with
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										20
									
								
								parser.ml
									
										
									
									
									
								
							
							
						
						
									
										20
									
								
								parser.ml
									
										
									
									
									
								
							| 
						 | 
				
			
			@ -31,14 +31,18 @@ let is_left_to_right = function
 | 
			
		|||
  | Add | Sub | Mul | Div -> true
 | 
			
		||||
  | _ -> assert false
 | 
			
		||||
 | 
			
		||||
let token_to_op = function
 | 
			
		||||
  | Token.Plus -> Add
 | 
			
		||||
  | Minus -> Sub
 | 
			
		||||
  | Asterisk -> Mul
 | 
			
		||||
  | Slash -> Div
 | 
			
		||||
  | Carret -> Exp
 | 
			
		||||
  | Percent -> Mod
 | 
			
		||||
  | _ -> failwith "Parser.token_to_op"
 | 
			
		||||
let operators = [
 | 
			
		||||
  Token.Plus, Add;
 | 
			
		||||
  Minus, Sub;
 | 
			
		||||
  Asterisk, Mul;
 | 
			
		||||
  Slash, Div;
 | 
			
		||||
  Carret, Exp;
 | 
			
		||||
  Percent, Mod;
 | 
			
		||||
] |> List.to_seq |> Hashtbl.of_seq
 | 
			
		||||
 | 
			
		||||
let token_to_op tok =
 | 
			
		||||
  try Hashtbl.find operators tok
 | 
			
		||||
  with _ -> failwith "Parser.token_to_op"
 | 
			
		||||
 | 
			
		||||
(* common parsers *)
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										15
									
								
								token.ml
									
										
									
									
									
								
							
							
						
						
									
										15
									
								
								token.ml
									
										
									
									
									
								
							| 
						 | 
				
			
			@ -22,21 +22,6 @@ let tokens = ref [
 | 
			
		|||
  ")", RParen;
 | 
			
		||||
]
 | 
			
		||||
 | 
			
		||||
let expect_token str tok seq =
 | 
			
		||||
  let rec aux ts seq =
 | 
			
		||||
    match ts (), seq () with
 | 
			
		||||
    | Seq.Nil, _ -> Some seq
 | 
			
		||||
    | Seq.Cons _, Seq.Nil -> None
 | 
			
		||||
    | Seq.Cons (a, ts), Seq.Cons (b, seq) ->
 | 
			
		||||
      if a = b then aux ts seq else None
 | 
			
		||||
  in
 | 
			
		||||
  let str = String.to_seq str in
 | 
			
		||||
  aux str seq |> Option.map (fun s -> tok, s)
 | 
			
		||||
 | 
			
		||||
let find_token seq =
 | 
			
		||||
  !tokens |> List.find_map
 | 
			
		||||
    (fun (s, t) -> expect_token s t seq)
 | 
			
		||||
 | 
			
		||||
let to_string = function
 | 
			
		||||
  | Int n -> Printf.sprintf "[int: %d]" n
 | 
			
		||||
  | Float n -> Printf.sprintf "[float: %f]" n
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		
		Reference in a new issue