diff --git a/ast.ml b/ast.ml index cf67336..e8cb85a 100644 --- a/ast.ml +++ b/ast.ml @@ -23,6 +23,7 @@ and operator = | Add | Sub | Mul | Div (* arithmetics *) | Mod (* modular operation *) | Exp (* exponentation *) + | Eq | Neq | GE | LE | GT | LT | Negate let op_to_string = function @@ -32,6 +33,12 @@ let op_to_string = function | Div -> "/" | Mod -> "%" | Exp -> "^" + | Eq -> "=" + | Neq -> "<>" + | GE -> ">=" + | LE -> "<=" + | GT -> ">" + | LT -> "<" | Negate -> "-" let unary op t = diff --git a/eval.ml b/eval.ml index 242f287..42da438 100644 --- a/eval.ml +++ b/eval.ml @@ -33,6 +33,7 @@ module Type = struct | External exception Invalid of t + exception Expected of t let to_string = function | Int -> "int" @@ -123,11 +124,45 @@ module Operator = struct let vf f a b = match a, b with | Float a, Float b -> Float (f a b) - | _ -> raise @@ Type.Invalid Float + | _ -> raise @@ Type.Expected Float + let vb intf floatf a b = + match a, b with + | Int a, Int b -> Bool (intf a b) + | Float a, Float b -> Bool (floatf a b) + | _ -> raise @@ Type.Expected Bool + + let vnot = function + | Bool b -> Bool (not b) + | _ -> raise @@ Type.Expected Bool + + let map ?intf ?floatf ?boolf v = + let app x f = f x in + match v with + | Int i -> Option.map (app i) intf + | Float f -> Option.map (app f) floatf + | Bool b -> Option.map (app b) boolf + | _ -> invalid_arg "Operator.map" + + let eq = vb Int.equal Float.equal + let neq a b = vnot @@ eq a b + + let compare a b = + match a, b with + | Int a, Int b -> Int.compare a b + | Float a, Float b -> Float.compare a b + | _ -> invalid_arg "Operator.compare" + + let ge a b = Bool (compare a b >= 0) + let le a b = Bool (compare a b <= 0) + let gt a b = Bool (compare a b > 0) + let lt a b = Bool (compare a b < 0) + + (* operator table *) let operators = let open Type in let ip = Int, Int and fp = Float, Float in + let any f = [ip, f; fp, f] in [ Add, [ip, vi Int.add; fp, vf Float.add]; Sub, [ip, vi Int.sub; fp, vf Float.sub]; @@ -135,6 +170,12 @@ module Operator = struct Div, [ip, vi Int.div; fp, vf Float.div]; Mod, [ip, vi Int.rem; fp, vf Float.rem]; Exp, [fp, vf Float.pow]; + Eq, any eq; + Neq, any neq; + GE, any ge; + LE, any le; + GT, any gt; + LT, any lt; ] |> List.to_seq |> Hashtbl.of_seq diff --git a/parser.ml b/parser.ml index 1e709ea..d91b021 100644 --- a/parser.ml +++ b/parser.ml @@ -23,6 +23,12 @@ let precedence = [ Div, 20; Mod, 30; Exp, 30; + Eq, 100; + Neq, 100; + GE, 100; + LE, 100; + GT, 100; + LT, 100; ] |> List.to_seq |> Hashtbl.of_seq let precedence_of op = @@ -59,6 +65,12 @@ let operators = [ Slash, Div; Carret, Exp; Percent, Mod; + Equal, Eq; + Not_equal, Neq; + Greater_equal, GE; + Less_equal, LE; + Greater, GT; + Less, LT; ] |> List.to_seq |> Hashtbl.of_seq let token_to_op tok = diff --git a/token.ml b/token.ml index f4166f2..c550401 100644 --- a/token.ml +++ b/token.ml @@ -12,11 +12,23 @@ type t = | LParen | RParen | Equal + | Not_equal + | Greater + | Less + | Greater_equal + | Less_equal | Hash | Right_arrow +(* list of tokens. because front tokens are detected first, longer + * tokens must come earlier than shorter tokens. *) let tokens = ref [ "->", Right_arrow; + "<>", Not_equal; + ">=", Greater_equal; + "<=", Less_equal; + ">", Greater; + "<", Less; "+", Plus; "-", Minus; "*", Asterisk;