Merge with cfg

.gitignore

@@ -25,6 +25,7 @@ setup.log
 
 # Dune generated files
 *.install
+*.opam
 
 # Local OPAM switch
 _opam/

bin/dune

@@ -1,4 +1,28 @@
 (executable
- (public_name main)
+  (name main)
- (name main)
+  (public_name main)
- (libraries lang))
+  (libraries exercises
+             miniImp
+             miniFun
+             utility)
+  (package miniFun)
+  (modes byte exe)
+)
+
+(executable
+  (name miniFunInterpreter)
+  (public_name miniFunInterpreter)
+  (libraries miniFun
+             clap)
+  (package miniFun)
+  (modes byte exe)
+  )
+
+(executable
+  (name miniImpInterpreter)
+  (public_name miniImpInterpreter)
+  (libraries miniImp
+             clap)
+  (package miniImp)
+  (modes byte exe)
+  )

bin/fibonacci-fixed-point.minifun

@@ -0,0 +1,15 @@
+lambda n: int -> int =>
+
+let fib = lambda f : (int -> int) -> int -> int =>
+    \ n : int -> int =>
+        if      n == 0 then 0
+        else if n == 1 then 1
+        else                f (n - 1) + f (n - 2)
+in
+
+let rec fix f : ((int -> int) -> int -> int) -> int -> int =
+    \ x : int -> int =>
+        f (fix f) x
+in
+
+fix fib n

bin/main.ml

@@ -1 +1,20 @@
-print_endline "Hello!"
+open MiniImp
+open MiniImp.Cfg
+
+let () =
+  let program = "def main with input x output y as
+                   x := 2;
+                   if y < 0 then (
+                       y := x + 3;
+                       x := y;
+                   ) else
+                       x := 1 - y;" in
+
+
+  let get_result x = Lexing.from_string x |> Parser.prg Lexer.lex in
+
+  let p = get_result program in
+
+  let converted = convert p in
+
+  Printf.printf "%a" Cfg.pp converted

bin/miller-rabin.miniimp

@@ -0,0 +1,25 @@
+def main with input n output result as
+  if (n % 2) == 0 then result := 1
+  else (
+
+    result := 0;
+    s := 0;
+    while (0 == ((n - 1) / (2 ^ s)) % 2) do (
+      s := s + 1
+    );
+    d := ((n - 1) / 2 ^ s);
+    for (i := 20, i > 0, i := i - 1) do (
+      a := rand(n - 4) + 2;
+      x := powmod(a, d, n);
+      for (j := 0, j < s, j := j+1) do (
+        y := powmod(x, 2, n);
+        if (y == 1 && (not x == 1) && (not x == n - 1)) then
+          result := 1;
+        else
+          skip;
+        x := y;
+      );
+      if not y == 1 then result := 1;
+                    else skip;
+    )
+  )

bin/miniFunInterpreter.ml

@@ -0,0 +1,100 @@
+open MiniFun
+open Lexing
+
+(* -------------------------------------------------------------------------- *)
+(*                             Command Arguments                              *)
+
+let () =
+  Clap.description "Interpreter for MiniFun language.";
+
+  let files = Clap.section ~description: "Files to consider." "FILES" in
+  let values = Clap.section ~description: "Input values." "VALUES" in
+
+  let input = Clap.mandatory_string
+      ~description: "Input file."
+      ~placeholder: "FILENAME"
+      ~section: files
+      ~long: "input"
+      ~short: 'i'
+      ()
+  in
+
+  let inputval = Clap.optional_int
+      ~description: "Optional input value to feed to the program. \
+                     If not specified it is read from stdin."
+      ~placeholder: "INT"
+      ~section: values
+      ~long: "value"
+      ~short: 'v'
+      ()
+  in
+
+  let output = Clap.optional_string
+      ~description: "Output file. If not specified output is printed on stdout."
+      ~placeholder: "FILENAME"
+      ~section: files
+      ~long: "output"
+      ~long_synonyms: ["out"; "result"]
+      ~short: 'o'
+      ()
+  in
+
+  Clap.close ();
+
+(* -------------------------------------------------------------------------- *)
+(*                                Interpreter                                 *)
+
+  let print_position outx lexbuf =
+    let pos = lexbuf.lex_curr_p in
+    Printf.fprintf outx "Encountered \"%s\" at %s:%d:%d"
+      (Lexing.lexeme lexbuf) pos.pos_fname
+      pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1)
+  in
+
+  let interpret_file inch (inval: int) outch =
+    let lexbuf = Lexing.from_channel inch in
+    let program =
+      try Parser.prg Lexer.read lexbuf with
+      | Lexer.LexingError msg ->
+        Printf.fprintf stderr "%a: %s\n" print_position lexbuf msg;
+        exit (-1)
+      | Parser.Error -> Printf.fprintf stderr "%a: syntax error\n" print_position lexbuf;
+        exit (-1)
+    in
+    let _ =
+      match TypeChecker.typecheck program with
+      | Ok _ -> ()
+      | Error (`AbsentAssignment msg)
+      | Error (`WrongTypeSpecification msg)
+      | Error (`WrongType msg) ->
+        Printf.fprintf stderr "%s\n" msg;
+        exit (-1)
+    in
+    let return_value =
+      match Semantics.reduce program inval with
+        Ok o -> o
+      | Error (`AbsentAssignment msg)
+      | Error (`DivisionByZero msg)
+      | Error (`WrongType msg) ->
+        Printf.fprintf stderr "%s\n" msg;
+        exit (-1)
+    in
+
+    Printf.fprintf outch "%d\n" return_value
+  in
+
+
+  let inx = In_channel.open_text input in
+  let outx = match output with
+      None -> stdout
+    | Some f -> Out_channel.open_text f
+  in
+
+  let inputval = match inputval with
+      None -> (
+        Printf.fprintf stdout "Provide the input: ";
+        read_int ()
+      )
+    | Some o -> o
+  in
+  interpret_file inx inputval outx;

bin/miniImpInterpreter.ml

@@ -0,0 +1,91 @@
+open MiniImp
+open Lexing
+
+(* -------------------------------------------------------------------------- *)
+(*                             Command Arguments                              *)
+
+let () =
+  Clap.description "Interpreter for MiniImp language.";
+
+  let files = Clap.section ~description: "Files to consider." "FILES" in
+  let values = Clap.section ~description: "Input values." "VALUES" in
+
+  let input = Clap.mandatory_string
+      ~description: "Input file."
+      ~placeholder: "FILENAME"
+      ~section: files
+      ~long: "input"
+      ~short: 'i'
+      ()
+  in
+
+  let inputval = Clap.optional_int
+      ~description: "Optional input value to feed to the program. \
+                     If not specified it is read from stdin."
+      ~placeholder: "INT"
+      ~section: values
+      ~long: "value"
+      ~short: 'v'
+      ()
+  in
+
+  let output = Clap.optional_string
+      ~description: "Output file. If not specified output is printed on stdout."
+      ~placeholder: "FILENAME"
+      ~section: files
+      ~long: "output"
+      ~long_synonyms: ["out"; "result"]
+      ~short: 'o'
+      ()
+  in
+
+  Clap.close ();
+
+(* -------------------------------------------------------------------------- *)
+(*                                Interpreter                                 *)
+
+  let print_position outx lexbuf =
+    let pos = lexbuf.lex_curr_p in
+    Printf.fprintf outx "Encountered \"%s\" at %s:%d:%d"
+      (Lexing.lexeme lexbuf) pos.pos_fname
+      pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1)
+  in
+
+  let interpret_file inch (inval: int) outch =
+    let lexbuf = Lexing.from_channel inch in
+    let program =
+      try Parser.prg Lexer.read lexbuf with
+      | Lexer.LexingError msg ->
+        Printf.fprintf stderr "%a: %s\n" print_position lexbuf msg;
+        exit (-1)
+      | Parser.Error -> Printf.fprintf stderr "%a: syntax error\n" print_position lexbuf;
+        exit (-1)
+    in
+    let return_value =
+      match Semantics.reduce program inval with
+        Ok o -> o
+      | Error (`AbsentAssignment msg)
+      | Error (`DivisionByZero msg)
+      | Error (`WrongType msg) ->
+        Printf.fprintf stderr "%s\n" msg;
+        exit (-1)
+    in
+
+    Printf.fprintf outch "%d\n" return_value
+  in
+
+
+  let inx = In_channel.open_text input in
+  let outx = match output with
+      None -> stdout
+    | Some f -> Out_channel.open_text f
+  in
+
+  let inputval = match inputval with
+      None -> (
+        Printf.fprintf stdout "Provide the input: ";
+        read_int ()
+      )
+    | Some o -> o
+  in
+  interpret_file inx inputval outx;

bin/sum.miniimp

@@ -0,0 +1,8 @@
+def main with input in output out as
+  x := in;
+  out := 0;
+  while not x < 0 do (
+    out := out + x;
+    x := x - 1;
+  );
+  skip

dune-project

@@ -4,6 +4,20 @@
 
 (generate_opam_files true)
 
+(using menhir 3.0)
+
 (package
- (name lang)
+ (name utility)
+ (depends ocaml dune))
+
+(package
+ (name miniImp)
+ (depends ocaml dune utility))
+
+(package
+ (name miniFun)
+ (depends ocaml dune utility))
+
+(package
+ (name exercises)
  (depends ocaml dune))

lang.opam

@@ -1,21 +0,0 @@
-# This file is generated by dune, edit dune-project instead
-opam-version: "2.0"
-depends: [
-  "ocaml"
-  "dune" {>= "3.16"}
-  "odoc" {with-doc}
-]
-build: [
-  ["dune" "subst"] {dev}
-  [
-    "dune"
-    "build"
-    "-p"
-    name
-    "-j"
-    jobs
-    "@install"
-    "@runtest" {with-test}
-    "@doc" {with-doc}
-  ]
-]

lib/dune

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

lib/exercises/dune

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

lib/exercises/exercises.ml

@@ -34,10 +34,10 @@ type 'a my_tree =
 let mod_list y =
   (List.fold_left
      (fun acc x ->
-       match acc with
+        match acc with
-       | [a] when ((List.hd a) = x) -> [x :: a]
+        | [a] when ((List.hd a) = x) -> [x :: a]
-       | a :: tl when ((List.hd a) = x) -> (x :: a) :: tl
+        | a :: tl when ((List.hd a) = x) -> (x :: a) :: tl
-       | _ -> [x] :: acc)
+        | _ -> [x] :: acc)
      []
      y)
   |> List.rev
@@ -46,7 +46,7 @@ let mod_list y =
 
 let to_tup f g =
   fun x -> match x with
-    (a, b) -> (f a, g b)
+      (a, b) -> (f a, g b)
 
 let partialsum l =
   snd (List.fold_left_map (fun acc x -> (acc+x, acc+x)) 0 l)

lib/lang.ml

@@ -1,13 +0,0 @@
-module Exercises = Exercises
-
-(* -------------------------------- MINI IMP -------------------------------- *)
-module MiniImpTypes = MiniImp.Types
-
-module MiniImp = MiniImp.Semantics
-
-(* -------------------------------- MINI FUN -------------------------------- *)
-module MiniFunTypes = MiniFun.Types
-
-module MiniTyFun = MiniFun.TypeChecker
-
-module MiniFun = MiniFun.Semantics

lib/miniFun/Lexer.mll

@@ -0,0 +1,95 @@
+{
+  open Parser
+  exception LexingError of string
+
+  let create_hashtable size init =
+    let tbl = Hashtbl.create size in
+    List.iter (fun (key, data) -> Hashtbl.add tbl key data) init;
+    tbl
+
+  let keyword_table =
+    let mapping = [
+      ("bool",   TYPEBOOL);
+      ("else",   ELSE);
+      ("false",  BOOL(false));
+      ("fst",    FIRST);
+      ("snd",    SECOND);
+      ("fun",    LAMBDA);
+      ("if",     IF);
+      ("in",     IN);
+      ("int",    TYPEINT);
+      ("lambda", LAMBDA);
+      ("let",    LET);
+      ("not",    BNOT);
+      ("powmod", POWERMOD);
+      ("rand",   RAND);
+      ("rec",    REC);
+      ("then",   THEN);
+      ("true",   BOOL(true));
+    ]
+    in create_hashtable (List.length mapping) mapping
+}
+
+
+let digit   = ['0'-'9']
+let alpha   = ['a'-'z' 'A'-'Z']
+let white   = [' ' '\t']+ | '\r' | '\n' | "\r\n"
+
+let integer = ('-')?(digit)(digit*)
+let var     = (alpha|'_') (alpha|digit|'_')*
+
+let symbols = ['!'-'/' ':'-'?' '[' ']' '^' '{'-'}' '~']
+
+(* lexing rules *)
+rule read = parse
+  | white           {read lexbuf}
+  | var as v        {
+      match Hashtbl.find_opt keyword_table v with
+      | Some keyword -> keyword
+      | None -> VARIABLE(v)
+    }
+  | "%"             {MODULO}
+  | "&&"            {BAND}
+  | "("             {LEFTPAR}
+  | ")"             {RIGHTPAR}
+  | "*"             {TIMES}
+  | "+"             {PLUS}
+  | ","             {COMMA}
+  | "-"             {MINUS}
+  | "->"            {TYPEFUNCTION}
+  | "/"             {DIVISION}
+  | ":"             {COLUMN}
+  | "<"             {CMPLESS}
+  | "<="            {CMPLESSEQ}
+  | "="             {ASSIGNMENT}
+  | "=="            {CMP}
+  | "=>"            {RESULTS}
+  | ">"             {CMPGREATER}
+  | ">="            {CMPGREATEREQ}
+  | "\\"            {LAMBDA}
+  | "^"             {POWER}
+  | "||"            {BOR}
+  | integer as i    {INT(int_of_string i)}
+  | "(*"            {comments 0 lexbuf}
+  | eof             {EOF}
+  | _               {
+      raise
+        (LexingError
+           (Printf.sprintf
+              "Error scanning %s on line %d at char %d"
+              (Lexing.lexeme lexbuf)
+              (lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum)
+              (lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum)
+           ))}
+and comments level = parse
+  | "*)"    {if level = 0
+             then read lexbuf
+             else comments (level-1) lexbuf}
+  | "(*"    {comments (level+1) lexbuf}
+  | _       {comments level lexbuf}
+  | eof     {raise (LexingError ("Comment is not closed"))}
+
+
+{
+  let lex = read
+}

lib/miniFun/Parser.mly

@@ -0,0 +1,98 @@
+(* code to be copied in the scanner module *)
+(*
+*)
+%{
+  open Types
+%}
+
+(* tokens *)
+%token TYPEBOOL TYPEINT TYPEFUNCTION
+%token LAMBDA RAND IF IN THEN ELSE LET REC BNOT POWERMOD RESULTS
+%token <bool> BOOL
+%token <string> VARIABLE
+%token <int> INT
+%token COMMA COLUMN LEFTPAR RIGHTPAR CMPLESS CMPGREATER PLUS MINUS TIMES
+%token DIVISION MODULO POWER ASSIGNMENT BAND BOR CMP CMPLESSEQ CMPGREATEREQ
+%token FIRST SECOND
+%token EOF
+
+%type <t_exp> prg
+%type <t_exp> texp
+%type <ftype> typeexp
+
+(* start nonterminal *)
+%start prg
+
+(* associativity in order of precedence *)
+/*%right rightlowest */
+%left lowest
+%right TYPEFUNCTION
+%left COMMA
+%nonassoc INT BOOL VARIABLE
+%left POWERMOD
+%left IF
+%left BOR BAND
+%left CMP CMPLESS CMPLESSEQ CMPGREATER CMPGREATEREQ
+%left PLUS MINUS
+%left TIMES DIVISION MODULO
+%left POWER
+%right BNOT RAND
+%left FIRST SECOND
+%left LAMBDA
+%left LET
+%left LEFTPAR
+%right righthighest
+
+%%
+
+(* grammar *)
+prg:
+  | e = texp; EOF {e}
+texp:
+  | i = INT                               {Integer (i)}
+  | b = BOOL                              {Boolean (b)}
+  | a = VARIABLE                          {Variable (a)}
+  | LEFTPAR; a = texp; COMMA; b = texp; RIGHTPAR
+                                          {Tuple (a, b)}
+  | LAMBDA; v = VARIABLE; COLUMN; t = typeexp; RESULTS; body = texp
+                             %prec lowest {Function (v, t, body)}
+  | a = texp; b = texp                    {Application (a, b)} %prec righthighest
+  | a = texp; PLUS; b = texp              {Plus (a, b)}
+  | a = texp; MINUS; b = texp             {Minus (a, b)}
+  | a = texp; TIMES; b = texp             {Times (a, b)}
+  | a = texp; DIVISION; b = texp          {Division (a, b)}
+  | a = texp; MODULO; b = texp            {Modulo (a, b)}
+  | a = texp; POWER; b = texp             {Power (a, b)}
+  | a = texp; BAND; b = texp              {BAnd (a, b)}
+  | a = texp; BOR; b = texp               {BOr (a, b)}
+
+  | FIRST; a = texp                       {First (a)}
+  | SECOND; a = texp                      {Second (a)}
+
+  | a = texp; CMP; b = texp               {Cmp (a, b)}
+  | a = texp; CMPLESS; b = texp           {CmpLess (a, b)}
+  | a = texp; CMPLESSEQ; b = texp         {CmpLessEq (a, b)}
+  | a = texp; CMPGREATER; b = texp        {CmpGreater (a, b)}
+  | a = texp; CMPGREATEREQ; b = texp      {CmpGreaterEq (a, b)}
+
+  | POWERMOD; LEFTPAR; t1 = texp; COMMA;
+                       t2 = texp; COMMA;
+                       t3 = texp; RIGHTPAR
+    {PowerMod (t1, t2, t3)}
+  | RAND; t = texp;                       {Rand (t)}
+  | BNOT; b = texp                        {BNot (b)}
+  | IF; b = texp; THEN; c1 = texp; ELSE; c2 = texp;
+                             %prec lowest {IfThenElse (b, c1, c2)}
+  | LET; v = VARIABLE; ASSIGNMENT; c = texp; IN; rest = texp
+                             %prec lowest {LetIn (v, c, rest)}
+  | LET; REC; f = VARIABLE; x = VARIABLE; COLUMN; t = typeexp; ASSIGNMENT; body = texp; IN; rest = texp
+                             %prec lowest {LetFun (f, x, t, body, rest)}
+  | LEFTPAR; a = texp; RIGHTPAR           {a}
+typeexp:
+  | TYPEINT                               {IntegerType}
+  | TYPEBOOL                              {BooleanType}
+  | v = delimited(LEFTPAR, typeexp, RIGHTPAR)
+                                          {v}
+  | a = typeexp; COMMA; b = typeexp       {TupleType (a, b)}
+  | vin = typeexp; TYPEFUNCTION; vout = typeexp
+                                          {FunctionType (vin, vout)}

lib/miniFun/Semantics.ml

@@ -5,7 +5,7 @@ Random.self_init ()
 
 let (let*) = Result.bind
 
-let rec evaluate (mem: memory) (command: t_exp) : (permittedValues, error) result =
+let rec evaluate (mem: memory) (command: t_exp) : (permittedValues, [> error]) result =
   match command with
     Integer n -> Ok (IntegerPermitted n)
   | Boolean b -> Ok (BooleanPermitted b)
@@ -14,14 +14,19 @@ let rec evaluate (mem: memory) (command: t_exp) : (permittedValues, error) resul
         None -> Error (`AbsentAssignment ("The variable " ^ v ^ " is not defined."))
       | Some a -> Ok a
     )
