Compleating assignment for interpreter, modified grammars, fixed tests

bin/dune

@@ -8,3 +8,21 @@
   (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/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

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)
@@ -341,7 +341,7 @@ 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 mem : memory = {assignments = VariableMap.empty} in
   match (evaluate mem program') with

lib/miniFun/Semantics.mli

@@ -1,3 +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 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,7 +5,7 @@ Random.self_init ()
 
 let (let*) = Result.bind
 
-let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) : (ftype, error) result =
+let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) : (ftype, [> typechecking_error]) result =
   match program with
     Integer _ -> Ok IntegerType
   | Boolean _ -> Ok BooleanType
@@ -150,7 +150,7 @@ let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) : (ftype,
     | _ -> Error (`WrongTypeSpecification
                     "Specification of function is not a function type.")
 
-let typecheck (program: t_exp) : (ftype, error) result =
+let typecheck (program: t_exp) : (ftype, [> typechecking_error]) result =
   let* typeprogram = evaluate_type program VariableMap.empty in
   match typeprogram with
     FunctionType (IntegerType, IntegerType) -> (

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

@@ -53,9 +53,18 @@ type memory = {
   assignments: permittedValues VariableMap.t
 }
 
-type error = [
+
+type base_error = [
     `AbsentAssignment of string
   | `WrongType of string
-  | `DivisionByZero of string
+]
+
+type typechecking_error = [
+  | base_error
   | `WrongTypeSpecification of string
 ]
+
+type error = [
+  | base_error
+  | `DivisionByZero of string
+]

lib/miniFun/Types.mli

@@ -53,9 +53,18 @@ type memory = {
   assignments: permittedValues VariableMap.t
 }
 
-type error = [
+
+type base_error = [
     `AbsentAssignment of string
   | `WrongType of string
-  | `DivisionByZero of string
+]
+
+type typechecking_error = [
+  | base_error
   | `WrongTypeSpecification of string
 ]
+
+type error = [
+  | base_error
+  | `DivisionByZero of string
+]

lib/miniFun/dune

@@ -13,4 +13,4 @@
  (modules Lexer Parser Types Semantics TypeChecker)
  (libraries utility menhirLib))
 
-(include_subdirs qualified)
+(include_subdirs qualified)

lib/miniImp/Lexer.mll

@@ -9,18 +9,24 @@
 
   let keyword_table =
     let mapping = [
-      ("main", MAIN);
+      ("as", AS);
-      ("skip", SKIP);
+      ("def", DEF);
-      ("if", IF);
-      ("else", ELSE);
-      ("while", WHILE);
-      ("for", FOR);
       ("do", DO);
-      ("true", BOOL(true));
+      ("else", ELSE);
       ("false", BOOL(false));
+      ("for", FOR);
+      ("if", IF);
+      ("input", INPUT);
+      ("main", MAIN);
       ("not", BNOT);
-      ("rand", RAND);
+      ("output", OUTPUT);
       ("powmod", POWERMOD);
+      ("rand", RAND);
+      ("skip", SKIP);
+      ("then", THEN);
+      ("true", BOOL(true));
+      ("while", WHILE);
+      ("with", WITH);
     ]
     in create_hashtable (List.length mapping) mapping
 }
@@ -42,26 +48,24 @@ rule read = parse
       | Some keyword -> keyword
       | None -> VARIABLE(v)
     }
-  | ";"             {SEQUENCE}
+  | "%"             {MODULO}
-  | ","             {COMMA}
+  | "&&"            {BAND}
-  | "{"             {LEFTGPAR}
-  | "}"             {RIGHTGPAR}
   | "("             {LEFTPAR}
   | ")"             {RIGHTPAR}
-  | "<"             {BCMPLESS}
-  | ">"             {BCMPGREATER}
-  | "+"             {PLUS}
-  | "-"             {MINUS}
   | "*"             {TIMES}
+  | "+"             {PLUS}
+  | ","             {COMMA}
+  | "-"             {MINUS}
   | "/"             {DIVISION}
-  | "%"             {MODULO}
-  | "^"             {POWER}
   | ":="            {ASSIGNMENT}
-  | "&&"            {BAND}
+  | ";"             {SEQUENCE}
-  | "||"            {BOR}
+  | "<"             {BCMPLESS}
-  | "=="            {BCMP}
   | "<="            {BCMPLESSEQ}
+  | "=="            {BCMP}
+  | ">"             {BCMPGREATER}
   | ">="            {BCMPGREATEREQ}
+  | "^"             {POWER}
+  | "||"            {BOR}
   | integer as i    {INT(int_of_string i)}
   | "(*"            {comments 0 lexbuf}
   | eof             {EOF}

lib/miniImp/Parser.mly

@@ -6,14 +6,13 @@
 %}
 
 (* tokens *)
-%token MAIN SKIP ASSIGNMENT SEQUENCE IF ELSE WHILE FOR DO COMMA
+%token MAIN DEF WITH INPUT OUTPUT AS SKIP ASSIGNMENT SEQUENCE IF THEN ELSE WHILE
-%token LEFTGPAR RIGHTGPAR
+%token FOR DO COMMA LEFTPAR RIGHTPAR
-%token <bool> BOOL
-%token BAND BOR BNOT BCMP BCMPLESS BCMPLESSEQ BCMPGREATER BCMPGREATEREQ
-%token <string> VARIABLE
-%token <int> INT
-%token 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
@@ -25,7 +24,7 @@
 %start prg
 
 (* associativity in order of precedence *)
-%left twoseq
+%left lowest
 %left SEQUENCE
 %left ELSE
 %left PLUS MINUS BOR BAND
@@ -34,52 +33,53 @@
 %left MODULO
 %left TIMES
 %left POWER
+%left DO
 
 %%
 
 (* grammar *)
 prg:
-  | MAIN; a = VARIABLE; b = VARIABLE; LEFTGPAR; t = cexpp; RIGHTGPAR; EOF
+  | DEF; MAIN; WITH; INPUT; a = VARIABLE; OUTPUT; b = VARIABLE; AS; t = cexpp; EOF
-    {Main (a, b, t)}                   // main a b {...}
+    {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 := ...
+    {Assignment (a, body)}             // a := body
-  | t1 = cexpp; SEQUENCE; t2 = cexpp %prec twoseq
+  | t1 = cexpp; SEQUENCE; t2 = cexpp %prec lowest
-    {Sequence (t1, t2)}                // ...; ...
+    {Sequence (t1, t2)}                // t1; t2
-  | t = cexpp; SEQUENCE                {t} // ...;
+  | t = cexpp; SEQUENCE                {t} // t;
-  | IF; LEFTPAR; guard = bexpp; RIGHTPAR; body1 = cexpp; ELSE; body2 = cexpp
+  | IF; guard = bexpp; THEN; body1 = cexpp; ELSE; body2 = cexpp
-    {If (guard, body1, body2)}         // if (...) ... else ...
+    {If (guard, body1, body2)}         // if ... then ... else ...
-  | WHILE; guard = bexpp; DO; LEFTGPAR; body = cexpp; RIGHTGPAR
+  | WHILE; guard = bexpp; DO; body = cexpp;
-    {While (guard, body)}              // while ... do {...}
+    {While (guard, body)}              // while ... do ...
   | FOR; LEFTPAR; ass = cexpp; COMMA; guard = bexpp; COMMA; iter = cexpp; RIGHTPAR;
-         DO; LEFTGPAR; body = cexpp; RIGHTGPAR
+         DO; body = cexpp;
-    {For (ass, guard, iter, body)}     // for (..., ..., ...) do {...}
+    {For (ass, guard, iter, body)}     // for (..., ..., ...) do ...
-  | LEFTGPAR; t = cexpp; RIGHTGPAR {t} // {...}
+  | LEFTPAR; t = cexpp; RIGHTPAR {t}   // (...)
 bexpp:
-  | b = BOOL                              {Boolean (b)}
+  | b = BOOL                              {Boolean (b)} // true, false
-  | b1 = bexpp; BAND; b2 = bexpp          {BAnd (b1, b2)}
+  | b1 = bexpp; BAND; b2 = bexpp          {BAnd (b1, b2)} // &&
-  | b1 = bexpp; BOR; b2 = bexpp           {BOr (b1, b2)}
+  | b1 = bexpp; BOR; b2 = bexpp           {BOr (b1, b2)} // ||
-  | BNOT; b = bexpp                       {BNot (b)}
+  | BNOT; b = bexpp                       {BNot (b)} // not
-  | a1 = aexpp; BCMP; a2 = aexpp          {BCmp (a1, a2)}
+  | a1 = aexpp; BCMP; a2 = aexpp          {BCmp (a1, a2)} // ==
-  | a1 = aexpp; BCMPLESS; a2 = aexpp      {BCmpLess (a1, a2)}
+  | a1 = aexpp; BCMPLESS; a2 = aexpp      {BCmpLess (a1, a2)} // <
-  | a1 = aexpp; BCMPLESSEQ; a2 = aexpp    {BCmpLessEq (a1, a2)}
+  | a1 = aexpp; BCMPLESSEQ; a2 = aexpp    {BCmpLessEq (a1, a2)} // <=
-  | a1 = aexpp; BCMPGREATER; a2 = aexpp   {BCmpGreater (a1, a2)}
+  | a1 = aexpp; BCMPGREATER; a2 = aexpp   {BCmpGreater (a1, a2)} // >
-  | a1 = aexpp; BCMPGREATEREQ; a2 = aexpp {BCmpGreaterEq (a1, a2)}
+  | a1 = aexpp; BCMPGREATEREQ; a2 = aexpp {BCmpGreaterEq (a1, a2)} // >=
-  | LEFTPAR; b = bexpp; RIGHTPAR          {b}
+  | 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; PLUS; t2 = aexpp          {Plus (t1, t2)} // +
-  | t1 = aexpp; MINUS; t2 = aexpp         {Minus (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; TIMES; t2 = aexpp         {Times (t1, t2)} // *
-  | t1 = aexpp; DIVISION; t2 = aexpp      {Division (t1, t2)}
+  | t1 = aexpp; DIVISION; t2 = aexpp      {Division (t1, t2)} // /
-  | t1 = aexpp; MODULO; t2 = aexpp        {Modulo (t1, t2)}
+  | t1 = aexpp; MODULO; t2 = aexpp        {Modulo (t1, t2)} // %
-  | t1 = aexpp; POWER; t2 = aexpp         {Power (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 (..., ..., ...)
+    {PowerMod (t1, t2, t3)}               // powmod(..., ..., ...)
-  | RAND; LEFTPAR; t = aexpp; RIGHTPAR    {Rand (t)}
+  | RAND; LEFTPAR; t = aexpp; RIGHTPAR    {Rand (t)} // rand()
-  | LEFTPAR; a = aexpp; RIGHTPAR          {a}
+  | 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

@@ -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

@@ -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
+]

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

@@ -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

@@ -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/testingImpParser.ml

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