Removed multiple input functions, added tuples, fixed parser

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

@@ -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})
@@ -345,7 +342,7 @@ let rec evaluate (mem: memory) (command: t_exp) : (permittedValues, error) resul
 
 
 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

lib/miniFun/TypeChecker.ml

@@ -15,59 +15,35 @@ let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) : (ftype,
                          ("The variable " ^ x ^ " is not defined."))
       | Some t -> Ok t
     )
-  | Function (xs, typef, fbody) -> (
+  | 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
-         that the number of inputs are the right number, finally eval the type
+         the type of the body using the bindings for the input *)
-         of the body using the bindings for the inputs *)
       match typef with
         FunctionType (tin, tout) -> (
-          if List.length xs <> List.length tin then
+          let* typefbody = evaluate_type fbody (VariableMap.add x tin context) in
-            Error (`WrongTypeSpecification
+          if (typefbody = tout) then
-                     ("Type specification for function has wrong arity."))
+            Ok typef
           else
-            let context1 = List.fold_left2
+            Error (`WrongTypeSpecification
-                (fun acc x t -> VariableMap.add x t acc)
+                     ("Function does not return specified type."))
-                context
-                xs
-                tin
-            in
-            let* typefbody = evaluate_type fbody context1 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, xs) -> (
+  | Application (f, x) -> (
-      (* check that the type is actually a function, then checks that the
-         supplied inputs are of the right type, returns the return type if all
-         inputs are supplied, otherwise a function from the remaining inputs to
-         the output types *)
       let* evalf = evaluate_type f context in
+      let* evalx = evaluate_type x context in
       match evalf with
         FunctionType (tin, tout) -> (
-          let rec helper (params: t_exp list) (typeparams: ftype list) =
+          if tin = evalx then
-            (* consumes until params are exausted *)
+            Ok tout
-            match (params, typeparams) with
+          else
-              ([], _) -> Ok typeparams
+            Error (`WrongType "Appling function with wrong input type to value")
-            | (_, []) -> Error (`WrongArity ("Function application has arity " ^
-                                            (List.length tin |> string_of_int) ^
-                                            ", but was applied to " ^
-                                            (List.length xs |> string_of_int) ^
-                                            " parameters"))
-            | (p::tlparams, v::tltypeparams) ->
-              if evaluate_type p context = Ok v then
-                helper tlparams tltypeparams
-              else
-                Error (`WrongType "Argument with wrong type.")
-          in
-          let* typesremaining = helper xs tin in
-          match typesremaining with
-            [] -> Ok tout
-          | t -> Ok (FunctionType (t, tout))
         )
       | _ -> Error (`WrongType "Applying to a non function type")
     )
@@ -117,6 +93,18 @@ let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) : (ftype,
       | (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)
@@ -146,26 +134,18 @@ let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) : (ftype,
     (* 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, xs, typef, fbody, rest) ->
+  | LetFun (f, x, typef, fbody, rest) ->
-    (* like with the function type, but also add f itself to the bindings *)
+    (* like with the function case, but also add f itself to the bindings *)
     match typef with
       FunctionType (tin, tout) -> (
-        if List.length xs <> List.length tin then
+        let newcontext = VariableMap.add f typef context in
-          Error (`WrongArity "Type specification for function has wrong arity.")
+        let newcontextwithx = VariableMap.add x tin newcontext in
-        else
+        let* typefbody = evaluate_type fbody newcontextwithx in
-          let context1 = VariableMap.add f typef context in
+        let* typerest = evaluate_type rest newcontext in
-          let context2 = List.fold_left2
+        match (typefbody = tout, typerest) with
-              (fun acc x t -> VariableMap.add x t acc)
+          (false, _) -> Error (`WrongTypeSpecification
-              context1
+                                 "Function does not return specified type.")
-              xs
+        | (true, t) -> Ok t
-              tin
-          in
-          let* typefbody = evaluate_type fbody context2 in
-          let* typerest = evaluate_type rest context1 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.")
@@ -173,7 +153,7 @@ let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) : (ftype,
 let typecheck (program: t_exp) : (ftype, error) result =
   let* typeprogram = evaluate_type program VariableMap.empty in
   match typeprogram with
-    FunctionType ([IntegerType], IntegerType) -> (
+    FunctionType (IntegerType, IntegerType) -> (
-      Ok (FunctionType ([IntegerType], IntegerType))
+      Ok (typeprogram)
     )
   | _ -> Error (`WrongType "Program is not a function from int to int.")

lib/miniFun/Types.ml

@@ -5,14 +5,16 @@ module VariableMap = Map.Make(String)
 type ftype =
     IntegerType
   | BooleanType
-  | FunctionType of ftype list * ftype
+  | TupleType of ftype * ftype
+  | FunctionType of ftype * ftype
 
 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 *)
@@ -21,9 +23,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 *)
@@ -31,14 +35,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
@@ -52,6 +57,5 @@ type error = [
     `AbsentAssignment of string
   | `WrongType of string
   | `DivisionByZero of string
-  | `WrongArity of string
   | `WrongTypeSpecification of string
 ]

lib/miniFun/Types.mli

@@ -5,14 +5,16 @@ module VariableMap : Map.S with type key = variable
 type ftype =
     IntegerType
   | BooleanType
-  | FunctionType of ftype list * ftype
+  | TupleType of ftype * ftype
+  | FunctionType of ftype * ftype
 
 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 *)
@@ -21,9 +23,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 *)
@@ -31,14 +35,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
@@ -52,6 +57,5 @@ type error = [
     `AbsentAssignment of string
   | `WrongType of string
   | `DivisionByZero of string
-  | `WrongArity of string
   | `WrongTypeSpecification of string
 ]

lib/miniFun/dune

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

test/dune

@@ -13,3 +13,7 @@
 (test
  (name testingTypeFun)
  (libraries miniFun))
+
+(test
+ (name testingTypeFunParser)
+ (libraries miniFun))

test/testingFun.ml

@@ -5,55 +5,66 @@ 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/testingImpParser.ml

@@ -1,7 +1,7 @@
 open MiniImp
 
 let get_result x =
-  Lexing.from_string x |> Parser.prg MiniImp.Lexer.lex |> Semantics.reduce
+  Lexing.from_string x |> Parser.prg Lexer.lex |> Semantics.reduce
 
 (* -------------------------------------------------------------------------- *)
 (* Identity program *)
@@ -118,7 +118,6 @@ let program =
     if (not y == 1) {result := 1} else {skip}
   }
 }"
-
 ;;
 
 (* should return 0 because prime *)

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

@@ -6,8 +6,8 @@ open MiniFun.Types
 
 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"