From 7ad217dfb0008bc090996c048f791d2d39e6cc6e Mon Sep 17 00:00:00 2001 From: elvis Date: Fri, 15 Nov 2024 17:23:04 +0100 Subject: [PATCH] Removed multiple input functions, added tuples, fixed parser --- lib/miniFun/Lexer.mll | 95 +++++++++++ lib/miniFun/Parser.mly | 98 +++++++++++ lib/miniFun/Semantics.ml | 85 +++++----- lib/miniFun/Semantics.mli | 2 + lib/miniFun/TypeChecker.ml | 104 +++++------- lib/miniFun/Types.ml | 24 +-- lib/miniFun/Types.mli | 24 +-- lib/miniFun/dune | 12 +- test/dune | 4 + test/testingFun.ml | 207 +++++++++++++++--------- test/testingImpParser.ml | 3 +- test/testingTypeFun.expected | 2 - test/testingTypeFun.ml | 184 ++++++++++----------- test/testingTypeFunParser.expected | 20 +++ test/testingTypeFunParser.ml | 251 +++++++++++++++++++++++++++++ 15 files changed, 808 insertions(+), 307 deletions(-) create mode 100644 lib/miniFun/Lexer.mll create mode 100644 lib/miniFun/Parser.mly create mode 100644 test/testingTypeFunParser.expected create mode 100644 test/testingTypeFunParser.ml diff --git a/lib/miniFun/Lexer.mll b/lib/miniFun/Lexer.mll new file mode 100644 index 0000000..f9ebd40 --- /dev/null +++ b/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 +} diff --git a/lib/miniFun/Parser.mly b/lib/miniFun/Parser.mly new file mode 100644 index 0000000..bfdec51 --- /dev/null +++ b/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 +%token VARIABLE +%token 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 prg +%type texp +%type 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)} diff --git a/lib/miniFun/Semantics.ml b/lib/miniFun/Semantics.ml index 1c4ac73..cd36897 100644 --- a/lib/miniFun/Semantics.ml +++ b/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 rec helper m params values = - 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 = ( + let* param = evaluate mem x in + let mem2 = match funcClosure.recursiveness with - None -> {assignments = mem2assignments} - | Some nameF -> { - assignments = - VariableMap.add - nameF - (FunctionPermitted funcClosure) - mem2assignments - } - ) in - match params with - [] -> evaluate mem2 funcClosure.body - | _ -> ( - Ok (FunctionPermitted {funcClosure with inputList = params; - assignments = mem2assignments})) + None -> {assignments = ( + VariableMap.add funcClosure.input param funcClosure.assignments)} + | Some nameF -> {assignments = ( + VariableMap.add funcClosure.input param funcClosure.assignments |> + VariableMap.add nameF (FunctionPermitted funcClosure) + )} + in + evaluate mem2 funcClosure.body ) | 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 diff --git a/lib/miniFun/Semantics.mli b/lib/miniFun/Semantics.mli index 9907835..1fe6f62 100644 --- a/lib/miniFun/Semantics.mli +++ b/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 diff --git a/lib/miniFun/TypeChecker.ml b/lib/miniFun/TypeChecker.ml index 2bfcdec..f84ac4f 100644 --- a/lib/miniFun/TypeChecker.ml +++ b/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 - of the body using the bindings for the inputs *) + the type of the body using the bindings for the input *) match typef with FunctionType (tin, tout) -> ( - if List.length xs <> List.length tin then - Error (`WrongTypeSpecification - ("Type specification for function has wrong arity.")) + let* typefbody = evaluate_type fbody (VariableMap.add x tin context) in + if (typefbody = tout) then + Ok typef else - let context1 = List.fold_left2 - (fun acc x t -> VariableMap.add x t acc) - 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 + ("Function does not return specified type.")) ) | _ -> Error (`WrongTypeSpecification ("Specification of function is not a function type.")) ) - | Application (f, xs) -> ( - (* 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 *) + | Application (f, x) -> ( 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) = - (* consumes until params are exausted *) - match (params, typeparams) with - ([], _) -> Ok typeparams - | (_, []) -> 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)) + if tin = evalx then + Ok tout + else + Error (`WrongType "Appling function with wrong input type to value") ) | _ -> Error (`WrongType "Applying to a non function type") ) @@ -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) -> - (* like with the function type, but also add f itself to the bindings *) + | LetFun (f, x, typef, fbody, rest) -> + (* like with the function case, but also add f itself to the bindings *) match typef with FunctionType (tin, tout) -> ( - if List.length xs <> List.length tin then - Error (`WrongArity "Type specification for function has wrong arity.") - else - let context1 = VariableMap.add f typef context in - let context2 = List.fold_left2 - (fun acc x t -> VariableMap.add x t acc) - context1 - xs - 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 + let newcontext = VariableMap.add f typef context in + let newcontextwithx = VariableMap.add x tin newcontext in + let* typefbody = evaluate_type fbody newcontextwithx in + let* typerest = evaluate_type rest newcontext in + match (typefbody = tout, typerest) with + (false, _) -> Error (`WrongTypeSpecification + "Function does not return specified type.") + | (true, t) -> Ok t ) | _ -> Error (`WrongTypeSpecification "Specification of function is not a function type.") @@ -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) -> ( - Ok (FunctionType ([IntegerType], IntegerType)) + FunctionType (IntegerType, IntegerType) -> ( + Ok (typeprogram) ) | _ -> Error (`WrongType "Program is not a function from int to int.") diff --git a/lib/miniFun/Types.ml b/lib/miniFun/Types.ml index cfb694b..bc526df 100644 --- a/lib/miniFun/Types.ml +++ b/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 *) - | Application of t_exp * t_exp list (* x x *) + | Tuple of t_exp * t_exp (* (a, b) *) + | 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 *) - | BOr of t_exp * t_exp (* x or x *) + | BAnd of t_exp * t_exp (* x && 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 - | BooleanPermitted of bool + IntegerPermitted of int + | 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 ] diff --git a/lib/miniFun/Types.mli b/lib/miniFun/Types.mli index 2cedefd..74bd6ba 100644 --- a/lib/miniFun/Types.mli +++ b/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 *) - | Application of t_exp * t_exp list (* x x *) + | Tuple of t_exp * t_exp (* (a, b) *) + | 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 *) - | BOr of t_exp * t_exp (* x or x *) + | BAnd of t_exp * t_exp (* x && 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 - | BooleanPermitted of bool + IntegerPermitted of int + | 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 ] diff --git a/lib/miniFun/dune b/lib/miniFun/dune index 92a977f..2b0876b 100644 --- a/lib/miniFun/dune +++ b/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) \ No newline at end of file diff --git a/test/dune b/test/dune index 01caa84..dbab5bc 100644 --- a/test/dune +++ b/test/dune @@ -13,3 +13,7 @@ (test (name testingTypeFun) (libraries miniFun)) + +(test + (name testingTypeFunParser) + (libraries miniFun)) \ No newline at end of file diff --git a/test/testingFun.ml b/test/testingFun.ml index 8904f20..9977d44 100644 --- a/test/testingFun.ml +++ b/test/testingFun.ml @@ -5,55 +5,66 @@ open MiniFun.Types (* Identity program *) let program = Function - (["a"], - FunctionType ([IntegerType], IntegerType), + ("a", + 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"], - FunctionType ([IntegerType], IntegerType), + ("a", + 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"], - FunctionType ([IntegerType; IntegerType], IntegerType), - Plus (Variable "x", Variable "y"))), - (Application (Variable "f", [Integer 3])) + (Function ("x", + FunctionType (IntegerType, FunctionType (IntegerType, IntegerType)), + (Function ("y", FunctionType (IntegerType, IntegerType), + 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"], - FunctionType ([IntegerType], IntegerType), - (Function (["y"], - FunctionType ([IntegerType], IntegerType), + "x", + FunctionType (IntegerType, IntegerType), + (Function ("y", + 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"], - FunctionType ([FunctionType ([IntegerType], IntegerType)], IntegerType), + "z", + FunctionType (FunctionType (IntegerType, IntegerType), IntegerType), (Function ( - ["y"], - FunctionType ([FunctionType ([IntegerType], IntegerType)], IntegerType), + "y", + FunctionType (FunctionType (IntegerType, IntegerType), IntegerType), Function ( - ["x"], - FunctionType ([IntegerType], IntegerType), + "x", + FunctionType (IntegerType, IntegerType), (IfThenElse ( CmpLess (Variable "x", Integer 0), - (Application (Variable "y", [Variable "x"])), - (Application (Variable "z", [Variable "x"])) + (Application (Variable "y", 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))); -Printf.printf "Passing functions to functions program 2: %d\n" (Result.get_ok (reduce program (-3))) +match reduce program (3) with + 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"], - FunctionType ([IntegerType], IntegerType), - (IfThenElse (CmpLess (Variable "x", Integer 2),Integer 1, Plus (Variable "x", Application (Variable "f", [Minus (Variable "x", Integer 1)])))), + "x", + FunctionType (IntegerType, IntegerType), + (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"], - FunctionType ([IntegerType], IntegerType), - (IfThenElse (CmpLessEq (Variable "x", Integer 0), Integer 1, Times (Variable "x", Application (Variable "f", [Minus (Variable "x", Integer 1)])))), + "x", + FunctionType (IntegerType, IntegerType), + (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"], - FunctionType ([IntegerType; IntegerType], IntegerType), + "input", + FunctionType (TupleType (IntegerType, IntegerType), IntegerType), ( - IfThenElse (BNot (Cmp (Variable "n", Integer 1)), - (IfThenElse (Cmp (Modulo (Variable "n", Integer 2), Integer 0), - Application (Variable "collatz", [Division (Variable "n", Integer 2); Plus (Integer 1, Variable "count")]), - Application (Variable "collatz", [(Plus (Integer 1, Times (Integer 3, Variable "n"))); Plus (Integer 1, Variable "count")]))), - (Variable "count")) + IfThenElse (BNot (Cmp (First (Variable "input"), Integer 1)), + (IfThenElse (Cmp (Modulo (First (Variable "input"), Integer 2), Integer 0), + Application (Variable "collatz", + Tuple ( + 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"], - FunctionType ([IntegerType], IntegerType), - Application (Variable "collatz", [Variable "x"; Integer 1]))) + (Function ("x", + FunctionType (IntegerType, IntegerType), + 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"], - FunctionType ([IntegerType], IntegerType), + "n", + 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"], - FunctionType ([IntegerType], IntegerType), + "x", + 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"], - FunctionType ([IntegerType; IntegerType; IntegerType], IntegerType), - (IfThenElse (Cmp (Variable "i", Integer 0), - Variable "a", - Application (Variable "fib", [Minus (Variable "i", Integer 1); - Variable "b"; - Plus (Variable "a", Variable "b")]) - )), - Function (["x"], - FunctionType ([IntegerType], IntegerType), - (Application (Variable "fib", [Variable "x"; Integer 0; Integer 1]))) + "i", + FunctionType (IntegerType, FunctionType (IntegerType, FunctionType (IntegerType, IntegerType))), + Function ( + "a", + FunctionType (IntegerType, FunctionType (IntegerType, IntegerType)), + Function ( + "b", + FunctionType (IntegerType, IntegerType), + (IfThenElse (Cmp (Variable "i", Integer 0), + Variable "a", + 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" diff --git a/test/testingImpParser.ml b/test/testingImpParser.ml index 676ddc9..97a391f 100644 --- a/test/testingImpParser.ml +++ b/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 *) diff --git a/test/testingTypeFun.expected b/test/testingTypeFun.expected index e790c2c..37c44f4 100644 --- a/test/testingTypeFun.expected +++ b/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) diff --git a/test/testingTypeFun.ml b/test/testingTypeFun.ml index 69e23bc..581d0e9 100644 --- a/test/testingTypeFun.ml +++ b/test/testingTypeFun.ml @@ -6,8 +6,8 @@ open MiniFun.Types let program = Function - (["a"], - FunctionType ([IntegerType], IntegerType), + ("a", + 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"], - FunctionType ([IntegerType], BooleanType), + ("a", + 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"], - FunctionType ([IntegerType; IntegerType], IntegerType), - (Variable "a") + ("a", + FunctionType (IntegerType, FunctionType (IntegerType, IntegerType)), + 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"], - FunctionType ([IntegerType], IntegerType), + "x", + 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"], - FunctionType ([IntegerType], IntegerType), + "x", + FunctionType (IntegerType, IntegerType), IfThenElse (Integer 1, Integer 2, Integer 1) ) ;; @@ -142,8 +113,8 @@ match typecheck program with (* Identity program *) let program = Function - (["a"], - FunctionType ([IntegerType], IntegerType), + ("a", + FunctionType (IntegerType, IntegerType), (Variable "a") ) ;; @@ -156,8 +127,8 @@ match typecheck program with (* Constant program *) let program = Function - (["a"], - FunctionType ([IntegerType], IntegerType), + ("a", + FunctionType (IntegerType, IntegerType), (Integer 1) ) ;; @@ -171,10 +142,15 @@ match typecheck program with let program = LetIn ("f", - (Function (["x"; "y"], - FunctionType ([IntegerType; IntegerType], IntegerType), - Plus (Variable "x", Variable "y"))), - (Application (Variable "f", [Integer 3])) + (Function ( + "x", + FunctionType (IntegerType, FunctionType (IntegerType, IntegerType)), + 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"], - FunctionType ([IntegerType], FunctionType ([IntegerType], IntegerType)), - (Function (["y"], - FunctionType ([IntegerType], IntegerType), + "x", + FunctionType (IntegerType, FunctionType (IntegerType, IntegerType)), + (Function ("y", + 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"], - FunctionType ([FunctionType ([IntegerType], IntegerType)], FunctionType ([FunctionType ([IntegerType], IntegerType)], FunctionType ([IntegerType], IntegerType))), + "z", + FunctionType (FunctionType (IntegerType, IntegerType), FunctionType (FunctionType (IntegerType, IntegerType), FunctionType (IntegerType, IntegerType))), (Function ( - ["y"], - FunctionType ([FunctionType ([IntegerType], IntegerType)], FunctionType ([IntegerType], IntegerType)), + "y", + FunctionType (FunctionType (IntegerType, IntegerType), FunctionType (IntegerType, IntegerType)), Function ( - ["x"], - FunctionType ([IntegerType], IntegerType), + "x", + FunctionType (IntegerType, IntegerType), (IfThenElse ( CmpLess (Variable "x", Integer 0), - (Application (Variable "y", [Variable "x"])), - (Application (Variable "z", [Variable "x"])) + (Application (Variable "y", 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"], - FunctionType ([IntegerType], IntegerType), - (IfThenElse (CmpLess (Variable "x", Integer 2),Integer 1, Plus (Variable "x", Application (Variable "f", [Minus (Variable "x", Integer 1)])))), + "x", + FunctionType (IntegerType, IntegerType), + (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"], - FunctionType ([IntegerType], IntegerType), - (IfThenElse (CmpLessEq (Variable "x", Integer 0), Integer 1, Times (Variable "x", Application (Variable "f", [Minus (Variable "x", Integer 1)])))), + "x", + FunctionType (IntegerType, IntegerType), + (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"], - FunctionType ([IntegerType; IntegerType], IntegerType), + "input", + FunctionType (TupleType (IntegerType, IntegerType), IntegerType), ( - IfThenElse (BNot (Cmp (Variable "n", Integer 1)), - (IfThenElse (Cmp (Modulo (Variable "n", Integer 2), Integer 0), - Application (Variable "collatz", [Division (Variable "n", Integer 2); Plus (Integer 1, Variable "count")]), - Application (Variable "collatz", [(Plus (Integer 1, Times (Integer 3, Variable "n"))); Plus (Integer 1, Variable "count")]))), - (Variable "count")) + IfThenElse (BNot (Cmp (First (Variable "input"), Integer 1)), + (IfThenElse (Cmp (Modulo (First (Variable "input"), Integer 2), Integer 0), + Application (Variable "collatz", + Tuple ( + 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"], - FunctionType ([IntegerType], IntegerType), - Application (Variable "collatz", [Variable "x"; Integer 1]))) + (Function ("x", + FunctionType (IntegerType, IntegerType), + Application (Variable "collatz", Tuple (Variable "x", Integer 1))) + ) ) ;; @@ -315,13 +298,13 @@ match typecheck program with let program = LetFun ( "sum", - ["n"], - FunctionType ([IntegerType], IntegerType), + "n", + 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"], - FunctionType ([IntegerType], IntegerType), + "x", + FunctionType (IntegerType, IntegerType), Rand (Variable "x") ) @@ -352,19 +335,20 @@ match typecheck program with let program = LetFun ( "fib", - ["i"; "a"; "b"], - FunctionType ([IntegerType; IntegerType; IntegerType], IntegerType), - (IfThenElse (Cmp (Variable "i", Integer 0), - Variable "a", - Application (Variable "fib", [Minus (Variable "i", Integer 1); - Variable "b"; - Plus (Variable "a", Variable "b")]) + "input", + FunctionType (TupleType (TupleType (IntegerType, IntegerType), IntegerType), IntegerType), + (IfThenElse (Cmp (First (First (Variable "input")), Integer 0), + Second (First (Variable "input")), + Application (Variable "fib", + Tuple ( Tuple ( + Minus (First (First (Variable "input")), Integer 1), + Second (Variable "input")), + Plus (Second (First (Variable "input")), Second (Variable "input")))) )), - Function (["x"], - FunctionType ([IntegerType], IntegerType), - (Application (Variable "fib", [Variable "x"; Integer 0; Integer 1]))) + Function ("x", + FunctionType (IntegerType, IntegerType), + (Application (Variable "fib", Tuple (Tuple (Variable "x", Integer 0), Integer 1)))) ) - ;; match typecheck program with diff --git a/test/testingTypeFunParser.expected b/test/testingTypeFunParser.expected new file mode 100644 index 0000000..d427952 --- /dev/null +++ b/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 diff --git a/test/testingTypeFunParser.ml b/test/testingTypeFunParser.ml new file mode 100644 index 0000000..dad6fc8 --- /dev/null +++ b/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"