First commit

lib/dune

@@ -0,0 +1,5 @@
+(library
+ (name lang)
+ (public_name lang))
+
+(include_subdirs qualified)

lib/exercises.ml

@@ -0,0 +1,109 @@
+type a_exp =
+    Aval of int
+  | Plus of a_exp * a_exp
+  | Minus of a_exp * a_exp
+  | Times of a_exp * a_exp
+  | Of_bool of b_exp
+and b_exp =
+    Bval of bool
+  | And of b_exp * b_exp
+  | Or of b_exp * b_exp
+  | Not of b_exp
+  | Minor of a_exp * a_exp
+
+
+let rec eval_a_exp node =
+  match node with
+    Aval (i) -> i
+  | Plus (i, j) -> (eval_a_exp i) + (eval_a_exp j)
+  | Minus (i, j) -> (eval_a_exp i) - (eval_a_exp j)
+  | Times (i, j) -> (eval_a_exp i) * (eval_a_exp j)
+  | Of_bool b -> if (eval_b_exp b) then 1 else 0
+and eval_b_exp node =
+  match node with
+    Bval (b) -> b
+  | And (a, b) -> (eval_b_exp a) && (eval_b_exp b)
+  | Or (a, b) -> (eval_b_exp a) || (eval_b_exp b)
+  | Not b -> not (eval_b_exp b)
+  | Minor (i, j) -> (eval_a_exp i) < (eval_a_exp j)
+
+type 'a my_tree =
+    Leaf of 'a
+  | Node of ('a my_tree) list
+
+let mod_list y =
+  (List.fold_left
+     (fun acc x ->
+       match acc with
+       | [a] when ((List.hd a) = x) -> [x :: a]
+       | a :: tl when ((List.hd a) = x) -> (x :: a) :: tl
+       | _ -> [x] :: acc)
+     []
+     y)
+  |> List.rev
+
+(* -------------------------------------------------------------------------- *)
+
+let to_tup f g =
+  fun x -> match x with
+    (a, b) -> (f a, g b)
+
+let partialsum l =
+  snd (List.fold_left_map (fun acc x -> (acc+x, acc+x)) 0 l)
+
+type label =
+  string
+
+type 'a finite_state_automata = {
+  l: label;
+  next: ('a finite_state_automata *  'a list) list;
+  final: bool;
+}
+
+let rec check_included input fsa =
+  match input with
+    [] -> fsa.final
+  | a::rest -> (
+      match List.find_opt (fun x -> List.mem a (snd x)) fsa.next with
+        None -> false
+      | Some x -> check_included rest (fst x)
+    )
+
+
+(* -------------------------------------------------------------------------- *)
+
+module StringMap = Map.Make(String)
+
+type fsa = {
+  vertices: bool StringMap.t;
+  edges: (string * char) StringMap.t;
+  state: string;
+}
+
+let ex8 (instr: char list) (infsa: fsa) =
+  let rec helper_ex8 (i: char list) (ifsa: fsa) (current: string) =
+    match i with
+      [] -> (
+        match StringMap.find_opt current ifsa.vertices with
+          None -> false
+        | Some b -> b
+      )
+    | a::rest -> (
+        match StringMap.find_first_opt (fun _ -> true) (StringMap.filter (fun x (_, y) -> x = current && y = a) ifsa.edges) with
+          None -> false
+        | Some (_, (outedge, _)) -> helper_ex8 rest ifsa outedge
+      )
+  in helper_ex8 instr infsa infsa.state
+
+type binary_tree =
+    Node of binary_tree * binary_tree
+  | Leaf of int
+
+let ex9 b =
+  let rec helper_ex9 b' n =
+    match b' with
+      Leaf a -> a + n
+    | Node (r, l) -> (helper_ex9 r (helper_ex9 l n))
+  in helper_ex9 b 0
+
+(* -------------------------------------------------------------------------- *)

lib/exercises.mli

@@ -0,0 +1,60 @@
+type a_exp =
+    Aval of int
+  | Plus of a_exp * a_exp
+  | Minus of a_exp * a_exp
+  | Times of a_exp * a_exp
+  | Of_bool of b_exp
+and b_exp =
+    Bval of bool
+  | And of b_exp * b_exp
+  | Or of b_exp * b_exp
+  | Not of b_exp
+  | Minor of a_exp * a_exp
+
+
+val eval_a_exp: a_exp -> int
+val eval_b_exp: b_exp -> bool
+
+type 'a my_tree =
+    Leaf of 'a
+  | Node of ('a my_tree) list
+
+val mod_list: 'a list -> 'a list list
+
+(* --------------------------------------------------------------------------- *)
+
+val to_tup : ('a -> 'b) -> ('c -> 'd) -> (('a * 'c) -> ('b * 'd))
+
+val partialsum : int list -> int list
+
+type label =
+  string
+
+type 'a finite_state_automata = {
+  l: label;
+  next: ('a finite_state_automata *  'a list) list;
+  final: bool;
+}
+
+val check_included : 'a list -> 'a finite_state_automata -> bool
+
+(* -------------------------------------------------------------------------- *)
+
+module StringMap : Map.S with type key = string
+
+type fsa = {
+  vertices: bool StringMap.t;
+  edges: (string * char) StringMap.t;
+  state: string;
+}
+
+val ex8 : char list -> fsa -> bool
+
+
+type binary_tree =
+    Node of binary_tree * binary_tree
+  | Leaf of int
+
+val ex9 : binary_tree -> int
+
+(* -------------------------------------------------------------------------- *)