-  | Function (xs, _, f) ->
+  | Tuple (x, y) -> (
+      let* xval = evaluate mem x in
+      let* yval = evaluate mem y in
+      Ok (TuplePermitted (xval, yval))
+    )
+  | Function (x, _, f) ->
     Ok (FunctionPermitted
-          {inputList = xs;
+          {input = x;
            body = f;
            assignments = mem.assignments;
            recursiveness = None}
        )
-  | Application (f, xs) -> (
+  | Application (f, x) -> (
       let* evalf = evaluate mem f in
       let* funcClosure = (
         match evalf with
@@ -30,45 +35,20 @@ let rec evaluate (mem: memory) (command: t_exp) : (permittedValues, error) resul
                                                    ^ " it's an integer"))
         | BooleanPermitted _ -> Error (`WrongType ("Function is not a function,"
                                                    ^ " it's a boolean"))
+        | TuplePermitted _ -> Error (`WrongType ("Function is not a function,"
+                                                   ^ " it's a tuple"))
       ) in
-      let parmList = List.map (fun k -> evaluate mem k) xs in
+      let* param = evaluate mem x in
-      let rec helper m params values =
+      let mem2 =
-        match (params, values) with
-          (_, []) -> Ok (m, params)
-        | ([], _) ->
-          Error (`WrongArity ("Function application has arity " ^
-                              (List.length funcClosure.inputList
-                               |> string_of_int) ^
-                              ", but was applied to " ^
-                              (List.length xs |> string_of_int) ^
-                              " parameters"))
-        | (p::tlparams, (Ok v)::tlvalues) -> helper
-                                          (VariableMap.add p v m)
-                                          tlparams
-                                          tlvalues
-        | (_, (Error e)::_) -> Error e
-      in
-      let* (mem2assignments, params) = helper
-          funcClosure.assignments
-          funcClosure.inputList
-          parmList
-      in
-      let mem2 = (
         match funcClosure.recursiveness with
-          None -> {assignments = mem2assignments}
+          None ->  {assignments = (
-        | Some nameF -> {
+            VariableMap.add funcClosure.input param funcClosure.assignments)}
-            assignments =
+        | Some nameF -> {assignments = (
-              VariableMap.add
+            VariableMap.add funcClosure.input param funcClosure.assignments |>
-                nameF
+            VariableMap.add nameF (FunctionPermitted funcClosure)
-                (FunctionPermitted funcClosure)
+          )}
-                mem2assignments
+      in
-          }
+      evaluate mem2 funcClosure.body
-      ) in
-      match params with
-        [] -> evaluate mem2 funcClosure.body
-      | _ -> (
-          Ok (FunctionPermitted {funcClosure with inputList = params;
-                                                  assignments = mem2assignments}))
     )
   | Plus (a, b) ->
     let* aval = (
@@ -248,7 +228,24 @@ let rec evaluate (mem: memory) (command: t_exp) : (permittedValues, error) resul
     )
     in
     Ok (BooleanPermitted (not aval))
-
+  | First a ->
+    let* aval = (
+      match evaluate mem a with
+        Ok TuplePermitted (x, _) -> Ok x
+      | Error e -> Error e
+      | _ -> Error (`WrongType ("Value is not a tuple"))
+    )
+    in
+    Ok (aval)
+  | Second a ->
+    let* aval = (
+      match evaluate mem a with
+        Ok TuplePermitted (_, x) -> Ok x
+      | Error e -> Error e
+      | _ -> Error (`WrongType ("Value is not a tuple"))
+    )
+    in
+    Ok (aval)
   | Cmp (exp_1, exp_2) ->
     let* exp_1val = match evaluate mem exp_1 with
         Ok IntegerPermitted x -> Ok x
@@ -329,13 +326,13 @@ let rec evaluate (mem: memory) (command: t_exp) : (permittedValues, error) resul
     let* evalxval = evaluate mem xval in
     let mem2 = {assignments = VariableMap.add x evalxval mem.assignments} in
     evaluate mem2 rest
-  | LetFun (f, xs, _, fbody, rest) ->
+  | LetFun (f, x, _, fbody, rest) ->
     let mem2 = {
       assignments =
         VariableMap.add
           f
           (FunctionPermitted
-             { inputList = xs;
+             { input = x;
                body = fbody;
                assignments = mem.assignments;
                recursiveness = Some f})
@@ -344,8 +341,8 @@ let rec evaluate (mem: memory) (command: t_exp) : (permittedValues, error) resul
     evaluate mem2 rest
 
 
-let reduce (program: t_exp) (iin : int) : (int, error) result =
+let reduce (program: t_exp) (iin : int) : (int, [> error]) result =
-  let program' = (Application (program, [(Integer iin)])) in
+  let program' = (Application (program, (Integer iin))) in
   let mem : memory = {assignments = VariableMap.empty} in
   match (evaluate mem program') with
     Ok IntegerPermitted a -> Ok a

lib/miniFun/Semantics.mli

@@ -1 +1,3 @@
-val reduce : Types.t_exp -> int -> (int, Types.error) result
+val evaluate : Types.memory -> Types.t_exp -> (Types.permittedValues, [> Types.error]) result
+
+val reduce : Types.t_exp -> int -> (int, [> Types.error]) result

lib/miniFun/TypeChecker.ml

@@ -5,11 +5,10 @@ Random.self_init ()
 
 let (let*) = Result.bind
 
-
 let rec principalTypings (D: ) (e: t_exp) : () result
 
-let evaluate_type (_program: t_exp) (_context: typingshape) : (typingshape, error) result =
+let evaluate_type_polimorphic (_program: t_exp) (_context: typingshape) : (typingshape, error) result =
-  failwith "asd"
+  failwith "Not implemented"
   (* match program with *)
   (*   Integer _ -> Ok (VariableMap.empty, IntegerType) *)
   (* | Boolean _ -> Ok (VariableMap.empty, BooleanType) *)
@@ -56,5 +55,155 @@ let evaluate_type (_program: t_exp) (_context: typingshape) : (typingshape, erro
   (* | LetIn (x, xval, rest) -> failwith "Not Implemented" *)
   (* | LetFun (f, xs, typef, fbody, rest) -> failwith "Not Implemented" *)
 
-let typecheck (_program: t_exp) : (ftype, error) result =
+let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) : (ftype, [> typechecking_error]) result =
-  failwith "Not Implemented"
+  match program with
+    Integer _ -> Ok IntegerType
+  | Boolean _ -> Ok BooleanType
+  | Variable x -> ( (* check for the type in the context *)
+      match VariableMap.find_opt x context with
+        None -> Error (`AbsentAssignment
+                         ("The variable " ^ x ^ " is not defined."))
+      | Some t -> Ok t
+    )
+  | Tuple (x, y) -> (
+      let* xtype = evaluate_type x context in
+      let* ytype = evaluate_type y context in
+      Ok (TupleType (xtype, ytype))
+    )
+  | Function (x, typef, fbody) -> (
+      (* first check that the function has the right specified type then check
+         the type of the body using the bindings for the input *)
+      match typef with
+        FunctionType (tin, tout) -> (
+          let* typefbody = evaluate_type fbody (VariableMap.add x tin context) in
+          if (typefbody = tout) then
+            Ok typef
+          else
+            Error (`WrongTypeSpecification
+                     ("Function does not return specified type."))
+        )
+      | _ -> Error (`WrongTypeSpecification
+                      ("Specification of function is not a function type."))
+    )
+  | Application (f, x) -> (
+      let* evalf = evaluate_type f context in
+      let* evalx = evaluate_type x context in
+      match evalf with
+        FunctionType (tin, tout) -> (
+          if tin = evalx then
+            Ok tout
+          else
+            Error (`WrongType "Appling function with wrong input type to value")
+        )
+      | _ -> Error (`WrongType "Applying to a non function type")
+    )
+  | Plus (x, y)
+  | Minus (x, y)
+  | Times (x, y)
+  | Division (x, y)
+  | Modulo (x, y)
+  | Power (x, y) -> (
+      let* typex = evaluate_type x context in
+      let* typey = evaluate_type y context in
+      match typex, typey with
+      | (IntegerType, IntegerType) -> Ok IntegerType
+      | (IntegerType, _) -> Error (`WrongType "Second term is not an integer.")
+      | (_, _) -> Error (`WrongType "First term is not an integer.")
+    )
+  | PowerMod (x, y, z) -> (
+      let* typex = evaluate_type x context in
+      let* typey = evaluate_type y context in
+      let* typez = evaluate_type z context in
+      match typex, typey, typez with
+      | (IntegerType, IntegerType, IntegerType) -> Ok IntegerType
+      | (IntegerType, IntegerType, _) -> Error (`WrongType ("Third term is " ^
+                                                            "not an integer."))
+      | (IntegerType, _, _) -> Error (`WrongType
+                                        ("Second term is not an integer."))
+      | (_, _, _) -> Error (`WrongType "First term is not an integer.")
+    )
+  | Rand (x) -> (
+      let* typex = evaluate_type x context in
+      match typex with
+      | (IntegerType) -> Ok IntegerType
+      | (_) -> Error (`WrongType "Term is not an integer.")
+    )
+  | BAnd (x, y)
+  | BOr (x, y) -> (
+      let* typex = evaluate_type x context in
+      let* typey = evaluate_type y context in
+      match typex, typey with
+      | (BooleanType, BooleanType) -> Ok BooleanType
+      | (BooleanType, _) -> Error (`WrongType "Second term is not a boolean.")
+      | (_, _) -> Error (`WrongType "First term is not a boolean.")
+    )
+  | BNot (x) -> (
+      let* typex = evaluate_type x context in
+      match typex with
+      | (BooleanType) -> Ok BooleanType
+      | (_) -> Error (`WrongType "Term is not a boolean.")
+    )
+  | First (x) -> (
+      let* typex = evaluate_type x context in
+      match typex with
+      | (TupleType (x, _)) -> Ok x
+      | (_) -> Error (`WrongType "Term is not a tuple.")
+    )
+  | Second (x) -> (
+      let* typex = evaluate_type x context in
+      match typex with
+      | (TupleType (_, x)) -> Ok x
+      | (_) -> Error (`WrongType "Term is not a tuple.")
+    )
+  | Cmp (x, y)
+  | CmpLess (x, y)
+  | CmpLessEq (x, y)
+  | CmpGreater (x, y)
+  | CmpGreaterEq (x, y) -> (
+      let* typex = evaluate_type x context in
+      let* typey = evaluate_type y context in
+      match typex, typey with
+      | (IntegerType, IntegerType) -> Ok BooleanType
+      | (IntegerType, _) -> Error (`WrongType "Second term is not an integer.")
+      | (_, _) -> Error (`WrongType "First term is not an integer.")
+    )
+  | IfThenElse (guard, if_exp, else_exp) -> (
+      let* typeguard = evaluate_type guard context in
+      let* typeif_exp = evaluate_type if_exp context in
+      let* typeelse_exp = evaluate_type else_exp context in
+      match typeguard, typeif_exp, typeelse_exp with
+        (BooleanType, t1, t2) -> (
+          if t1 = t2 then
+            Ok t1
+          else
+            Error (`WrongType "If branches do not have the same type.")
+        )
+      | (_, _, _) -> Error (`WrongType "If guard is not a boolean.")
+    )
+  | LetIn (x, xval, rest) ->
+    (* bind the type to the variable name in the context *)
+    let* typex = evaluate_type xval context in
+    evaluate_type rest (VariableMap.add x typex context)
+  | LetFun (f, x, typef, fbody, rest) ->
+    (* like with the function case, but also add f itself to the bindings *)
+    match typef with
+      FunctionType (tin, tout) -> (
+        let newcontext = VariableMap.add f typef context in
+        let newcontextwithx = VariableMap.add x tin newcontext in
+        let* typefbody = evaluate_type fbody newcontextwithx in
+        let* typerest = evaluate_type rest newcontext in
+        match (typefbody = tout, typerest) with
+          (false, _) -> Error (`WrongTypeSpecification
+                                 "Function does not return specified type.")
+        | (true, t) -> Ok t
+      )
+    | _ -> Error (`WrongTypeSpecification
+                    "Specification of function is not a function type.")
+
+let typecheck (program: t_exp) : (ftype, [> typechecking_error]) result =
+  let* typeprogram = evaluate_type program VariableMap.empty in
+  match typeprogram with
+    FunctionType (IntegerType, IntegerType) -> (
+      Ok (typeprogram)
+    )
+  | _ -> Error (`WrongType "Program is not a function from int to int.")

lib/miniFun/TypeChecker.mli

@@ -1 +1 @@
-val typecheck : Types.t_exp -> (Types.ftype, Types.error) result
+val typecheck : Types.t_exp -> (Types.ftype, [> Types.typechecking_error]) result

lib/miniFun/Types.ml

@@ -8,8 +8,9 @@ module VariableSet = Set.Make(String)
 type ftype =
     IntegerType
   | BooleanType
+  | TupleType of ftype * ftype
   | PolimorphicType of string
-  | FunctionType of ftype list * ftype
+  | FunctionType of ftype * ftype
 type fsubstitution = (* goes from polimorphic types to types *)
   ftype VariableMap.t
 type fenvironment = (* goes from variables to types *)
@@ -21,8 +22,9 @@ type t_exp =
     Integer of int                                             (* x := a *)
   | Boolean of bool                                            (* v *)
   | Variable of variable                                       (* x *)
-  | Function of variable list * ftype * t_exp                  (* lambda x: t. x *)
+  | Tuple of t_exp * t_exp                                     (* (a, b) *)
-  | Application of t_exp * t_exp list                          (* x x *)
+  | Function of variable * ftype * t_exp                       (* lambda x: t. x *)
+  | Application of t_exp * t_exp                               (* x x *)
   | Plus of t_exp * t_exp                                      (* x + x *)
   | Minus of t_exp * t_exp                                     (* x - x *)
   | Times of t_exp * t_exp                                     (* x * x *)
@@ -31,9 +33,11 @@ type t_exp =
   | Power of t_exp * t_exp                                     (* x ^ x *)
   | PowerMod of t_exp * t_exp * t_exp                          (* (x ^ x) % x *)
   | Rand of t_exp                                              (* rand(0, x) *)
-  | BAnd of t_exp * t_exp                                      (* x and x *)
+  | BAnd of t_exp * t_exp                                      (* x && x *)
-  | BOr of t_exp * t_exp                                       (* x or x *)
+  | BOr of t_exp * t_exp                                       (* x || x *)
   | BNot of t_exp                                              (* not x *)
+  | First of t_exp                                             (* fst x *)
+  | Second of t_exp                                            (* scn x *)
   | Cmp of t_exp * t_exp                                       (* x == x *)
   | CmpLess of t_exp * t_exp                                   (* x < x *)
   | CmpLessEq of t_exp * t_exp                                 (* x <= x *)
@@ -41,14 +45,15 @@ type t_exp =
   | CmpGreaterEq of t_exp * t_exp                              (* x >= x *)
   | IfThenElse of t_exp * t_exp * t_exp                        (* if b then c else c *)
   | LetIn of variable * t_exp * t_exp                          (* let x = x in x *)
-  | LetFun of variable * variable list * ftype * t_exp * t_exp (* let rec x: t. x in x *)
+  | LetFun of variable * variable * ftype * t_exp * t_exp      (* let rec x. y: t. x in x*)
 
 type permittedValues =
-    IntegerPermitted of int
+    IntegerPermitted  of int
-  | BooleanPermitted of bool
+  | BooleanPermitted  of bool
+  | TuplePermitted    of permittedValues * permittedValues
   | FunctionPermitted of closure
 and closure = {
-  inputList: variable list;
+  input: variable;
   body: t_exp;
   assignments: permittedValues VariableMap.t;
   recursiveness: variable option
@@ -58,10 +63,18 @@ type memory = {
   assignments: permittedValues VariableMap.t
 }
 
-type error = [
+
+type base_error = [
     `AbsentAssignment of string
   | `WrongType of string
-  | `DivisionByZero of string
+]
-  | `WrongArity of string
+
+type typechecking_error = [
+  | base_error
   | `WrongTypeSpecification of string
 ]
+
+type error = [
+  | base_error
+  | `DivisionByZero of string
+]

lib/miniFun/Types.mli

@@ -8,8 +8,9 @@ module VariableSet : Set.S with type elt = string
 type ftype =
     IntegerType
   | BooleanType
+  | TupleType of ftype * ftype
   | PolimorphicType of variable
-  | FunctionType of ftype list * ftype
+  | FunctionType of ftype * ftype
 type fsubstitution = (* goes from polimorphic types to types *)
   ftype VariableMap.t
 type fenvironment = (* goes from variables to types *)
@@ -47,8 +48,9 @@ type t_exp =
     Integer of int                                             (* x := a *)
   | Boolean of bool                                            (* v *)
   | Variable of variable                                       (* x *)
-  | Function of variable list * ftype * t_exp                  (* lambda x: t. x *)
+  | Tuple of t_exp * t_exp                                     (* (a, b) *)
-  | Application of t_exp * t_exp list                          (* x x *)
+  | Function of variable * ftype * t_exp                       (* lambda x: t. x *)
+  | Application of t_exp * t_exp                               (* x x *)
   | Plus of t_exp * t_exp                                      (* x + x *)
   | Minus of t_exp * t_exp                                     (* x - x *)
   | Times of t_exp * t_exp                                     (* x * x *)
@@ -57,9 +59,11 @@ type t_exp =
   | Power of t_exp * t_exp                                     (* x ^ x *)
   | PowerMod of t_exp * t_exp * t_exp                          (* (x ^ x) % x *)
   | Rand of t_exp                                              (* rand(0, x) *)
-  | BAnd of t_exp * t_exp                                      (* x and x *)
+  | BAnd of t_exp * t_exp                                      (* x && x *)
-  | BOr of t_exp * t_exp                                       (* x or x *)
+  | BOr of t_exp * t_exp                                       (* x || x *)
   | BNot of t_exp                                              (* not x *)
+  | First of t_exp                                             (* fst x *)
+  | Second of t_exp                                            (* scn x *)
   | Cmp of t_exp * t_exp                                       (* x == x *)
   | CmpLess of t_exp * t_exp                                   (* x < x *)
   | CmpLessEq of t_exp * t_exp                                 (* x <= x *)
@@ -67,14 +71,15 @@ type t_exp =
   | CmpGreaterEq of t_exp * t_exp                              (* x >= x *)
   | IfThenElse of t_exp * t_exp * t_exp                        (* if b then c else c *)
   | LetIn of variable * t_exp * t_exp                          (* let x = x in x *)
-  | LetFun of variable * variable list * ftype * t_exp * t_exp (* let rec x: t. x in x *)
+  | LetFun of variable * variable * ftype * t_exp * t_exp      (* let rec x. y: t. x in x*)
 
 type permittedValues =
-    IntegerPermitted of int
+    IntegerPermitted  of int
-  | BooleanPermitted of bool
+  | BooleanPermitted  of bool
+  | TuplePermitted    of permittedValues * permittedValues
   | FunctionPermitted of closure
 and closure = {
-  inputList: variable list;
+  input: variable;
   body: t_exp;
   assignments: permittedValues VariableMap.t;
   recursiveness: variable option
@@ -84,10 +89,18 @@ type memory = {
   assignments: permittedValues VariableMap.t
 }
 
-type error = [
+
+type base_error = [
     `AbsentAssignment of string
   | `WrongType of string
-  | `DivisionByZero of string
+]
-  | `WrongArity of string
+
+type typechecking_error = [
+  | base_error
   | `WrongTypeSpecification of string
 ]
+
+type error = [
+  | base_error
+  | `DivisionByZero of string
+]

lib/miniFun/dune

@@ -0,0 +1,16 @@
+(ocamllex Lexer)
+
+(menhir
+ (modules Parser)
+ (explain true)
+ (infer true)
+ (flags --dump --table)
+ )
+
+(library
+ (name miniFun)
+ (public_name miniFun)
+ (modules Lexer Parser Types Semantics TypeChecker)
+ (libraries utility menhirLib))
+
+(include_subdirs qualified)

lib/miniImp/Cfg.ml

@@ -0,0 +1,316 @@
+type simpleStatements =
+  | SimpleSkip
+  | SimpleAssignment of Types.variable * simpleArithmetic
+  | SimpleGuard of simpleBoolean
+and simpleBoolean =
+  | SimpleBoolean of bool
+  | SimpleBAnd of simpleBoolean * simpleBoolean
+  | SimpleBOr of simpleBoolean * simpleBoolean
+  | SimpleBNot of simpleBoolean
+  | SimpleBCmp of simpleArithmetic * simpleArithmetic
+  | SimpleBCmpLess of simpleArithmetic * simpleArithmetic
+  | SimpleBCmpLessEq of simpleArithmetic * simpleArithmetic
+  | SimpleBCmpGreater of simpleArithmetic * simpleArithmetic
+  | SimpleBCmpGreaterEq of simpleArithmetic * simpleArithmetic
+and simpleArithmetic =
+  | SimpleVariable of Types.variable
+  | SimpleInteger of int
+  | SimplePlus of simpleArithmetic * simpleArithmetic
+  | SimpleMinus of simpleArithmetic * simpleArithmetic
+  | SimpleTimes of simpleArithmetic * simpleArithmetic
+  | SimpleDivision of simpleArithmetic * simpleArithmetic
+  | SimpleModulo of simpleArithmetic * simpleArithmetic
+  | SimplePower of simpleArithmetic * simpleArithmetic
+  | SimplePowerMod of simpleArithmetic * simpleArithmetic * simpleArithmetic
+  | SimpleRand of simpleArithmetic
+
+let printSingleStatement (ppf) (c: simpleStatements) : unit =
+  let rec helper_c (ppf) (c: simpleStatements) : unit =
+    match c with
+    | SimpleSkip -> Printf.fprintf ppf "Skip"
+    | SimpleAssignment (v, a) -> Printf.fprintf ppf "Assignment {%s, %a}" v helper_a a
+    | SimpleGuard (b) -> Printf.fprintf ppf "Guard {%a}" helper_b b
+  and helper_b (ppf) (c: simpleBoolean) : unit =
+    match c with
+    | SimpleBoolean b -> Printf.fprintf ppf "%b" b
+    | SimpleBAnd (b1, b2) -> Printf.fprintf ppf "{%a && %a}" helper_b b1 helper_b b2
+    | SimpleBOr (b1, b2) -> Printf.fprintf ppf "{%a || %a}" helper_b b1 helper_b b2
+    | SimpleBNot b -> Printf.fprintf ppf "{not %a}" helper_b b
+    | SimpleBCmp (a1, a2) -> Printf.fprintf ppf "{%a == %a}" helper_a a1 helper_a a2
+    | SimpleBCmpLess (a1, a2) -> Printf.fprintf ppf "{%a < %a}" helper_a a1 helper_a a2
+    | SimpleBCmpLessEq (a1, a2) -> Printf.fprintf ppf "{%a <= %a}" helper_a a1 helper_a a2
+    | SimpleBCmpGreater (a1, a2) -> Printf.fprintf ppf "{%a > %a}" helper_a a1 helper_a a2
+    | SimpleBCmpGreaterEq (a1, a2) -> Printf.fprintf ppf "{%a >= %a}" helper_a a1 helper_a a2
+  and helper_a (ppf) (c: simpleArithmetic) : unit =
+    match c with
+    | SimpleVariable (v) -> Printf.fprintf ppf "%s" v
+    | SimpleInteger (i) -> Printf.fprintf ppf "%d" i
+    | SimplePlus (a1, a2) -> Printf.fprintf ppf "{%a + %a}" helper_a a1 helper_a a2
+    | SimpleMinus (a1, a2) -> Printf.fprintf ppf "{%a - %a}" helper_a a1 helper_a a2
+    | SimpleTimes (a1, a2) -> Printf.fprintf ppf "{%a * %a}" helper_a a1 helper_a a2
+    | SimpleDivision (a1, a2) -> Printf.fprintf ppf "{%a / %a}" helper_a a1 helper_a a2
+    | SimpleModulo (a1, a2) -> Printf.fprintf ppf "{%a %% %a}" helper_a a1 helper_a a2
+    | SimplePower (a1, a2) -> Printf.fprintf ppf "{%a ^ %a}" helper_a a1 helper_a a2
+    | SimplePowerMod (a1, a2, a3) -> Printf.fprintf ppf "{powmod %a %a %a}" helper_a a1 helper_a a2 helper_a a3
+    | SimpleRand (a) -> Printf.fprintf ppf "{rand %a}" helper_a a
+  in
+  helper_c ppf c
+
+let printSimpleStatements (ppf) (c: simpleStatements list) : unit =
+  List.iter (fun x -> printSingleStatement ppf x; Printf.printf "; ") c
+
+
+
+let globalIdNode = ref 0;
+
+module Node = struct
+  type t = {
+    id: int
+  }
+  let compare a b = compare a.id b.id
+
+  let newNode () =
+    globalIdNode := !globalIdNode + 1;
+    {id = !globalIdNode}
+end
+;;
+
+module NodeMap = Map.Make(Node)
+module NodeSet = Set.Make(Node)
+
+module Cfg = struct
+  type t = {
+    empty: bool;
+    nodes: NodeSet.t;
+    edges: (Node.t * (Node.t option)) NodeMap.t;
+    reverseedges: (Node.t list) NodeMap.t;
+    initial: Node.t option;
+    terminal: Node.t option;
+    code: (simpleStatements list) NodeMap.t
+  }
+
+  let newCfg () =
+    { empty = true;
+      nodes = NodeSet.empty;
+      edges = NodeMap.empty;
+      reverseedges = NodeMap.empty;
+      initial = None;
+      terminal = None;
+      code = NodeMap.empty }
+
+  let mergeCfg (cfg1: t) (cfg2: t) (entryNode: Node.t) (exitNode: Node.t) : t =
+    match (cfg1.empty, cfg2.empty) with
+      true, _ -> cfg2
+    | _, true -> cfg1
+    | false, false ->
+      let cfg1initial = Option.get cfg1.initial in
+      let cfg2initial = Option.get cfg2.initial in
+      let cfg1terminal = Option.get cfg1.terminal in
+      let cfg2terminal = Option.get cfg2.terminal in
+      { empty = false;
+        nodes = NodeSet.union cfg1.nodes cfg2.nodes |>
+                NodeSet.add entryNode |>
+                NodeSet.add exitNode;
+        edges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
+            cfg1.edges cfg2.edges |>
+                NodeMap.add entryNode (cfg1initial, Some cfg2initial) |>
+                NodeMap.add cfg1terminal (exitNode, None) |>
+                NodeMap.add cfg2terminal (exitNode, None);
+        reverseedges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
+            cfg1.reverseedges cfg2.reverseedges |>
+                       NodeMap.add_to_list cfg1initial entryNode |>
+                       NodeMap.add_to_list cfg2initial entryNode |>
+                       NodeMap.add_to_list exitNode cfg1terminal |>
+                       NodeMap.add_to_list exitNode cfg2terminal;
+        initial = Some entryNode;
+        terminal = Some exitNode;
+        code = NodeMap.union (fun _ -> failwith "Failed merging code of cfg.")
+            cfg1.code cfg2.code
+      }
+
+  let concatCfg (cfg1: t) (cfg2: t) : t =
+    match (cfg1.empty, cfg2.empty) with
+      true, _ -> cfg2
+    | _, true -> cfg1
+    | false, false ->
+      let cfg1initial = Option.get cfg1.initial in
+      let cfg2initial = Option.get cfg2.initial in
+      let cfg1terminal = Option.get cfg1.terminal in
+      let cfg2terminal = Option.get cfg2.terminal in
+      { empty = false;
+        nodes = NodeSet.union cfg1.nodes cfg2.nodes;
+        edges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
+                              cfg1.edges cfg2.edges |>
+                NodeMap.add cfg1terminal (cfg2initial, None);
+        reverseedges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
+            cfg1.reverseedges cfg2.reverseedges |>
+                       NodeMap.add_to_list cfg2initial cfg1terminal;
+        initial = Some cfg1initial;
+        terminal = Some cfg2terminal;
+        code = NodeMap.union (fun _ -> failwith "Failed merging code of cfg.")
+            cfg1.code cfg2.code
+      }
+
+  let addToLastNode (newcode: simpleStatements) (cfg: t) : t =
+    match cfg.empty with
+    | true -> let newnode = Node.newNode () in
+      { empty = false;
+        nodes = NodeSet.singleton newnode;
+        edges = NodeMap.empty;
+        reverseedges = NodeMap.empty;
+        initial = Some newnode;
+        terminal = Some newnode;
+        code = NodeMap.singleton newnode [newcode]
+      }
+    | false ->
+      let prevcfgterminal = Option.get cfg.terminal in
+      { cfg with
+        code = (NodeMap.add_to_list
+                  prevcfgterminal
+                  newcode
+                  cfg.code) }
+
+  let pp (ppf) (c: t) : unit =
+    Printf.fprintf ppf "Nodes' ids: ";
+    List.iter (fun (x : Node.t) -> Printf.fprintf ppf "%d " x.id) (NodeSet.to_list c.nodes);
+    Printf.fprintf ppf "\n";
+
+    Printf.fprintf ppf "Nodes' edges:\n";
+    List.iter (fun ((n, (a, b)) : (Node.t * (Node.t * Node.t option))) : unit ->
+        match b with None -> Printf.fprintf ppf "\t%d -> %d\n" n.id a.id
+                   | Some b -> Printf.fprintf ppf "\t%d -> %d, %d\n" n.id a.id b.id
+      ) (NodeMap.to_list c.edges);
+    Printf.fprintf ppf "\n";
+
+    Printf.fprintf ppf "Nodes' back edges:\n";
+    List.iter (fun ((n, xs) : (Node.t * (Node.t list))) : unit ->
+        Printf.fprintf ppf "\t%d -> " n.id;
+        List.iter (fun (x: Node.t) -> Printf.fprintf ppf "%d, " x.id) xs;
+        Printf.fprintf ppf "\n"
+      ) (NodeMap.to_list c.reverseedges);
+    Printf.fprintf ppf "\n";
+
+    Printf.fprintf ppf "Initial node's id: ";
+    Printf.fprintf ppf "%d" ((Option.get c.initial).id);
+    Printf.fprintf ppf "\n";
+
+    Printf.fprintf ppf "Terminal node's id: ";
+    Printf.fprintf ppf "%d" ((Option.get c.terminal).id);
+    Printf.fprintf ppf "\n";
+
+    Printf.fprintf ppf "Code:\n";
+    List.iter (fun ((n, stms) : Node.t * simpleStatements list) : unit ->
+        Printf.fprintf ppf "\tid %d --> %a\n%!" n.id printSimpleStatements (List.rev stms)
+      ) (NodeMap.to_list c.code);
+    Printf.fprintf ppf "\n";
+end
+;;
+
+
+let rec convert_c (prevcfg: Cfg.t) (prg: Types.c_exp) : Cfg.t =
+  match prg with
+  | Skip -> prevcfg |> Cfg.addToLastNode SimpleSkip
+  | Assignment (x, a) -> prevcfg |> Cfg.addToLastNode (SimpleAssignment (x, convert_a a))
+  | Sequence (c1, c2) ->
+    let cfg1 = convert_c prevcfg c1 in
+    let cfg2 = convert_c cfg1 c2 in
+    cfg2
+  | If (b, c1, c2) ->
+    let convertedb = convert_b b in
+    let cfg1 = convert_c (Cfg.newCfg ()) c1 in
+    let cfg2 = convert_c (Cfg.newCfg ()) c2 in
+    let entrynode = Node.newNode () in
+    let exitnode = Node.newNode () in
+    let newcfg = Cfg.mergeCfg cfg1 cfg2 entrynode exitnode in
+    let mergedcfg = Cfg.concatCfg prevcfg newcfg in
+    { mergedcfg with
+      code = mergedcfg.code |>
+             NodeMap.add_to_list entrynode (SimpleGuard convertedb) |>
+             NodeMap.add_to_list exitnode (SimpleSkip) }
+  | While (b, c) ->
+    let convertedb = convert_b b in
+    let cfg = convert_c (Cfg.newCfg ()) c in
+    let cfginitial = Option.get cfg.initial in
+    let cfgterminal = Option.get cfg.terminal in
+    let entrynode = Node.newNode () in
+    let guardnode = Node.newNode () in
+    let exitnode = Node.newNode () in
+    { empty = false;
+      nodes = cfg.nodes |>
+              NodeSet.add entrynode |>
+              NodeSet.add guardnode |>
+              NodeSet.add exitnode;
+      edges = cfg.edges |>
+              NodeMap.add entrynode (guardnode, None) |>
+              NodeMap.add guardnode (cfginitial, Some exitnode) |>
+              NodeMap.add cfgterminal (guardnode, None);
+      reverseedges = cfg.reverseedges |>
+                     NodeMap.add_to_list guardnode entrynode |>
+                     NodeMap.add_to_list cfginitial guardnode |>
+                     NodeMap.add_to_list exitnode guardnode |>
+                     NodeMap.add_to_list guardnode cfgterminal;
+      initial = Some entrynode;
+      terminal = Some exitnode;
+      code = NodeMap.add_to_list guardnode (SimpleGuard (convertedb)) cfg.code |>
+             NodeMap.add_to_list exitnode (SimpleSkip)
+    } |> Cfg.concatCfg prevcfg
+  | For (assignment, guard, increment, body) ->
+    let cfgassignment = convert_c (Cfg.newCfg ()) assignment in
+    let convertedguard = convert_b guard in
+    let cfgincrement = convert_c (Cfg.newCfg ()) increment in
+    let cfgbody = convert_c (Cfg.newCfg ()) body in
+
+    let prevassignment = Cfg.concatCfg prevcfg cfgassignment in
+    let bodyincrement = Cfg.concatCfg cfgbody cfgincrement in
+
+    let cfginitial = Option.get bodyincrement.initial in
+    let cfgterminal = Option.get bodyincrement.terminal in
+
+    let guardnode = Node.newNode () in
+    let exitnode = Node.newNode () in
+    { empty = false;
+      nodes = bodyincrement.nodes |>
+              NodeSet.add guardnode |>
+              NodeSet.add exitnode;
+      edges = bodyincrement.edges |>
+              NodeMap.add guardnode (cfginitial, Some exitnode) |>
+              NodeMap.add cfgterminal (guardnode, None);
+      reverseedges = bodyincrement.reverseedges |>
+                     NodeMap.add_to_list cfginitial guardnode |>
+                     NodeMap.add_to_list exitnode guardnode |>
+                     NodeMap.add_to_list guardnode cfgterminal;
+      initial = Some guardnode;
+      terminal = Some exitnode;
+      code = NodeMap.add_to_list guardnode (SimpleGuard (convertedguard)) bodyincrement.code |>
+             NodeMap.add_to_list exitnode (SimpleSkip)
+    } |> Cfg.concatCfg prevassignment
+
+and convert_b (prg: Types.b_exp) : simpleBoolean =
+  match prg with
+  | Boolean (b) -> SimpleBoolean b
+  | BAnd (b1, b2) -> SimpleBAnd (convert_b b1, convert_b b2)
+  | BOr (b1, b2) -> SimpleBOr (convert_b b1, convert_b b2)
+  | BNot (b) -> SimpleBNot (convert_b b)
+  | BCmp (a1, a2) -> SimpleBCmp (convert_a a1, convert_a a2)
+  | BCmpLess (a1, a2) -> SimpleBCmpLess (convert_a a1, convert_a a2)
+  | BCmpLessEq (a1, a2) -> SimpleBCmpLessEq (convert_a a1, convert_a a2)
+  | BCmpGreater (a1, a2) -> SimpleBCmpGreater (convert_a a1, convert_a a2)
+  | BCmpGreaterEq (a1, a2) -> SimpleBCmpGreaterEq (convert_a a1, convert_a a2)
+
+and convert_a (prg: Types.a_exp) : simpleArithmetic =
+  match prg with
+  | Variable x -> SimpleVariable x
+  | Integer n -> SimpleInteger n
+  | Plus (a1, a2) -> SimplePlus (convert_a a1, convert_a a2)
+  | Minus (a1, a2) -> SimpleMinus (convert_a a1, convert_a a2)
+  | Times (a1, a2) -> SimpleTimes (convert_a a1, convert_a a2)
+  | Division (a1, a2) -> SimpleDivision (convert_a a1, convert_a a2)
+  | Modulo (a1, a2) -> SimpleModulo (convert_a a1, convert_a a2)
+  | Power (a1, a2) -> SimplePower (convert_a a1, convert_a a2)
+  | PowerMod (a1, a2, a3) -> SimplePowerMod (convert_a a1, convert_a a2, convert_a a3)
+  | Rand (a) -> SimpleRand (convert_a a)
+
+let convert (prg: Types.p_exp) : Cfg.t =
+  match prg with
+  | Main (_, _, exp) ->
+    convert_c (Cfg.newCfg ()) exp

lib/miniImp/Cfg.mli

@@ -0,0 +1,40 @@
+type simpleStatements =
+  | SimpleSkip
+  | SimpleAssignment of Types.variable * simpleArithmetic
+  | SimpleGuard of simpleBoolean
+and simpleBoolean =
+  | SimpleBoolean of bool
+  | SimpleBAnd of simpleBoolean * simpleBoolean
+  | SimpleBOr of simpleBoolean * simpleBoolean
+  | SimpleBNot of simpleBoolean
+  | SimpleBCmp of simpleArithmetic * simpleArithmetic
+  | SimpleBCmpLess of simpleArithmetic * simpleArithmetic
+  | SimpleBCmpLessEq of simpleArithmetic * simpleArithmetic
+  | SimpleBCmpGreater of simpleArithmetic * simpleArithmetic
+  | SimpleBCmpGreaterEq of simpleArithmetic * simpleArithmetic
+and simpleArithmetic =
+  | SimpleVariable of Types.variable
+  | SimpleInteger of int
+  | SimplePlus of simpleArithmetic * simpleArithmetic
+  | SimpleMinus of simpleArithmetic * simpleArithmetic
+  | SimpleTimes of simpleArithmetic * simpleArithmetic
+  | SimpleDivision of simpleArithmetic * simpleArithmetic
+  | SimpleModulo of simpleArithmetic * simpleArithmetic
+  | SimplePower of simpleArithmetic * simpleArithmetic
+  | SimplePowerMod of simpleArithmetic * simpleArithmetic * simpleArithmetic
+  | SimpleRand of simpleArithmetic
+
+module Node : sig
+  type t
+  val compare : t -> t -> int
+end
+
+module NodeMap : Map.S with type key = Node.t
+module NodeSet : Set.S with type elt = Node.t
+
+module Cfg : sig
+  type t
+  val pp : out_channel -> t -> unit
+end
+
+val convert : Types.p_exp -> Cfg.t

lib/miniImp/Lexer.mll

@@ -0,0 +1,92 @@
+{
+  open Parser
+  exception LexingError of string
+
+  let create_hashtable size init =
+    let tbl = Hashtbl.create size in
+    List.iter (fun (key, data) -> Hashtbl.add tbl key data) init;
+    tbl
+
+  let keyword_table =
+    let mapping = [
+      ("as", AS);
+      ("def", DEF);
+      ("do", DO);
+      ("else", ELSE);
+      ("false", BOOL(false));
+      ("for", FOR);
+      ("if", IF);
+      ("input", INPUT);
+      ("main", MAIN);
+      ("not", BNOT);
+      ("output", OUTPUT);
+      ("powmod", POWERMOD);
+      ("rand", RAND);
+      ("skip", SKIP);
+      ("then", THEN);
+      ("true", BOOL(true));
+      ("while", WHILE);
+      ("with", WITH);
+    ]
+    in create_hashtable (List.length mapping) mapping
+}
+
+let digit   = ['0'-'9']
+let alpha   = ['a'-'z' 'A'-'Z']
+let white   = [' ' '\t']+ | '\r' | '\n' | "\r\n"
+
+let integer = (digit)(digit*)
+let var     = (alpha|'_') (alpha|digit|'_')*
+
+let symbols = ['!'-'/' ':'-'?' '[' ']' '^' '{'-'}' '~']
+
+(* lexing rules *)
+rule read = parse
+  | white           {read lexbuf}
+  | var as v        {
+      match Hashtbl.find_opt keyword_table v with
+      | Some keyword -> keyword
+      | None -> VARIABLE(v)
+    }
+  | "%"             {MODULO}
+  | "&&"            {BAND}
+  | "("             {LEFTPAR}
+  | ")"             {RIGHTPAR}
+  | "*"             {TIMES}
+  | "+"             {PLUS}
+  | ","             {COMMA}
+  | "-"             {MINUS}
+  | "/"             {DIVISION}
+  | ":="            {ASSIGNMENT}
+  | ";"             {SEQUENCE}
+  | "<"             {BCMPLESS}
+  | "<="            {BCMPLESSEQ}
+  | "=="            {BCMP}
+  | ">"             {BCMPGREATER}
+  | ">="            {BCMPGREATEREQ}
+  | "^"             {POWER}
+  | "||"            {BOR}
+  | integer as i    {INT(int_of_string i)}
+  | "(*"            {comments 0 lexbuf}
+  | eof             {EOF}
+  | _               {
+      raise
+        (LexingError
+           (Printf.sprintf
+              "Error scanning %s on line %d at char %d"
+              (Lexing.lexeme lexbuf)
+              (lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum)
+              (lexbuf.Lexing.lex_curr_p.Lexing.pos_lnum)
+           ))}
+and comments level = parse
+  | "*)"    {if level = 0
+             then read lexbuf
+             else comments (level-1) lexbuf}
+  | "(*"    {comments (level+1) lexbuf}
+  | _       {comments level lexbuf}
+  | eof     {raise (LexingError ("Comment is not closed"))}
+
+
+{
+  let lex = read
+}

lib/miniImp/Parser.mly

@@ -0,0 +1,85 @@
+(* code to be copied in the scanner module *)
+(*
+*)
+%{
+  open Types
+%}
+
+(* tokens *)
+%token MAIN DEF WITH INPUT OUTPUT AS SKIP ASSIGNMENT SEQUENCE IF THEN ELSE WHILE
+%token FOR DO COMMA LEFTPAR RIGHTPAR
+%token PLUS MINUS TIMES DIVISION MODULO POWER POWERMOD RAND
+%token BAND BOR BNOT BCMP BCMPLESS BCMPLESSEQ BCMPGREATER BCMPGREATEREQ
+%token <bool> BOOL
+%token <int> INT
+%token <string> VARIABLE
+%token EOF
+
+%type <c_exp> cexpp
+%type <b_exp> bexpp
+%type <a_exp> aexpp
+%type <p_exp> prg
+
+(* start nonterminal *)
+%start prg
+
+(* associativity in order of precedence *)
+%left lowest
+%left SEQUENCE
+%left ELSE
+%left PLUS MINUS BOR BAND
+%left BNOT
+%left DIVISION
+%left MODULO
+%left TIMES
+%left POWER
+%left DO
+
+%%
+
+(* grammar *)
+prg:
+  | DEF; MAIN; WITH; INPUT; a = VARIABLE; OUTPUT; b = VARIABLE; AS; t = cexpp; EOF
+    {Main (a, b, t)}                   // def main with input a output b as t
+cexpp:
+  | SKIP {Skip}                        // skip
+  | a = VARIABLE; ASSIGNMENT; body = aexpp
+    {Assignment (a, body)}             // a := body
+  | t1 = cexpp; SEQUENCE; t2 = cexpp %prec lowest
+    {Sequence (t1, t2)}                // t1; t2
+  | t = cexpp; SEQUENCE                {t} // t;
+  | IF; guard = bexpp; THEN; body1 = cexpp; ELSE; body2 = cexpp
+    {If (guard, body1, body2)}         // if ... then ... else ...
+  | WHILE; guard = bexpp; DO; body = cexpp;
+    {While (guard, body)}              // while ... do ...
+  | FOR; LEFTPAR; ass = cexpp; COMMA; guard = bexpp; COMMA; iter = cexpp; RIGHTPAR;
+         DO; body = cexpp;
+    {For (ass, guard, iter, body)}     // for (..., ..., ...) do ...
+  | LEFTPAR; t = cexpp; RIGHTPAR {t}   // (...)
+bexpp:
+  | b = BOOL                              {Boolean (b)} // true, false
+  | b1 = bexpp; BAND; b2 = bexpp          {BAnd (b1, b2)} // &&
+  | b1 = bexpp; BOR; b2 = bexpp           {BOr (b1, b2)} // ||
+  | BNOT; b = bexpp                       {BNot (b)} // not
+  | a1 = aexpp; BCMP; a2 = aexpp          {BCmp (a1, a2)} // ==
+  | a1 = aexpp; BCMPLESS; a2 = aexpp      {BCmpLess (a1, a2)} // <
+  | a1 = aexpp; BCMPLESSEQ; a2 = aexpp    {BCmpLessEq (a1, a2)} // <=
+  | a1 = aexpp; BCMPGREATER; a2 = aexpp   {BCmpGreater (a1, a2)} // >
+  | a1 = aexpp; BCMPGREATEREQ; a2 = aexpp {BCmpGreaterEq (a1, a2)} // >=
+  | LEFTPAR; b = bexpp; RIGHTPAR          {b} // (b)
+aexpp:
+  | a = VARIABLE                          {Variable (a)}
+  | i = INT                               {Integer (i)}
+  | t1 = aexpp; PLUS; t2 = aexpp          {Plus (t1, t2)} // +
+  | t1 = aexpp; MINUS; t2 = aexpp         {Minus (t1, t2)} // -
+  | MINUS; i = INT                        {Integer (-i)}
+  | t1 = aexpp; TIMES; t2 = aexpp         {Times (t1, t2)} // *
+  | t1 = aexpp; DIVISION; t2 = aexpp      {Division (t1, t2)} // /
+  | t1 = aexpp; MODULO; t2 = aexpp        {Modulo (t1, t2)} // %
+  | t1 = aexpp; POWER; t2 = aexpp         {Power (t1, t2)} // ^
+  | POWERMOD; LEFTPAR; t1 = aexpp; COMMA;
+                       t2 = aexpp; COMMA;
+                       t3 = aexpp; RIGHTPAR
+    {PowerMod (t1, t2, t3)}               // powmod(..., ..., ...)
+  | RAND; LEFTPAR; t = aexpp; RIGHTPAR    {Rand (t)} // rand()
+  | LEFTPAR; a = aexpp; RIGHTPAR          {a} // (a)

lib/miniImp/Semantics.ml

@@ -4,139 +4,153 @@ module Utility = Utility;;
 
 Random.self_init ()
 
-let rec evaluate (mem: memory) (command: c_exp) =
+let (let*) = Result.bind
+
+let rec evaluate (mem: memory) (command: c_exp) : (memory, [> error]) result =
   match command with
-    Skip -> mem
+    Skip -> Ok mem
-  | Assignment (v, exp_a) -> {
+  | Assignment (v, exp_a) ->
-      (* Map.add replaces the previeus value *)
+    let* vval = evaluate_a mem exp_a in
-      assignments = VariableMap.add v (evaluate_a mem exp_a) mem.assignments
+    Ok {
+      (* Map.add replaces the previus value *)
+      assignments = VariableMap.add v vval mem.assignments
     }
   | Sequence (exp_c1, exp_c2) -> (
-      let mem2 = evaluate mem exp_c1 in
+      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
+      let* guard = evaluate_b mem exp_b in
+      if guard then
         evaluate mem exp_c1
       else
         evaluate mem exp_c2
     )
   | While (exp_b, exp_c) -> (
-      if evaluate_b mem exp_b then
+      let* guard = evaluate_b mem exp_b in
-        let mem2 = evaluate mem exp_c in
+      if guard then
+        let* mem2 = evaluate mem exp_c in
         evaluate mem2 command
       else
-        mem
+        Ok mem
     )
   | For (exp_c1, exp_b, exp_c2, body_c) -> (
-      let mem2 = evaluate mem exp_c1 in
+      let* mem2 = evaluate mem exp_c1 in
-      let rec f localmem =
+      let rec f (localmem: memory) : (memory, [> error]) result =
-        if (evaluate_b localmem exp_b)
+        let* guard = (evaluate_b localmem exp_b) in
-        then f (
+        if guard
-            let tmpmem = (evaluate localmem body_c) in
+        then
-            (evaluate tmpmem exp_c2))
+            let* stepmem = evaluate localmem body_c in
-        else localmem
+            let* incrementmem = evaluate stepmem exp_c2 in
+            f incrementmem
+        else Ok localmem
       in
       f mem2
     )
 
-and evaluate_a (mem: memory) (exp_a: a_exp) =
+
+and evaluate_a (mem: memory) (exp_a: a_exp) : (int, [> error]) result =
   match exp_a with
     Variable v -> (
       match VariableMap.find_opt v mem.assignments with
-        None -> raise (AbsentAssignment ("The variable " ^ v ^ " is not defined."))
+        None -> Error (`AbsentAssignment ("The variable " ^ v ^ " is not defined."))
-      | Some a -> a
+      | Some a -> Ok a
     )
-  | Integer n -> n
+  | Integer n -> Ok n
   | Plus (exp_a1, exp_a2) -> (
-      let exp_a1val = evaluate_a mem exp_a1 in
+      let* exp_a1val = evaluate_a mem exp_a1 in
-      let exp_a2val = evaluate_a mem exp_a2 in
+      let* exp_a2val = evaluate_a mem exp_a2 in
-      exp_a1val + exp_a2val
+      Ok (exp_a1val + exp_a2val)
     )
   | Minus (exp_a1, exp_a2) -> (
-      let exp_a1val = evaluate_a mem exp_a1 in
+      let* exp_a1val = evaluate_a mem exp_a1 in
-      let exp_a2val = evaluate_a mem exp_a2 in
+      let* exp_a2val = evaluate_a mem exp_a2 in
-      exp_a1val - exp_a2val
+      Ok (exp_a1val - exp_a2val)
     )
   | Times (exp_a1, exp_a2) -> (
-      let exp_a1val = evaluate_a mem exp_a1 in
+      let* exp_a1val = evaluate_a mem exp_a1 in
-      let exp_a2val = evaluate_a mem exp_a2 in
+      let* exp_a2val = evaluate_a mem exp_a2 in
-      exp_a1val * exp_a2val
+      Ok (exp_a1val * exp_a2val)
     )
   | Division (exp_a1, exp_a2) -> (
-      let exp_a1val = evaluate_a mem exp_a1 in
+      let* exp_a1val = evaluate_a mem exp_a1 in
-      let exp_a2val = evaluate_a mem exp_a2 in
+      let* exp_a2val = evaluate_a mem exp_a2 in
       try
-        exp_a1val / exp_a2val
+        Ok (exp_a1val / exp_a2val)
-      with Division_by_zero -> raise (DivisionByZero "Dividing by zero")
+      with Division_by_zero -> Error (`DivisionByZero "Dividing by zero")
     )
   | Modulo (exp_a1, exp_a2) -> (
-      let exp_a1val = evaluate_a mem exp_a1 in
+      let* exp_a1val = evaluate_a mem exp_a1 in
-      let exp_a2val = evaluate_a mem exp_a2 in
+      let* exp_a2val = evaluate_a mem exp_a2 in
-      exp_a1val mod exp_a2val
+      Ok (exp_a1val mod exp_a2val)
     )
   | Power (exp_a1, exp_a2) -> (
-      let exp_a1val = evaluate_a mem exp_a1 in
+      let* exp_a1val = evaluate_a mem exp_a1 in
-      let exp_a2val = evaluate_a mem exp_a2 in
+      let* exp_a2val = evaluate_a mem exp_a2 in
-      Utility.pow exp_a1val exp_a2val
+      Ok (Utility.pow exp_a1val exp_a2val)
     )
   | PowerMod (exp_a1, exp_a2, exp_a3) -> (
-      let exp_a1val = evaluate_a mem exp_a1 in
+      let* exp_a1val = evaluate_a mem exp_a1 in
-      let exp_a2val = evaluate_a mem exp_a2 in
+      let* exp_a2val = evaluate_a mem exp_a2 in
-      let exp_a3val = evaluate_a mem exp_a3 in
+      let* exp_a3val = evaluate_a mem exp_a3 in
-      Utility.powmod exp_a1val exp_a3val exp_a2val
+      Ok (Utility.powmod exp_a1val exp_a3val exp_a2val)
     )
   | Rand (exp_a) -> (
-      Random.int (evaluate_a mem exp_a)
+      let* exp_aval = evaluate_a mem exp_a in
+      Ok (Random.int exp_aval)
     )
-and evaluate_b (mem: memory) (exp_b: b_exp) =
+
+
+and evaluate_b (mem: memory) (exp_b: b_exp) : (bool, [> error]) result =
   match exp_b with
-    Boolean b -> b
+    Boolean b -> Ok b
   | BAnd (exp_b1, exp_b2) -> (
-      let exp_b1val = evaluate_b mem exp_b1 in
+      let* exp_b1val = evaluate_b mem exp_b1 in
-      let exp_b2val = evaluate_b mem exp_b2 in
+      let* exp_b2val = evaluate_b mem exp_b2 in
-      exp_b1val && exp_b2val
+      Ok (exp_b1val && exp_b2val)
     )
   | BOr (exp_b1, exp_b2) -> (
-      let exp_b1val = evaluate_b mem exp_b1 in
+      let* exp_b1val = evaluate_b mem exp_b1 in
-      let exp_b2val = evaluate_b mem exp_b2 in
+      let* exp_b2val = evaluate_b mem exp_b2 in
-      exp_b1val || exp_b2val
+      Ok (exp_b1val || exp_b2val)
     )
   | BNot (exp_b) -> (
-      not (evaluate_b mem exp_b)
+      let* exp_bval = evaluate_b mem exp_b in
+      Ok (not exp_bval)
     )
   | BCmp (exp_a1, exp_a2) -> (
-      let exp_a1val = evaluate_a mem exp_a1 in
+      let* exp_a1val = evaluate_a mem exp_a1 in
-      let exp_a2val = evaluate_a mem exp_a2 in
+      let* exp_a2val = evaluate_a mem exp_a2 in
-      exp_a1val = exp_a2val
+      Ok (exp_a1val = exp_a2val)
     )
   | BCmpLess (exp_a1, exp_a2) -> (
-      let exp_a1val = evaluate_a mem exp_a1 in
+      let* exp_a1val = evaluate_a mem exp_a1 in
-      let exp_a2val = evaluate_a mem exp_a2 in
+      let* exp_a2val = evaluate_a mem exp_a2 in
-      exp_a1val < exp_a2val
+      Ok (exp_a1val < exp_a2val)
     )
   | BCmpLessEq (exp_a1, exp_a2) -> (
-      let exp_a1val = evaluate_a mem exp_a1 in
+      let* exp_a1val = evaluate_a mem exp_a1 in
-      let exp_a2val = evaluate_a mem exp_a2 in
+      let* exp_a2val = evaluate_a mem exp_a2 in
-      exp_a1val <= exp_a2val
+      Ok (exp_a1val <= exp_a2val)
     )
   | BCmpGreater (exp_a1, exp_a2) -> (
-      let exp_a1val = evaluate_a mem exp_a1 in
+      let* exp_a1val = evaluate_a mem exp_a1 in
-      let exp_a2val = evaluate_a mem exp_a2 in
+      let* exp_a2val = evaluate_a mem exp_a2 in
-      exp_a1val > exp_a2val
+      Ok (exp_a1val > exp_a2val)
     )
   | BCmpGreaterEq (exp_a1, exp_a2) -> (
-      let exp_a1val = evaluate_a mem exp_a1 in
+      let* exp_a1val = evaluate_a mem exp_a1 in
-      let exp_a2val = evaluate_a mem exp_a2 in
+      let* exp_a2val = evaluate_a mem exp_a2 in
-      exp_a1val >= exp_a2val
+      Ok (exp_a1val >= exp_a2val)
     )
 
 
-let reduce (program: p_exp) (iin : int) =
+let reduce (program: p_exp) (iin : int) : (int, [> error]) result =
   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
+      let* resultmem : memory = evaluate mem expression in
-        None -> raise (AbsentAssignment ("The output variable is not defined (" ^ vout ^ ")"))
+      match VariableMap.find_opt vout resultmem.assignments with
-      | Some a -> a
+        None -> Error (`AbsentAssignment ("The output variable is not defined (" ^ vout ^ ")"))
+      | Some a -> Ok a
     )

lib/miniImp/Semantics.mli

@@ -1,3 +1,3 @@
 open Types
 
-val reduce : p_exp -> int -> int
+val reduce : p_exp -> int -> (int, [> Types.error]) result

lib/miniImp/Types.ml

@@ -8,13 +8,13 @@ and c_exp =
   | 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 *)
-  | For of c_exp * b_exp * c_exp * c_exp (* for c; b; c do c *)
+  | For of c_exp * b_exp * c_exp * c_exp (* for (c; b; c) do c *)
 and b_exp =
     Boolean of bool                      (* v *)
-  | BAnd of b_exp * b_exp                (* b and b *)
+  | BAnd of b_exp * b_exp                (* b && b *)
-  | BOr of b_exp * b_exp                 (* b or b *)
+  | BOr of b_exp * b_exp                 (* b || b *)
   | BNot of b_exp                        (* not b *)
-  | BCmp of a_exp * a_exp                (* a = a *)
+  | BCmp of a_exp * a_exp                (* a == a *)
   | BCmpLess of a_exp * a_exp            (* a < a *)
   | BCmpLessEq of a_exp * a_exp          (* a <= a *)
   | BCmpGreater of a_exp * a_exp         (* a > a *)
@@ -38,5 +38,7 @@ type memory = {
   assignments: int VariableMap.t
 }
 
-exception AbsentAssignment of string
+type error = [
-exception DivisionByZero of string
+    `AbsentAssignment of string
+  | `DivisionByZero of string
+]

lib/miniImp/Types.mli

@@ -8,13 +8,13 @@ and c_exp =
   | 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 *)
-  | For of c_exp * b_exp * c_exp * c_exp (* for c; b; c do c *)
+  | For of c_exp * b_exp * c_exp * c_exp (* for (c; b; c) do c *)
 and b_exp =
     Boolean of bool                      (* v *)
-  | BAnd of b_exp * b_exp                (* b and b *)
+  | BAnd of b_exp * b_exp                (* b && b *)
-  | BOr of b_exp * b_exp                 (* b or b *)
+  | BOr of b_exp * b_exp                 (* b || b *)
   | BNot of b_exp                        (* not b *)
-  | BCmp of a_exp * a_exp                (* a = a *)
+  | BCmp of a_exp * a_exp                (* a == a *)
   | BCmpLess of a_exp * a_exp            (* a < a *)
   | BCmpLessEq of a_exp * a_exp          (* a <= a *)
   | BCmpGreater of a_exp * a_exp         (* a > a *)
@@ -38,5 +38,7 @@ type memory = {
   assignments: int VariableMap.t
 }
 
-exception AbsentAssignment of string
+type error = [
-exception DivisionByZero of string
+    `AbsentAssignment of string
+  | `DivisionByZero of string
+]

lib/miniImp/dune

@@ -0,0 +1,16 @@
+(ocamllex Lexer)
+
+(menhir
+ (modules Parser)
+ (explain true)
+ (infer true)
+ (flags --dump --table)
+ )
+
+(library
+ (name miniImp)
+ (public_name miniImp)
+ (modules Lexer Parser Types Semantics Cfg)
+ (libraries utility menhirLib))
+
+(include_subdirs qualified)

lib/utility/dune

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

test/dune

@@ -1,11 +1,19 @@
 (test
  (name testingImp)
- (libraries lang))
+ (libraries miniImp))
+
+(test
+ (name testingImpParser)
+ (libraries miniImp))
 
 (test
  (name testingFun)
- (libraries lang))
+ (libraries miniFun))
 
 (test
  (name testingTypeFun)
- (libraries lang))
+ (libraries miniFun))
+
+(test
+ (name testingTypeFunParser)
+ (libraries miniFun))

test/testingFun.ml

@@ -1,59 +1,70 @@
-open Lang.MiniFun
+open MiniFun.Semantics
-open Lang.MiniFunTypes
+open MiniFun.Types
 
 (* -------------------------------------------------------------------------- *)
 (* Identity program *)
 let program =
   Function
-    (["a"],
+    ("a",
-     FunctionType ([IntegerType], IntegerType),
+     FunctionType (IntegerType, IntegerType),
      (Variable "a")
     )
 ;;
 
-Printf.printf "Identity program: %d\n" (Result.get_ok (reduce program 1))
+match reduce program 1 with
+  Ok o ->  Printf.printf "Identity program: %d\n" o
+| Error _ -> Printf.printf "Identity program: error\n"
 
 (* -------------------------------------------------------------------------- *)
 (* Constant program *)
 let program =
   Function
-    (["a"],
+    ("a",
-     FunctionType ([IntegerType], IntegerType),
+     FunctionType (IntegerType, IntegerType),
      (Integer 1)
     )
 ;;
 
-Printf.printf "Constant program: %d\n" (Result.get_ok (reduce program 10))
+match reduce program 10 with
+  Ok o -> Printf.printf "Constant program: %d\n" o
+| Error _ -> Printf.printf "Constant program: error\n"
 
 (* -------------------------------------------------------------------------- *)
 (* Partial application of function program *)
 let program =
   LetIn
     ("f",
-     (Function (["x"; "y"],
+     (Function ("x",
-                FunctionType ([IntegerType; IntegerType], IntegerType),
+                FunctionType (IntegerType, FunctionType (IntegerType, IntegerType)),
-                Plus (Variable "x", Variable "y"))),
+                (Function ("y", FunctionType (IntegerType, IntegerType),
-     (Application (Variable "f", [Integer 3]))
+                           Plus (Variable "x", Variable "y"))
+                )
+               )),
+     (Application (Variable "f", Integer 3))
     )
 ;;
 
-Printf.printf "Partial application of function program: %d\n" (Result.get_ok (reduce program 2))
+match reduce program 2 with
+  Ok o -> Printf.printf "Partial application of function program: %d\n" o
+| Error _ -> Printf.printf "Partial application of function program: error\n"
 
 (* -------------------------------------------------------------------------- *)
 (* Partial application of function program *)
 let program =
   LetFun
     ("f",
-     ["x"],
+     "x",
-     FunctionType ([IntegerType], IntegerType),
+     FunctionType (IntegerType, IntegerType),
-     (Function (["y"],
+     (Function ("y",
-                FunctionType ([IntegerType], IntegerType),
+                FunctionType (IntegerType, IntegerType),
                 Plus (Variable "x", Variable "y"))),
-     (Application (Variable "f", [Integer 3]))
+     (Application (Variable "f", Integer 3))
     )
 ;;
 
-Printf.printf "Partial application of function program: %d\n" (Result.get_ok (reduce program 3))
+match reduce program 3 with
+  Ok o -> Printf.printf "Partial application of function program: %d\n" o
+| Error _ -> Printf.printf "Partial application of function program: error\n"
 
 (* -------------------------------------------------------------------------- *)
 (* Passing functions to functions program *)
@@ -61,18 +72,18 @@ let program =
   LetIn
     ("f",
      (Function (
-         ["z"],
+         "z",
-         FunctionType ([FunctionType ([IntegerType], IntegerType)], IntegerType),
+         FunctionType (FunctionType (IntegerType, IntegerType), IntegerType),
          (Function (
-             ["y"],
+             "y",
-             FunctionType ([FunctionType ([IntegerType], IntegerType)], IntegerType),
+             FunctionType (FunctionType (IntegerType, IntegerType), IntegerType),
              Function (
-               ["x"],
+               "x",
-               FunctionType ([IntegerType], IntegerType),
+               FunctionType (IntegerType, IntegerType),
                (IfThenElse (
                    CmpLess (Variable "x", Integer 0),
-                   (Application (Variable "y", [Variable "x"])),
+                   (Application (Variable "y", Variable "x")),
-                   (Application (Variable "z", [Variable "x"]))
+                   (Application (Variable "z", Variable "x"))
                  )))
            ))
        )),
@@ -80,82 +91,100 @@ let program =
         (
           (Application
              (Variable "f",
-              [Function (["x"], FunctionType ([IntegerType], IntegerType), Plus (Variable "x", Integer 1))]
+              Function ("x", FunctionType (IntegerType, IntegerType), Plus (Variable "x", Integer 1))
              )
           ),
-          [Function (["x"], FunctionType ([IntegerType], IntegerType), Minus (Variable "x", Integer 1))]
+          Function ("x", FunctionType (IntegerType, IntegerType), Minus (Variable "x", Integer 1))
         )
      )
     )
 ;;
 
-Printf.printf "Passing functions to functions program 1: %d\n" (Result.get_ok (reduce program (3)));
+match reduce program (3) with
-Printf.printf "Passing functions to functions program 2: %d\n" (Result.get_ok (reduce program (-3)))
+  Ok o -> Printf.printf "Passing functions to functions program 1: %d\n" o
+| Error _ -> Printf.printf "Passing functions to functions program 1: error\n";;
+
+match reduce program (-3) with
+  Ok o -> Printf.printf "Passing functions to functions program 2: %d\n" o
+| Error _ -> Printf.printf "Passing functions to functions program 2: error\n"
 
 (* -------------------------------------------------------------------------- *)
 (* Recursive function program *)
 let program =
   LetFun
     ("f",
-     ["x"],
+     "x",
-     FunctionType ([IntegerType], IntegerType),
+     FunctionType (IntegerType, IntegerType),
-     (IfThenElse (CmpLess (Variable "x", Integer 2),Integer 1, Plus (Variable "x", Application (Variable "f", [Minus (Variable "x", Integer 1)])))),
+     (IfThenElse (CmpLess (Variable "x", Integer 2),Integer 1, Plus (Variable "x", Application (Variable "f", Minus (Variable "x", Integer 1))))),
      (Variable "f")
     )
 ;;
 
-Printf.printf "Recursive function program: %d\n" (Result.get_ok (reduce program 10))
+match reduce program 10 with
+  Ok o -> Printf.printf "Recursive function program: %d\n" o
+| Error _ -> Printf.printf "Recursive function program: error\n"
 
 (* -------------------------------------------------------------------------- *)
 (* Scope program *)
 let program =
   LetIn
     ("f",
-     (LetIn ("a", Integer 1, (Function (["y"], FunctionType ([IntegerType], IntegerType), Plus (Variable "y", Variable "a"))))),
+     (LetIn ("a", Integer 1, (Function ("y", FunctionType (IntegerType, IntegerType), Plus (Variable "y", Variable "a"))))),
      (LetIn ("a", Integer 2, Variable "f"))
     )
 ;;
 
-Printf.printf "Scope program: %d\n" (Result.get_ok (reduce program 4))
+match reduce program 4 with
+  Ok o -> Printf.printf "Scope program: %d\n" o
+| Error _ -> Printf.printf "Scope program: error\n"
 
 (* -------------------------------------------------------------------------- *)
 (* Factorial program *)
 let program =
   LetFun (
     "f",
-    ["x"],
+    "x",
-    FunctionType ([IntegerType], IntegerType),
+    FunctionType (IntegerType, IntegerType),
-    (IfThenElse (CmpLessEq (Variable "x", Integer 0), Integer 1, Times (Variable "x", Application (Variable "f", [Minus (Variable "x", Integer 1)])))),
+    (IfThenElse (CmpLessEq (Variable "x", Integer 0), Integer 1, Times (Variable "x", Application (Variable "f", Minus (Variable "x", Integer 1))))),
     (Variable "f")
   )
 ;;
 
-Printf.printf "Factorial program: %d\n" (Result.get_ok (reduce program 10))
+match reduce program 10 with
-;;
+  Ok o -> Printf.printf "Factorial program: %d\n" o
+| Error _ -> Printf.printf "Factorial program: error\n"
 
 (* -------------------------------------------------------------------------- *)
 (* Hailstone sequence's lenght program *)
 
 let program =
+
   LetFun (
     "collatz",
-    ["n"; "count"],
+    "input",
-    FunctionType ([IntegerType; IntegerType], IntegerType),
+    FunctionType (TupleType (IntegerType, IntegerType), IntegerType),
     (
-      IfThenElse (BNot (Cmp (Variable "n", Integer 1)),
+      IfThenElse (BNot (Cmp (First (Variable "input"), Integer 1)),
-                  (IfThenElse (Cmp (Modulo (Variable "n", Integer 2), Integer 0),
+                  (IfThenElse (Cmp (Modulo (First (Variable "input"), Integer 2), Integer 0),
-                               Application (Variable "collatz", [Division (Variable "n", Integer 2); Plus (Integer 1, Variable "count")]),
+                               Application (Variable "collatz",
-                               Application (Variable "collatz", [(Plus (Integer 1, Times (Integer 3, Variable "n"))); Plus (Integer 1, Variable "count")]))),
+                                            Tuple (
-                 (Variable "count"))
+                                              Division (First (Variable "input"), Integer 2),
+                                              Plus (Integer 1, Second (Variable "input")))),
+                               Application (Variable "collatz",
+                                            Tuple (
+                                              Plus (Integer 1, Times (Integer 3, First (Variable "input"))),
+                                              Plus (Integer 1, Second (Variable "input")))))),
+                 (Second (Variable "input")))
     ),
-    (Function (["x"],
+    (Function ("x",
-               FunctionType ([IntegerType], IntegerType),
+               FunctionType (IntegerType, IntegerType),
-               Application (Variable "collatz", [Variable "x"; Integer 1])))
+               Application (Variable "collatz", Tuple (Variable "x", Integer 1))))
   )
 ;;
 
-Printf.printf "Hailstone sequence's lenght program: %d\n" (Result.get_ok (reduce program 77031))
+match reduce program 77031 with
-;;
+  Ok o -> Printf.printf "Hailstone sequence's lenght program: %d\n" o
+| Error _ -> Printf.printf "Hailstone sequence's lenght program: error\n"
 
 (* -------------------------------------------------------------------------- *)
 (* Sum multiples of 3 and 5 program *)
@@ -163,55 +192,81 @@ Printf.printf "Hailstone sequence's lenght program: %d\n" (Result.get_ok (reduce
 let program =
   LetFun (
     "sum",
-    ["n"],
+    "n",
-    FunctionType ([IntegerType], IntegerType),
+    FunctionType (IntegerType, IntegerType),
     (IfThenElse ((BOr (Cmp (Modulo (Variable "n", Integer 3), Integer 0), Cmp (Modulo (Variable "n", Integer 5), Integer 0))),
-                 Plus (Variable "n", Application (Variable "sum", [Minus (Variable "n", Integer 1)])),
+                 Plus (Variable "n", Application (Variable "sum", Minus (Variable "n", Integer 1))),
                  (IfThenElse ((CmpLessEq (Variable "n", Integer 1)),
                               (Integer 0),
-                              (Application (Variable "sum", [Minus (Variable "n", Integer 1)])))
+                              (Application (Variable "sum", Minus (Variable "n", Integer 1))))
                  ))
     ),
     (Variable "sum")
   )
 ;;
 
-Printf.printf "Sum multiples of 3 and 5 program: %d\n" (Result.get_ok (reduce program 12345))
+match reduce program 12345 with
-;;
+  Ok o -> Printf.printf "Sum multiples of 3 and 5 program: %d\n" o
+| Error _ -> Printf.printf "Sum multiples of 3 and 5 program: error\n"
 
 (* -------------------------------------------------------------------------- *)
 (* Rand program *)
 let program =
   Function (
-    ["x"],
+    "x",
-    FunctionType ([IntegerType], IntegerType),
+    FunctionType (IntegerType, IntegerType),
     Rand (Variable "x")
   )
 
 ;;
 
-Printf.printf "Rand program: %b\n" ((Result.get_ok (reduce program 10) < 10))
+match reduce program 10 with
-;;
+  Ok o -> if o < 10 then Printf.printf "Rand program: %b\n" true
+  else Printf.printf "Rand program: %b\n" false
+| Error _ -> Printf.printf "Rand program: error\n"
 
 (* -------------------------------------------------------------------------- *)
 (* Fibonacci program *)
 let program =
   LetFun (
     "fib",
-    ["i"; "a"; "b"],
+    "i",
-    FunctionType ([IntegerType; IntegerType; IntegerType], IntegerType),
+    FunctionType (IntegerType, FunctionType (IntegerType, FunctionType (IntegerType, IntegerType))),
-    (IfThenElse (Cmp (Variable "i", Integer 0),
+    Function (
-                 Variable "a",
+      "a",
-                 Application (Variable "fib", [Minus (Variable "i", Integer 1);
+      FunctionType (IntegerType, FunctionType (IntegerType, IntegerType)),
-                                               Variable "b";
+      Function (
-                                               Plus (Variable "a", Variable "b")])
+        "b",
-                )),
+        FunctionType (IntegerType, IntegerType),
-    Function (["x"],
+        (IfThenElse (Cmp (Variable "i", Integer 0),
-              FunctionType ([IntegerType], IntegerType),
+                     Variable "a",
-              (Application (Variable "fib", [Variable "x"; Integer 0; Integer 1])))
+                     Application (
+                       Application (
+                         Application (
+                           Variable "fib",
+                           Minus (Variable "i", Integer 1)),
+                         Variable "b"),
+                       Plus (Variable "a", Variable "b")
+                     )
+                    ))
+      )
+    ),
+    Function ("x",
+              FunctionType (IntegerType, IntegerType),
+              Application (
+                Application (
+                  Application (
+                    Variable "fib",
+                    Variable "x"
+                  ),
+                  Integer 0
+                ),
+                Integer 1
+              )
+             )
   )
-
 ;;
 
-Printf.printf "Fibonacci program: %d\n" (Result.get_ok (reduce program 48))
+match reduce program 48 with
-;;
+  Ok o -> Printf.printf "Fibonacci program: %d\n" o
+| Error _ -> Printf.printf "Fibonacci program: error\n"

test/testingImp.expected

@@ -5,5 +5,5 @@ Hailstone sequence's lenght program: 351
 Sum multiples of 3 and 5 program: 35565945
 Rand program: true
 Fibonacci program: 4807526976
-Miller-Rabin primality test program: 0
+Miller-Rabin primality test program 1: 0
-Miller-Rabin primality test program: 1
+Miller-Rabin primality test program 2: 1

test/testingImp.ml

@@ -1,5 +1,5 @@
-open Lang.MiniImp
+open MiniImp.Semantics
-open Lang.MiniImpTypes
+open MiniImp.Types
 
 (* -------------------------------------------------------------------------- *)
 (* Identity program *)
@@ -11,7 +11,12 @@ let program =
     )
 ;;
 
-Printf.printf "Identity program: %d\n" (reduce program 1)
+Printf.printf "Identity program: ";
+match reduce program 1 with
+  Ok d -> Printf.printf "%d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
+;;
 
 (* -------------------------------------------------------------------------- *)
 (* y not defined program *)
@@ -28,10 +33,12 @@ let program =
     )
 ;;
 
-try
+
-  Printf.printf "y not defined program: %d\n" (reduce program 100)
+Printf.printf "y not defined program: ";
-with AbsentAssignment s ->
+match reduce program 100 with
-  Printf.printf "y not defined program: %s\n" s
+  Ok d -> Printf.printf "error: %d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "%s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
 ;;
 
 (* -------------------------------------------------------------------------- *)
@@ -54,9 +61,14 @@ let program =
     )
 ;;
 
-Printf.printf "Factorial program: %d\n" (reduce program 10)
+Printf.printf "Factorial program: ";
+match reduce program 10 with
+  Ok d -> Printf.printf "%d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
 ;;
 
+
 (* -------------------------------------------------------------------------- *)
 (* Hailstone sequence's lenght program *)
 let program =
@@ -80,7 +92,11 @@ let program =
     )
 ;;
 
-Printf.printf "Hailstone sequence's lenght program: %d\n" (reduce program 77031)
+Printf.printf "Hailstone sequence's lenght program: ";
+match reduce program 77031 with
+  Ok d -> Printf.printf "%d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
 ;;
 
 (* -------------------------------------------------------------------------- *)
@@ -106,7 +122,11 @@ let program =
     )
 ;;
 
-Printf.printf "Sum multiples of 3 and 5 program: %d\n" (reduce program 12345)
+Printf.printf "Sum multiples of 3 and 5 program: ";
+match reduce program 12345 with
+  Ok d -> Printf.printf "%d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
 ;;
 
 (* -------------------------------------------------------------------------- *)
@@ -119,7 +139,11 @@ let program =
     )
 ;;
 
-Printf.printf "Rand program: %b\n" ((reduce program 10) < 10)
+Printf.printf "Rand program: ";
+match reduce program 10 with
+  Ok d -> Printf.printf "%b\n" (d < 10)
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
 ;;
 
 (* -------------------------------------------------------------------------- *)
@@ -149,7 +173,11 @@ let program =
     )
 ;;
 
-Printf.printf "Fibonacci program: %d\n" (reduce program 48)
+Printf.printf "Fibonacci program: ";
+match reduce program 48 with
+  Ok d -> Printf.printf "%d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
 ;;
 
 (* -------------------------------------------------------------------------- *)
@@ -216,8 +244,16 @@ let program =
 ;;
 
 (* should return 0 because prime *)
-Printf.printf "Miller-Rabin primality test program: %d\n" (reduce program 179424673)
+Printf.printf "Miller-Rabin primality test program 1: ";
+match reduce program 179424673 with
+  Ok d -> Printf.printf "%d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
 ;;
 (* should return 1 because not prime *)
-Printf.printf "Miller-Rabin primality test program: %d\n" (reduce program 179424675)
+Printf.printf "Miller-Rabin primality test program 2: ";
+match reduce program 179424675 with
+  Ok d -> Printf.printf "%d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
 ;;

test/testingImpParser.expected

@@ -0,0 +1,9 @@
+Identity program: 1
+y not defined program: The variable y is not defined.
+Factorial program: 3628800
+Hailstone sequence's lenght program: 351
+Sum multiples of 3 and 5 program: 35565945
+Rand program: true
+Fibonacci program: 4807526976
+Miller-Rabin primality test program 1: 0
+Miller-Rabin primality test program 2: 1

test/testingImpParser.ml

@@ -0,0 +1,166 @@
+open MiniImp
+
+let get_result x =
+  Lexing.from_string x |> Parser.prg Lexer.lex |> Semantics.reduce
+
+(* -------------------------------------------------------------------------- *)
+(* Identity program *)
+let program =
+  "def main with input a output b as b := a"
+;;
+
+Printf.printf "Identity program: ";
+match get_result program 1 with
+  Ok d -> Printf.printf "%d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
+;;
+
+(* -------------------------------------------------------------------------- *)
+(* y not defined program *)
+let program =
+  "def main with input a output b as x := 1; b := a + x + y"
+;;
+
+Printf.printf "y not defined program: ";
+match get_result program 100 with
+  Ok d -> Printf.printf "error: %d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "%s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
+;;
+
+(* -------------------------------------------------------------------------- *)
+(* Factorial program *)
+let program =
+"def main with input a output b as
+  b := 1;
+  for (i := 1, i <= a, i := i + 1) do
+    b := b * i;
+"
+;;
+
+Printf.printf "Factorial program: ";
+match get_result program 10 with
+  Ok d -> Printf.printf "%d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
+;;
+
+(* -------------------------------------------------------------------------- *)
+(* Hailstone sequence's lenght program *)
+let program =
+"def main with input a output b as
+  b := 1;
+  while not a == 1 do (
+    b :=  b + 1;
+    if ((a % 2) == 1) then a := 3 * a + 1 else a := a / 2
+  )
+"
+;;
+
+Printf.printf "Hailstone sequence's lenght program: ";
+match get_result program 77031 with
+  Ok d -> Printf.printf "%d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
+;;
+
+(* -------------------------------------------------------------------------- *)
+(* Sum multiples of 3 and 5 program *)
+let program =
+"def main with input a output b as
+  b := 0;
+  for (i := 0, i <= a, i := i+1) do
+    if (i % 3 == 0 || i % 5 == 0) then b := b + i;
+                                   else skip;
+"
+;;
+
+Printf.printf "Sum multiples of 3 and 5 program: ";
+match get_result program 12345 with
+  Ok d -> Printf.printf "%d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
+;;
+
+(* -------------------------------------------------------------------------- *)
+(* Rand program *)
+let program =
+  "def main with input a output b as b := rand(a)"
+;;
+
+Printf.printf "Rand program: ";
+match get_result program 10 with
+  Ok d -> Printf.printf "%b\n" (d < 10)
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
+;;
+
+(* -------------------------------------------------------------------------- *)
+(* Fibonacci program *)
+let program =
+"def main with input n output fnext as
+  fnow := 0;
+  fnext := 1;
+  while (n > 1) do (
+    tmp := fnow + fnext;
+    fnow := fnext;
+    fnext := tmp;
+    n := n - 1;
+  )
+"
+;;
+
+Printf.printf "Fibonacci program: ";
+match get_result program 48 with
+  Ok d -> Printf.printf "%d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
+;;
+
+(* -------------------------------------------------------------------------- *)
+(* Miller-Rabin primality test program *)
+let program =
+"def main with input n output result as
+  if (n % 2) == 0 then result := 1
+  else (
+
+    result := 0;
+    s := 0;
+    while (0 == ((n - 1) / (2 ^ s)) % 2) do (
+      s := s + 1
+    );
+    d := ((n - 1) / 2 ^ s);
+    for (i := 20, i > 0, i := i - 1) do (
+      a := rand(n - 4) + 2;
+      x := powmod(a, d, n);
+      for (j := 0, j < s, j := j+1) do (
+        y := powmod(x, 2, n);
+        if (y == 1 && (not x == 1) && (not x == n - 1)) then
+          result := 1;
+        else
+          skip;
+        x := y;
+      );
+      if not y == 1 then result := 1;
+                    else skip;
+    )
+  )
+"
+;;
+
+(* should return 0 because prime *)
+Printf.printf "Miller-Rabin primality test program 1: ";
+match get_result program 179424673 with
+  Ok d -> Printf.printf "%d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
+;;
+
+(* should return 1 because not prime *)
+Printf.printf "Miller-Rabin primality test program 2: ";
+match get_result program 179424675 with
+  Ok d -> Printf.printf "%d\n" d
+| Error `AbsentAssignment msg -> Printf.printf "error -> %s\n" msg
+| Error `DivisionByZero msg -> Printf.printf "error -> %s\n" msg
+;;

test/testingTypeFun.expected

@@ -1,6 +1,4 @@
 Error absent assignment program: error (success)
-Error wrong arity program 1: error (success)
-Error wrong arity program 2: error (success)
 Error wrong return type program: error (success)
 Error wrong specification program: error (success)
 Error wrong input type program: error (success)

test/testingTypeFun.ml

@@ -1,13 +1,13 @@
-open Lang.MiniTyFun
+open MiniFun.TypeChecker
-open Lang.MiniFunTypes
+open MiniFun.Types
 
 (* -------------------------------------------------------------------------- *)
 (* Error absent assignment program *)
 
 let program =
   Function
-    (["a"],
+    ("a",
-     FunctionType ([IntegerType], IntegerType),
+     FunctionType (IntegerType, IntegerType),
      Variable "x"
     )
 ;;
@@ -16,42 +16,13 @@ match typecheck program with
   Error (`AbsentAssignment _) -> Printf.printf "Error absent assignment program: error (success)\n"
 | _ -> Printf.printf "Error absent assignment program: failed\n"
 
-(* -------------------------------------------------------------------------- *)
-(* Error wrong arity program *)
-
-let program =
-  Function
-    (["a"],
-     FunctionType ([IntegerType; IntegerType], IntegerType),
-     (Variable "a")
-    )
-;;
-
-match typecheck program with
-  Error (`WrongTypeSpecification _) -> Printf.printf "Error wrong arity program 1: error (success)\n"
-| _ -> Printf.printf "Error wrong arity program 1: failed\n"
-
-let program =
-  LetFun
-    ("f",
-     ["a"; "b"],
-     FunctionType ([IntegerType; IntegerType], IntegerType),
-     (Variable "a"),
-     Function (["x"], FunctionType ([IntegerType], IntegerType), Application (Variable "f", [Integer 1; Integer 2; Variable "x"]))
-    )
-;;
-
-match typecheck program with
-  Error (`WrongArity _) -> Printf.printf "Error wrong arity program 2: error (success)\n"
-| _ -> Printf.printf "Error wrong arity program 2: failed\n"
-
 (* -------------------------------------------------------------------------- *)
 (* Error wrong return type program *)
 
 let program =
   Function
-    (["a"],
+    ("a",
-     FunctionType ([IntegerType], BooleanType),
+     FunctionType (IntegerType, BooleanType),
      (Variable "a")
     )
 ;;
@@ -65,7 +36,7 @@ match typecheck program with
 
 let program =
   Function
-    (["a"],
+    ("a",
      IntegerType,
      (Variable "a")
     )
@@ -81,11 +52,11 @@ match typecheck program with
 let program =
   Application (
     Function
-      (["a"; "b"],
+      ("a",
-       FunctionType ([IntegerType; IntegerType], IntegerType),
+       FunctionType (IntegerType, FunctionType (IntegerType, IntegerType)),
-       (Variable "a")
+       Function ("b", FunctionType (IntegerType, IntegerType), Variable "a")
       ),
-    [Boolean false]
+    Boolean false
   )
 ;;
 
@@ -99,7 +70,7 @@ match typecheck program with
 let program =
   Application (
     Integer 0,
-    [Boolean false]
+    Boolean false
   )
 ;;
 
@@ -112,8 +83,8 @@ match typecheck program with
 
 let program =
   Function (
-    ["x"],
+    "x",
-    FunctionType ([IntegerType], IntegerType),
+    FunctionType (IntegerType, IntegerType),
     IfThenElse (Cmp (Integer 1, Integer 2), Boolean true, Integer 1)
   )
 ;;
@@ -127,8 +98,8 @@ match typecheck program with
 
 let program =
   Function (
-    ["x"],
+    "x",
-    FunctionType ([IntegerType], IntegerType),
+    FunctionType (IntegerType, IntegerType),
     IfThenElse (Integer 1, Integer 2, Integer 1)
   )
 ;;
@@ -142,8 +113,8 @@ match typecheck program with
 (* Identity program *)
 let program =
   Function
-    (["a"],
+    ("a",
-     FunctionType ([IntegerType], IntegerType),
+     FunctionType (IntegerType, IntegerType),
      (Variable "a")
     )
 ;;
@@ -156,8 +127,8 @@ match typecheck program with
 (* Constant program *)
 let program =
   Function
-    (["a"],
+    ("a",
-     FunctionType ([IntegerType], IntegerType),
+     FunctionType (IntegerType, IntegerType),
      (Integer 1)
     )
 ;;
@@ -171,10 +142,15 @@ match typecheck program with
 let program =
   LetIn
     ("f",
-     (Function (["x"; "y"],
+     (Function (
-                FunctionType ([IntegerType; IntegerType], IntegerType),
+         "x",
-                Plus (Variable "x", Variable "y"))),
+         FunctionType (IntegerType, FunctionType (IntegerType, IntegerType)),
-     (Application (Variable "f", [Integer 3]))
+         Function ("y",
+                   FunctionType (IntegerType, IntegerType),
+                   Plus (Variable "x", Variable "y")
+                  )
+               )),
+     (Application (Variable "f", Integer 3))
     )
 ;;
 
@@ -187,12 +163,12 @@ match typecheck program with
 let program =
   LetFun
     ("f",
-     ["x"],
+     "x",
-     FunctionType ([IntegerType], FunctionType ([IntegerType], IntegerType)),
+     FunctionType (IntegerType, FunctionType (IntegerType, IntegerType)),
-     (Function (["y"],
+     (Function ("y",
-                FunctionType ([IntegerType], IntegerType),
+                FunctionType (IntegerType, IntegerType),
                 Plus (Variable "x", Variable "y"))),
-     (Application (Variable "f", [Integer 3]))
+     (Application (Variable "f", Integer 3))
     )
 ;;
 
@@ -206,18 +182,18 @@ let program =
   LetIn
     ("f",
      (Function (
-         ["z"],
+         "z",
-         FunctionType ([FunctionType ([IntegerType], IntegerType)], FunctionType ([FunctionType ([IntegerType], IntegerType)], FunctionType ([IntegerType], IntegerType))),
+         FunctionType (FunctionType (IntegerType, IntegerType), FunctionType (FunctionType (IntegerType, IntegerType), FunctionType (IntegerType, IntegerType))),
          (Function (
-             ["y"],
+             "y",
-             FunctionType ([FunctionType ([IntegerType], IntegerType)], FunctionType ([IntegerType], IntegerType)),
+             FunctionType (FunctionType (IntegerType, IntegerType), FunctionType (IntegerType, IntegerType)),
              Function (
-               ["x"],
+               "x",
-               FunctionType ([IntegerType], IntegerType),
+               FunctionType (IntegerType, IntegerType),
                (IfThenElse (
                    CmpLess (Variable "x", Integer 0),
-                   (Application (Variable "y", [Variable "x"])),
+                   (Application (Variable "y", Variable "x")),
-                   (Application (Variable "z", [Variable "x"]))
+                   (Application (Variable "z", Variable "x"))
                  )))
            ))
        )),
@@ -225,10 +201,10 @@ let program =
         (
           (Application
              (Variable "f",
-              [Function (["x"], FunctionType ([IntegerType], IntegerType), Plus (Variable "x", Integer 1))]
+              Function ("x", FunctionType (IntegerType, IntegerType), Plus (Variable "x", Integer 1))
              )
           ),
-          [Function (["x"], FunctionType ([IntegerType], IntegerType), Minus (Variable "x", Integer 1))]
+          Function ("x", FunctionType (IntegerType, IntegerType), Minus (Variable "x", Integer 1))
         )
      )
     )
@@ -243,9 +219,9 @@ match typecheck program with
 let program =
   LetFun
     ("f",
-     ["x"],
+     "x",
-     FunctionType ([IntegerType], IntegerType),
+     FunctionType (IntegerType, IntegerType),
-     (IfThenElse (CmpLess (Variable "x", Integer 2),Integer 1, Plus (Variable "x", Application (Variable "f", [Minus (Variable "x", Integer 1)])))),
+     (IfThenElse (CmpLess (Variable "x", Integer 2),Integer 1, Plus (Variable "x", Application (Variable "f", Minus (Variable "x", Integer 1))))),
      (Variable "f")
     )
 ;;
@@ -259,7 +235,7 @@ match typecheck program with
 let program =
   LetIn
     ("f",
-     (LetIn ("a", Integer 1, (Function (["y"], FunctionType ([IntegerType], IntegerType), Plus (Variable "y", Variable "a"))))),
+     (LetIn ("a", Integer 1, (Function ("y", FunctionType (IntegerType, IntegerType), Plus (Variable "y", Variable "a"))))),
      (LetIn ("a", Integer 2, Variable "f"))
     )
 ;;
@@ -273,9 +249,9 @@ match typecheck program with
 let program =
   LetFun (
     "f",
-    ["x"],
+    "x",
-    FunctionType ([IntegerType], IntegerType),
+    FunctionType (IntegerType, IntegerType),
-    (IfThenElse (CmpLessEq (Variable "x", Integer 0), Integer 1, Times (Variable "x", Application (Variable "f", [Minus (Variable "x", Integer 1)])))),
+    (IfThenElse (CmpLessEq (Variable "x", Integer 0), Integer 1, Times (Variable "x", Application (Variable "f", Minus (Variable "x", Integer 1))))),
     (Variable "f")
   )
 ;;
@@ -290,18 +266,25 @@ match typecheck program with
 let program =
   LetFun (
     "collatz",
-    ["n"; "count"],
+    "input",
-    FunctionType ([IntegerType; IntegerType], IntegerType),
+    FunctionType (TupleType (IntegerType, IntegerType), IntegerType),
     (
-      IfThenElse (BNot (Cmp (Variable "n", Integer 1)),
+      IfThenElse (BNot (Cmp (First (Variable "input"), Integer 1)),
-                  (IfThenElse (Cmp (Modulo (Variable "n", Integer 2), Integer 0),
+                  (IfThenElse (Cmp (Modulo (First (Variable "input"), Integer 2), Integer 0),
-                               Application (Variable "collatz", [Division (Variable "n", Integer 2); Plus (Integer 1, Variable "count")]),
+                               Application (Variable "collatz",
-                               Application (Variable "collatz", [(Plus (Integer 1, Times (Integer 3, Variable "n"))); Plus (Integer 1, Variable "count")]))),
+                                            Tuple (
-                 (Variable "count"))
+                                              Division (First (Variable "input"), Integer 2),
+                                              Plus (Integer 1, Second (Variable "input")))),
+                               Application (Variable "collatz",
+                                            Tuple (
+                                              Plus (Integer 1, Times (Integer 3, First (Variable "input"))),
+                                              Plus (Integer 1, Second (Variable "input")))))),
+                 (Second (Variable "input")))
     ),
-    (Function (["x"],
+    (Function ("x",
-               FunctionType ([IntegerType], IntegerType),
+               FunctionType (IntegerType, IntegerType),
-               Application (Variable "collatz", [Variable "x"; Integer 1])))
+               Application (Variable "collatz", Tuple (Variable "x", Integer 1)))
+    )
   )
 ;;
 
@@ -315,13 +298,13 @@ match typecheck program with
 let program =
   LetFun (
     "sum",
-    ["n"],
+    "n",
-    FunctionType ([IntegerType], IntegerType),
+    FunctionType (IntegerType, IntegerType),
     (IfThenElse ((BOr (Cmp (Modulo (Variable "n", Integer 3), Integer 0), Cmp (Modulo (Variable "n", Integer 5), Integer 0))),
-                 Plus (Variable "n", Application (Variable "sum", [Minus (Variable "n", Integer 1)])),
+                 Plus (Variable "n", Application (Variable "sum", Minus (Variable "n", Integer 1))),
                  (IfThenElse ((CmpLessEq (Variable "n", Integer 1)),
                               (Integer 0),
-                              (Application (Variable "sum", [Minus (Variable "n", Integer 1)])))
+                              (Application (Variable "sum", Minus (Variable "n", Integer 1))))
                  ))
     ),
     (Variable "sum")
@@ -336,8 +319,8 @@ match typecheck program with
 (* Rand program *)
 let program =
   Function (
-    ["x"],
+    "x",
-    FunctionType ([IntegerType], IntegerType),
+    FunctionType (IntegerType, IntegerType),
     Rand (Variable "x")
   )
 
@@ -352,19 +335,20 @@ match typecheck program with
 let program =
   LetFun (
     "fib",
-    ["i"; "a"; "b"],
+    "input",
-    FunctionType ([IntegerType; IntegerType; IntegerType], IntegerType),
+    FunctionType (TupleType (TupleType (IntegerType, IntegerType), IntegerType), IntegerType),
-    (IfThenElse (Cmp (Variable "i", Integer 0),
+    (IfThenElse (Cmp (First (First (Variable "input")), Integer 0),
-                 Variable "a",
+                 Second (First (Variable "input")),
-                 Application (Variable "fib", [Minus (Variable "i", Integer 1);
+                 Application (Variable "fib",
-                                               Variable "b";
+                              Tuple ( Tuple (
-                                               Plus (Variable "a", Variable "b")])
+                                  Minus (First (First (Variable "input")), Integer 1),
+                                  Second (Variable "input")),
+                                  Plus (Second (First (Variable "input")), Second (Variable "input"))))
                 )),
-    Function (["x"],
+    Function ("x",
-              FunctionType ([IntegerType], IntegerType),
+              FunctionType (IntegerType, IntegerType),
-              (Application (Variable "fib", [Variable "x"; Integer 0; Integer 1])))
+              (Application (Variable "fib", Tuple (Tuple (Variable "x", Integer 0), Integer 1))))
   )
-
 ;;
 
 match typecheck program with

test/testingTypeFunParser.expected

@@ -0,0 +1,20 @@
+Error absent assignment program: error (success)
+Error wrong type program: error (success)
+Error wrong return type program: error (success)
+Error wrong specification program: error (success)
+Error wrong input type program: error (success)
+Error not a function program: error (success)
+Error if branches with different types program: error (success)
+Error if guard is not a boolean program: error (success)
+Identity program: success
+Constant program: success
+Partial application of function program 1: success
+Partial application of function program 2: success
+Passing functions to functions program: success
+Recursive function program: success
+Scope program: success
+Factorial program: success
+Hailstone sequence's lenght program: success
+Sum multiples of 3 and 5 program: success
+Rand program: success
+Fibonacci program: success

test/testingTypeFunParser.ml

@@ -0,0 +1,251 @@
+open MiniFun
+
+let get_result x =
+  Lexing.from_string x |> Parser.prg Lexer.lex |> TypeChecker.typecheck
+
+(* -------------------------------------------------------------------------- *)
+(* Error absent assignment program *)
+
+let program =
+  "lambda a: int -> int => x"
+;;
+
+Printf.printf "Error absent assignment program: ";
+match get_result program with
+  Error (`AbsentAssignment _) -> Printf.printf "error (success)\n"
+| _ -> Printf.printf "failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Error wrong type program *)
+
+let program =
+  "lambda a: (int, int) -> int => a"
+;;
+
+Printf.printf "Error wrong type program: ";
+match get_result program with
+  Error (`WrongTypeSpecification _) -> Printf.printf "error (success)\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Error wrong return type program *)
+
+let program =
+  "lambda a: int -> bool => a"
+;;
+
+Printf.printf "Error wrong return type program: ";
+match get_result program with
+  Error (`WrongTypeSpecification _) -> Printf.printf "error (success)\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Error wrong specification program *)
+
+let program =
+  "lambda a: int => a"
+;;
+
+Printf.printf "Error wrong specification program: ";
+match get_result program with
+  Error (`WrongTypeSpecification _) -> Printf.printf "error (success)\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Error wrong input type program *)
+
+let program =
+  "(lambda a: int -> int => a) false"
+;;
+
+Printf.printf "Error wrong input type program: ";
+match get_result program with
+  Error (`WrongType _) -> Printf.printf "error (success)\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Error not a function program *)
+
+let program =
+  "0 false"
+;;
+
+Printf.printf "Error not a function program: ";
+match get_result program with
+  Error (`WrongType _) -> Printf.printf "error (success)\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Error if branches with different types program *)
+
+let program =
+  "lambda x: int -> int => if 1 == 2 then true else 1"
+;;
+
+Printf.printf "Error if branches with different types program: ";
+match get_result program with
+  Error (`WrongType _) -> Printf.printf "error (success)\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Error if guard is not a boolean program *)
+
+let program =
+  "lambda x: int -> int => (if 1 then 2 else 1)"
+;;
+
+Printf.printf "Error if guard is not a boolean program: ";
+match get_result program with
+  Error (`WrongType _) -> Printf.printf "error (success)\n"
+| _ -> Printf.printf " failed\n"
+
+
+(* -------------------------------------------------------------------------- *)
+(* Identity program *)
+let program =
+  "lambda a: int -> int => a"
+;;
+
+Printf.printf "Identity program: ";
+match get_result program with
+  Ok _ -> Printf.printf "success\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Constant program *)
+let program =
+  "lambda a: int -> int => 1"
+;;
+
+Printf.printf "Constant program: ";
+match get_result program with
+  Ok _ -> Printf.printf "success\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Partial application of function program *)
+let program =
+  "let f = lambda x: int -> int -> int => lambda y: int -> int => x + y in f 3"
+;;
+
+Printf.printf "Partial application of function program 1: ";
+match get_result program with
+  Ok _ -> Printf.printf "success\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Partial application of function program *)
+let program =
+  "let rec f x: int -> int -> int = lambda y: int -> int => x + y in f 3"
+;;
+
+Printf.printf "Partial application of function program 2: ";
+match get_result program with
+  Ok _ -> Printf.printf "success\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Passing functions to functions program *)
+let program =
+  "let f =
+     \\z: (int -> int) -> (int -> int) -> int -> int =>
+       \\y: (int -> int) -> int -> int =>
+         \\x: int -> int =>
+           if x < 0 then y x else z x
+   in (f (\\x: int -> int => x + 1)) (\\x: int -> int => x - 1)"
+;;
+
+Printf.printf "Passing functions to functions program: ";
+match get_result program with
+  Ok _ -> Printf.printf "success\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Recursive function program *)
+let program =
+  "let rec f x: int -> int = if x < 2 then 1 else x + f (x - 1) in f"
+;;
+
+Printf.printf "Recursive function program: ";
+match get_result program with
+  Ok _ -> Printf.printf "success\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Scope program *)
+let program =
+  "let f = let a = 1 in fun y: int -> int => y + a in let a = 2 in f"
+;;
+
+Printf.printf "Scope program: ";
+match get_result program with
+  Ok _ -> Printf.printf "success\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Factorial program *)
+let program =
+  "let rec f x: int -> int = if x <= 0 then 1 else x * f (x - 1) in f"
+;;
+
+Printf.printf "Factorial program: ";
+match get_result program with
+  Ok _ -> Printf.printf "success\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Hailstone sequence's lenght program *)
+
+let program =
+  "let rec collatz input: (int, int) -> int =
+     if not (fst input == 1) then
+       if fst input % 2 == 0 then collatz ((fst input / 2), (snd input + 1))
+                     else collatz ((1 + fst input * 3), (snd input + 1))
+       else snd input
+   in fun x: int -> int => collatz (x, 1)
+"
+;;
+
+Printf.printf "Hailstone sequence's lenght program: ";
+match get_result program with
+  Ok _ -> Printf.printf "success\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Sum multiples of 3 and 5 program *)
+
+let program =
+  "let rec sum n: int -> int = if n % 3 == 0 || n % 5 == 0 then n + sum (n - 1) else if n < 1 then 0 else sum (n - 1) in sum"
+;;
+
+Printf.printf "Sum multiples of 3 and 5 program: ";
+match get_result program with
+  Ok _ -> Printf.printf "success\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Rand program *)
+let program =
+  "fun x: int -> int => rand x"
+;;
+
+Printf.printf "Rand program: ";
+match get_result program with
+  Ok _ -> Printf.printf "success\n"
+| _ -> Printf.printf " failed\n"
+
+(* -------------------------------------------------------------------------- *)
+(* Fibonacci program *)
+let program =
+  "let rec fib input:
+     int, int, int -> int =
+  if fst fst input == 0
+  then snd fst input
+  else fib (((fst fst input - 1), snd input), (snd fst input + snd input))
+  in lambda x: int -> int => fib ((x, 0), 1)"
+;;
+
+Printf.printf "Fibonacci program: ";
+match get_result program with
+  Ok _ -> Printf.printf "success\n"
+| _ -> Printf.printf " failed\n"