separated into modules, added parser and lexer for miniImp

.gitignore

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

bin/dune

@@ -1,4 +1,9 @@
 (executable
- (public_name main)
  (name main)
- (libraries lang))
+ (public_name main)
+ (libraries exercises
+            miniImp
+            miniFun
+            utility)
+ (package miniFun)
+ )

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/miniFun/dune

@@ -0,0 +1,6 @@
+(library
+ (name miniFun)
+ (public_name miniFun)
+ (libraries utility))
+
+(include_subdirs qualified)

lib/miniImp/Lexer.mll

@@ -0,0 +1,88 @@
+{
+  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 = [
+      ("main", MAIN);
+      ("skip", SKIP);
+      ("if", IF);
+      ("else", ELSE);
+      ("while", WHILE);
+      ("for", FOR);
+      ("do", DO);
+      ("true", BOOL(true));
+      ("false", BOOL(false));
+      ("not", BNOT);
+      ("rand", RAND);
+      ("powmod", POWERMOD);
+    ]
+    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)
+    }
+  | ";"             {SEQUENCE}
+  | ","             {COMMA}
+  | "{"             {LEFTGPAR}
+  | "}"             {RIGHTGPAR}
+  | "("             {LEFTPAR}
+  | ")"             {RIGHTPAR}
+  | "<"             {BCMPLESS}
+  | ">"             {BCMPGREATER}
+  | "+"             {PLUS}
+  | "-"             {MINUS}
+  | "*"             {TIMES}
+  | "/"             {DIVISION}
+  | "%"             {MODULO}
+  | "^"             {POWER}
+  | ":="            {ASSIGNMENT}
+  | "&&"            {BAND}
+  | "||"            {BOR}
+  | "=="            {BCMP}
+  | "<="            {BCMPLESSEQ}
+  | ">="            {BCMPGREATEREQ}
+  | 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 SKIP ASSIGNMENT SEQUENCE IF ELSE WHILE FOR DO COMMA
+%token LEFTGPAR RIGHTGPAR
+%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 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 twoseq
+%left SEQUENCE
+%left ELSE
+%left PLUS MINUS BOR BAND
+%left BNOT
+%left DIVISION
+%left MODULO
+%left TIMES
+%left POWER
+
+%%
+
+(* grammar *)
+prg:
+  | MAIN; a = VARIABLE; b = VARIABLE; LEFTGPAR; t = cexpp; RIGHTGPAR; EOF
+    {Main (a, b, t)}                   // main a b {...}
+cexpp:
+  | SKIP {Skip}                        // skip
+  | a = VARIABLE; ASSIGNMENT; body = aexpp
+    {Assignment (a, body)}             // a := ...
+  | t1 = cexpp; SEQUENCE; t2 = cexpp %prec twoseq
+    {Sequence (t1, t2)}                // ...; ...
+  | t = cexpp; SEQUENCE                {t} // ...;
+  | IF; LEFTPAR; guard = bexpp; RIGHTPAR; body1 = cexpp; ELSE; body2 = cexpp
+    {If (guard, body1, body2)}         // if (...) ... else ...
+  | WHILE; guard = bexpp; DO; LEFTGPAR; body = cexpp; RIGHTGPAR
+    {While (guard, body)}              // while ... do {...}
+  | FOR; LEFTPAR; ass = cexpp; COMMA; guard = bexpp; COMMA; iter = cexpp; RIGHTPAR;
+         DO; LEFTGPAR; body = cexpp; RIGHTGPAR
+    {For (ass, guard, iter, body)}     // for (..., ..., ...) do {...}
+  | LEFTGPAR; t = cexpp; RIGHTGPAR {t} // {...}
+bexpp:
+  | b = BOOL                              {Boolean (b)}
+  | b1 = bexpp; BAND; b2 = bexpp          {BAnd (b1, b2)}
+  | b1 = bexpp; BOR; b2 = bexpp           {BOr (b1, b2)}
+  | BNOT; b = bexpp                       {BNot (b)}
+  | 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}
+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)}
+  | LEFTPAR; a = aexpp; RIGHTPAR          {a}

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 *)

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 *)

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)
+ (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,15 @@
 (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/testingFun.ml

@@ -1,5 +1,5 @@
-open Lang.MiniFun
+open MiniFun.Semantics
-open Lang.MiniFunTypes
+open MiniFun.Types
 
 (* -------------------------------------------------------------------------- *)
 (* Identity program *)

test/testingImp.ml

@@ -1,5 +1,5 @@
-open Lang.MiniImp
+open MiniImp.Semantics
-open Lang.MiniImpTypes
+open MiniImp.Types
 
 (* -------------------------------------------------------------------------- *)
 (* Identity program *)

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: 0
+Miller-Rabin primality test program: 1

test/testingImpParser.ml

@@ -0,0 +1,129 @@
+open MiniImp
+
+let get_result x =
+  Lexing.from_string x |> Parser.prg MiniImp.Lexer.lex |> Semantics.reduce
+
+(* -------------------------------------------------------------------------- *)
+(* Identity program *)
+let program =
+  "main a b {b := a}"
+;;
+
+Printf.printf "Identity program: %d\n" (get_result program 1);;
+
+(* -------------------------------------------------------------------------- *)
+(* y not defined program *)
+let program =
+  "main a b {x := 1; b := a + x + y}"
+;;
+
+try
+  Printf.printf "y not defined program: %d\n" (get_result program 100)
+with Types.AbsentAssignment s ->
+  Printf.printf "y not defined program: %s\n" s
+;;
+
+(* -------------------------------------------------------------------------- *)
+(* Factorial program *)
+let program =
+"main a b {
+  b := 1;
+  for (i := 1, i <= a, i := i + 1) do {
+    b := b * i;
+  }
+}
+"
+;;
+
+Printf.printf "Factorial program: %d\n" (get_result program 10)
+;;
+
+(* -------------------------------------------------------------------------- *)
+(* Hailstone sequence's lenght program *)
+let program =
+"main a b {
+  b := 1;
+  while (not a == 1) do {
+    b :=  b + 1;
+    if ((a % 2) == 1) a := 3 * a + 1 else a := a / 2
+  }
+}"
+;;
+
+Printf.printf "Hailstone sequence's lenght program: %d\n" (get_result program 77031)
+;;
+
+(* -------------------------------------------------------------------------- *)
+(* Sum multiples of 3 and 5 program *)
+let program =
+"main a b {
+  b := 0;
+  for (i := 0, i <= a, i := i+1) do {
+    if ( i % 3 == 0 || i % 5 == 0) {b := b + i} else {skip}
+  }
+}"
+;;
+
+Printf.printf "Sum multiples of 3 and 5 program: %d\n" (get_result program 12345)
+;;
+
+(* -------------------------------------------------------------------------- *)
+(* Rand program *)
+let program =
+  "main a b {b := rand(a)}"
+;;
+
+Printf.printf "Rand program: %b\n" ((get_result program 10) < 10)
+;;
+
+(* -------------------------------------------------------------------------- *)
+(* Fibonacci program *)
+let program =
+"main n fnext {
+  fnow := 0;
+  fnext := 1;
+  while (n > 1) do {
+    tmp := fnow + fnext;
+    fnow := fnext;
+    fnext := tmp;
+    n := n - 1
+  }
+}"
+;;
+
+Printf.printf "Fibonacci program: %d\n" (get_result program 48)
+;;
+
+(* -------------------------------------------------------------------------- *)
+(* Miller-Rabin primality test program *)
+let program =
+"main n result {
+  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))
+        {result := 1}
+      else
+        {skip};
+      x := y
+    };
+    if (not y == 1) {result := 1} else {skip}
+  }
+}"
+
+;;
+
+(* should return 0 because prime *)
+Printf.printf "Miller-Rabin primality test program: %d\n" (get_result program 179424673)
+;;
+(* should return 1 because not prime *)
+Printf.printf "Miller-Rabin primality test program: %d\n" (get_result program 179424675)
+;;

test/testingTypeFun.ml

@@ -1,5 +1,5 @@
-open Lang.MiniTyFun
+open MiniFun.TypeChecker
-open Lang.MiniFunTypes
+open MiniFun.Types
 
 (* -------------------------------------------------------------------------- *)
 (* Error absent assignment program *)