lib/lang.ml

@@ -0,0 +1,3 @@
+module Exercises = Exercises
+
+module MiniImp = MiniImp

lib/miniImp.ml

@@ -0,0 +1,104 @@
+type variable = string
+
+type p_exp =
+    Main of variable * variable * c_exp (* def main with input x output y as c *)
+and c_exp =
+    Skip
+  | Assignment of variable * a_exp      (* x := a *)
+  | Sequence of c_exp * c_exp           (* c; c *)
+  | If of b_exp * c_exp * c_exp         (* if b then c else c *)
+  | While of b_exp * c_exp              (* while b do c *)
+and b_exp =
+    Boolean of bool                     (* v *)
+  | BAnd of b_exp * b_exp               (* b and b *)
+  | BNot of b_exp                       (* not b *)
+  | BCmpLess of a_exp * a_exp           (* a < a *)
+and a_exp =
+    Variable of variable                (* x *)
+  | Integer of int                      (* n *)
+  | Plus of a_exp * a_exp               (* a + a *)
+  | Minus of a_exp * a_exp              (* a - a *)
+  | Times of a_exp * a_exp              (* a * a *)
+
+
+
+module VariableMap = Map.Make(String)
+
+type memory = {
+  assignments: int VariableMap.t
+}
+
+
+exception AbsentAssignment of string
+
+let rec evaluate (mem: memory) (command: c_exp) =
+  match command with
+    Skip -> mem
+  | Assignment (v, exp_a) -> {assignments = VariableMap.add v (evaluate_a mem exp_a) mem.assignments}
+  | Sequence (exp_c1, exp_c2) -> (
+      let mem2 = evaluate mem exp_c1 in
+      evaluate mem2 exp_c2
+    )
+  | If (exp_b, exp_c1, exp_c2) -> (
+      if evaluate_b mem exp_b then
+        evaluate mem exp_c1
+      else
+        evaluate mem exp_c2
+    )
+  | While (exp_b, exp_c) -> (
+      if evaluate_b mem exp_b then
+        let mem2 = evaluate mem exp_c in
+        evaluate mem2 command
+      else
+        mem
+    )
+
+and evaluate_a (mem: memory) (exp_a: a_exp) =
+  match exp_a with
+    Variable v -> (
+      match VariableMap.find_opt v mem.assignments with
+        None -> raise (AbsentAssignment ("The variable " ^ v ^ " is not defined."))
+      | Some a -> a
+    )
+  | Integer n -> n
+  | Plus (exp_a1, exp_a2) -> (
+      let exp_a1val = evaluate_a mem exp_a1 in
+      let exp_a2val = evaluate_a mem exp_a2 in
+      exp_a1val + exp_a2val
+    )
+  | Minus (exp_a1, exp_a2) -> (
+      let exp_a1val = evaluate_a mem exp_a1 in
+      let exp_a2val = evaluate_a mem exp_a2 in
+      exp_a1val - exp_a2val
+    )
+  | Times (exp_a1, exp_a2) -> (
+      let exp_a1val = evaluate_a mem exp_a1 in
+      let exp_a2val = evaluate_a mem exp_a2 in
+      exp_a1val * exp_a2val
+    )
+and evaluate_b (mem: memory) (exp_b: b_exp) =
+  match exp_b with
+    Boolean b -> b
+  | BAnd (exp_b1, exp_b2) -> (
+      let exp_b1val = evaluate_b mem exp_b1 in
+      let exp_b2val = evaluate_b mem exp_b2 in
+      exp_b1val && exp_b2val
+    )
+  | BNot (exp_b) -> (
+      not (evaluate_b mem exp_b)
+    )
+  | BCmpLess (exp_a1, exp_a2) -> (
+      let exp_a1val = evaluate_a mem exp_a1 in
+      let exp_a2val = evaluate_a mem exp_a2 in
+      exp_a1val < exp_a2val
+    )
+
+
+let reduce (iin : int) (program: p_exp) =
+  match program with
+    Main (vin, vout, expression) -> (
+      let mem : memory = {assignments = (VariableMap.empty |> VariableMap.add vin iin)} in
+      match VariableMap.find_opt vout (evaluate mem expression).assignments with
+        None -> raise (AbsentAssignment ("The output variable is not defined (" ^ vout ^ ")"))
+      | Some a -> a
+    )

lib/miniImp.mli

@@ -0,0 +1,33 @@
+type variable = string
+
+type p_exp =
+    Main of variable * variable * c_exp (* def main with input x output y as c *)
+and c_exp =
+    Skip
+  | Assignment of variable * a_exp      (* x := a *)
+  | Sequence of c_exp * c_exp           (* c; c *)
+  | If of b_exp * c_exp * c_exp         (* if b then c else c *)
+  | While of b_exp * c_exp              (* while b do c *)
+and b_exp =
+    Boolean of bool                     (* v *)
+  | BAnd of b_exp * b_exp               (* b and b *)
+  | BNot of b_exp                       (* not b *)
+  | BCmpLess of a_exp * a_exp           (* a < a *)
+and a_exp =
+    Variable of variable                (* x *)
+  | Integer of int                      (* n *)
+  | Plus of a_exp * a_exp               (* a + a *)
+  | Minus of a_exp * a_exp              (* a - a *)
+  | Times of a_exp * a_exp              (* a * a *)
+
+
+
+module VariableMap : Map.S with type key = variable
+
+type memory = {
+  assignments: int VariableMap.t
+}
+
+exception AbsentAssignment of string
+
+val reduce : int -> p_exp -> int