Add ans
This commit is contained in:
		
							parent
							
								
									8e249614ee
								
							
						
					
					
						commit
						856c2b359e
					
				
					 4 changed files with 40 additions and 25 deletions
				
			
		
							
								
								
									
										2
									
								
								ast.ml
									
										
									
									
									
								
							
							
						
						
									
										2
									
								
								ast.ml
									
										
									
									
									
								
							| 
						 | 
				
			
			@ -88,6 +88,7 @@ end
 | 
			
		|||
 | 
			
		||||
type t =
 | 
			
		||||
  | Value of Value.t
 | 
			
		||||
  | Var of string
 | 
			
		||||
  | Binop of t * Binop.t * t
 | 
			
		||||
  | Set_binop_pre of Binop.t * t
 | 
			
		||||
  | Get_binop_pre of Binop.t
 | 
			
		||||
| 
						 | 
				
			
			@ -103,6 +104,7 @@ let print ast =
 | 
			
		|||
  let pv v = pr "%s" @@ Value.to_string v in
 | 
			
		||||
  let rec aux = function
 | 
			
		||||
    | Value n -> pv n
 | 
			
		||||
    | Var v -> pr "%s" v
 | 
			
		||||
    | Binop (left, op, right) -> begin
 | 
			
		||||
        let op = Binop.to_string op in
 | 
			
		||||
        pr "(%s " op; aux left; pr " "; aux right; pr ")";
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										38
									
								
								eval.ml
									
										
									
									
									
								
							
							
						
						
									
										38
									
								
								eval.ml
									
										
									
									
									
								
							| 
						 | 
				
			
			@ -2,6 +2,7 @@ open Ast
 | 
			
		|||
open Ast.Value
 | 
			
		||||
 | 
			
		||||
exception No_operation
 | 
			
		||||
exception No_such_variable of string
 | 
			
		||||
 | 
			
		||||
let rec binop op l r =
 | 
			
		||||
  let tl = typeof l and tr = typeof r in
 | 
			
		||||
| 
						 | 
				
			
			@ -20,18 +21,25 @@ let rec binop op l r =
 | 
			
		|||
    end
 | 
			
		||||
  | Some f -> f l r
 | 
			
		||||
 | 
			
		||||
let rec eval = function
 | 
			
		||||
  | Value v -> v
 | 
			
		||||
  | Binop (l, op, r) ->
 | 
			
		||||
    let l = eval l and r = eval r in
 | 
			
		||||
    binop op l r
 | 
			
		||||
  | Set_binop_pre (op, l) ->
 | 
			
		||||
    let l =
 | 
			
		||||
      match eval l with
 | 
			
		||||
      | Int n -> n
 | 
			
		||||
      | v -> raise @@ Invalid_type (typeof v)
 | 
			
		||||
    in
 | 
			
		||||
    Hashtbl.replace Parser.precedence op l;
 | 
			
		||||
    Nop
 | 
			
		||||
  | Get_binop_pre op ->
 | 
			
		||||
    Int (Hashtbl.find Parser.precedence op)
 | 
			
		||||
