syntax.ml

   1: (** Abstract syntax. *)
   2: 
   3: (** Arithmetical expressions. *)
   4: type expression =
   5:   | Numeral of int (** non-negative integer constant *)
   6:   | Plus of expression * expression  (** Addition [e1 + e2] *)
   7:   | Minus of expression * expression (** Difference [e1 - e2] *)
   8:   | Times of expression * expression (** Product [e1 * e2] *)
   9:   | Divide of expression * expression (** Quotient [e1 / e2] *)
  10:   | Negate of expression (** Opposite value [-e] *)
  11: 
  12: (** Conversion of expresions to strings. *)
  13: let string_of_expression e =
  14:   let rec to_str n e =
  15:     let (m, str) = match e with
  16:         Numeral n       ->    (3, string_of_int n)
  17:       | Negate e        ->    (2, "-" ^ (to_str 0 e))
  18:       | Times (e1, e2)  ->    (1, (to_str 1 e1) ^ " * " ^ (to_str 2 e2))
  19:       | Divide (e1, e2) ->    (1, (to_str 1 e1) ^ " / " ^ (to_str 2 e2))
  20:       | Plus (e1, e2)   ->    (0, (to_str 0 e1) ^ " + " ^ (to_str 1 e2))
  21:       | Minus (e1, e2)  ->    (0, (to_str 0 e1) ^ " - " ^ (to_str 1 e2))
  22:     in
  23:       if m < n then "(" ^ str ^ ")" else str
  24:   in
  25:     to_str (-1) e

eval.ml

   1: (** Evaluation of expressions, given as big step semantics. *)
   2: 
   3: open Syntax
   4: 
   5: (** [eval e] evaluates the expression [e] to an integer. It raises an
   6:     expressions if division by zero occurs. *)
   7: let rec eval = function
   8:   | Numeral n -> n
   9:   | Plus (e1, e2) -> eval e1 + eval e2
  10:   | Minus (e1, e2) -> eval e1 - eval e2
  11:   | Times (e1, e2) -> eval e1 * eval e2
  12:   | Divide (e1, e2) ->
  13:       let n2 = eval e2 in
  14:         if n2 <> 0 then eval e1 / n2 else failwith "Division by zero"
  15:   | Negate e -> - (eval e)

lexer.mll

   1: {
   2:   open Parser
   3: }
   4: 
   5: rule lexeme = parse
   6:     [' ' '\t' '\r' '\n']  { lexeme lexbuf }
   7:   | ['0'-'9']+  { NUMERAL (int_of_string (Lexing.lexeme lexbuf)) }
   8:   | '+'         { PLUS }
   9:   | '-'         { MINUS }
  10:   | '*'         { TIMES }
  11:   | '/'         { DIVIDE }
  12:   | '('         { LPAREN }
  13:   | ')'         { RPAREN }
  14:   | eof         { EOF }

parser.mly

   1: %{
   2:   open Syntax
   3: %}
   4: 
   5: /* Lexemes */
   6: %token <int> NUMERAL
   7: %token PLUS
   8: %token MINUS
   9: %token TIMES
  10: %token DIVIDE
  11: %token UMINUS
  12: %token LPAREN
  13: %token RPAREN
  14: %token EOF
  15: 
  16: /* Precedence and associativity */
  17: %left PLUS MINUS
  18: %left TIMES DIVIDE
  19: %nonassoc UMINUS
  20: 
  21: /* Top level rule */
  22: %start toplevel
  23: %type <Syntax.expression> toplevel
  24: 
  25: %%
  26: 
  27: /* Grammar */
  28: 
  29: toplevel: expression EOF { $1 }
  30: ;
  31: 
  32: expression:
  33:   | NUMERAL                           { Numeral $1 }
  34:   | expression TIMES  expression      { Times ($1, $3) }
  35:   | expression PLUS   expression      { Plus ($1, $3) }
  36:   | expression MINUS  expression      { Minus ($1, $3) }
  37:   | expression DIVIDE expression      { Divide ($1, $3) }
  38:   | MINUS expression %prec UMINUS     { Negate $2 }
  39:   | LPAREN expression RPAREN          { $2 }
  40: ;

calc.ml

   1: (** The main program. *)
   2: 
   3: (** The end of file character. *)
   4: let eof =
   5:   match Sys.os_type with
   6:       "Unix" | "Cygwin" -> "Ctrl-D"
   7:     | "Win32" -> "Ctrl-Z"
   8:     | _ -> "\"end of file\""
   9: ;;
  10: 
  11: (** The startup message. *)
  12: let startup = "Calculator. Press " ^ eof ^ " to quit."
  13: ;;
  14: 
  15: (** Top level reads input, parses, evaluates and prints the result. *)
  16: let main =
  17:   print_endline startup ;
  18:   try
  19:     while true do
  20:       print_string "> ";
  21:       let str = read_line () in
  22:         try
  23:             let e = Parser.toplevel Lexer.lexeme (Lexing.from_string str) in
  24:           let n = Eval.eval e in
  25:           print_endline (string_of_int n)
  26:         with
  27:           Failure str -> print_endline ("Error: " ^ str)
  28:         | Parsing.Parse_error -> print_endline "Syntax error."
  29:     done 
  30:   with
  31:     End_of_file -> print_endline "\nGood bye."
  32: ;;