let eval ans ast =
 | 
			
		||||
  let rec aux = function
 | 
			
		||||
    | Value v -> v
 | 
			
		||||
    | Var v ->
 | 
			
		||||
      if v = "ans"
 | 
			
		||||
      then ans
 | 
			
		||||
      else raise @@ No_such_variable v
 | 
			
		||||
    | Binop (l, op, r) ->
 | 
			
		||||
      let l = aux l and r = aux r in
 | 
			
		||||
      binop op l r
 | 
			
		||||
    | Set_binop_pre (op, l) ->
 | 
			
		||||
      let l =
 | 
			
		||||
        match aux l with
 | 
			
		||||
        | Int n -> n
 | 
			
		||||
        | v -> raise @@ Invalid_type (typeof v)
 | 
			
		||||
      in
 | 
			
		||||
      Hashtbl.replace Parser.precedence op l;
 | 
			
		||||
      Nop
 | 
			
		||||
    | Get_binop_pre op ->
 | 
			
		||||
      Int (Hashtbl.find Parser.precedence op)
 | 
			
		||||
  in
 | 
			
		||||
  aux ast
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
							
								
								
									
										24
									
								
								main.ml
									
										
									
									
									
								
							
							
						
						
									
										24
									
								
								main.ml
									
										
									
									
									
								
							| 
						 | 
				
			
			@ -10,6 +10,7 @@ let error_to_string e =
 | 
			
		|||
  | Parser.Expected t -> sprintf "expected %s" t
 | 
			
		||||
  | Parser.Unexpected_token t -> sprintf "unexpected token \"%s\"" t
 | 
			
		||||
  | Ast.Invalid_type t -> sprintf "invalid type %s" (Ast.Type.to_string t)
 | 
			
		||||
  | Eval.No_such_variable v -> sprintf "no such variable %s" v
 | 
			
		||||
  | Failure f -> sprintf "error on %s" f
 | 
			
		||||
  | Division_by_zero -> "cannot divide by zero"
 | 
			
		||||
  | _ -> raise e
 | 
			
		||||
| 
						 | 
				
			
			@ -18,32 +19,35 @@ let print_error e =
 | 
			
		|||
  printf "error: %s\n" @@ error_to_string e
 | 
			
		||||
 | 
			
		||||
(* read-eval-print *) 
 | 
			
		||||
let rep () : unit =
 | 
			
		||||
let rep ans : unit =
 | 
			
		||||
  printf "> ";
 | 
			
		||||
  let line = read_line () in
 | 
			
		||||
  if line = "quit" then raise Exit;
 | 
			
		||||
  let ans =
 | 
			
		||||
  let v =
 | 
			
		||||
    line
 | 
			
		||||
    |> Lex.tokenize
 | 
			
		||||
    |> Parser.parse
 | 
			
		||||
    |> Eval.eval
 | 
			
		||||
    |> Eval.eval !ans
 | 
			
		||||
  in
 | 
			
		||||
  match ans with
 | 
			
		||||
  match v with
 | 
			
		||||
  | Nop -> ()
 | 
			
		||||
  | _ -> printf "%s\n" @@ Ast.Value.to_string ans
 | 
			
		||||
  | _ ->
 | 
			
		||||
    ans := v;
 | 
			
		||||
    printf "%s\n" @@ Ast.Value.to_string v
 | 
			
		||||
 | 
			
		||||
let init_repl () =
 | 
			
		||||
  let sigintf _ = raise Reset_line in
 | 
			
		||||
  Sys.(set_signal sigint (Signal_handle sigintf))
 | 
			
		||||
 | 
			
		||||
(* simple REPL with error handling *)
 | 
			
		||||
let rec repl () : unit =
 | 
			
		||||
  try rep (); repl () with
 | 
			
		||||
let rec repl ans : unit =
 | 
			
		||||
  try rep ans; repl ans with
 | 
			
		||||
  | Exit | End_of_file -> ()
 | 
			
		||||
  | Reset_line -> printf "\n"; repl ()
 | 
			
		||||
  | e -> print_error e; repl ()
 | 
			
		||||
  | Reset_line -> printf "\n"; repl ans
 | 
			
		||||
  | e -> print_error e; repl ans
 | 
			
		||||
 | 
			
		||||
let () =
 | 
			
		||||
  let ans = ref @@ Ast.Value.Int 0 in
 | 
			
		||||
  init_repl ();
 | 
			
		||||
  printf "Configurable Evaluator %s\n" version; (* banner *)
 | 
			
		||||
  repl ()
 | 
			
		||||
  repl ans
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -90,6 +90,7 @@ let parse ts =
 | 
			
		|||
    | Seq.Cons (x, seq) -> begin match x with
 | 
			
		||||
        | Token.Int n -> Value (Int n), seq
 | 
			
		||||
        | Float n -> Value (Float n), seq
 | 
			
		||||
        | Ident id -> Var id, seq
 | 
			
		||||
        | LParen -> expr seq
 | 
			
		||||
        | _ -> unexpected_token x
 | 
			
		||||
      end
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
	Add table
		
		Reference in a new issue