elvis/lci
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Compleating assignment for interpreter, modified grammars, fixed tests

Browse Source
This commit is contained in:
elvis
2024-11-16 15:40:00 +01:00
parent 40055899c9
commit 9e599cc018
24 changed files with 593 additions and 1238 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
bin/dune
View File

@ -8,3 +8,21 @@
(package miniFun)
(modes byte exe)
)
(executable
(name miniFunInterpreter)
(public_name miniFunInterpreter)
(libraries miniFun
clap)
(package miniFun)
(modes byte exe)
)
(executable
(name miniImpInterpreter)
(public_name miniImpInterpreter)
(libraries miniImp
clap)
(package miniImp)
(modes byte exe)
)

15
bin/fibonacci-fixed-point.minifun Normal file
View File

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

25
bin/miller-rabin.miniimp Normal file
View File

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

100
bin/miniFunInterpreter.ml Normal file
View File

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

91
bin/miniImpInterpreter.ml Normal file
View File

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

8
bin/sum.miniimp Normal file
View File

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

4
lib/miniFun/Semantics.ml
View File

@ -5,7 +5,7 @@ Random.self_init ()
let (let*) = Result.bind
let rec evaluate (mem: memory) (command: t_exp) : (permittedValues, error) result =
let rec evaluate (mem: memory) (command: t_exp) : (permittedValues, [> error]) result =
match command with
Integer n -> Ok (IntegerPermitted n)
| Boolean b -> Ok (BooleanPermitted b)
@ -341,7 +341,7 @@ let rec evaluate (mem: memory) (command: t_exp) : (permittedValues, error) resul
evaluate mem2 rest
let reduce (program: t_exp) (iin : int) : (int, error) result =
let reduce (program: t_exp) (iin : int) : (int, [> error]) result =
let program' = (Application (program, (Integer iin))) in
let mem : memory = {assignments = VariableMap.empty} in
match (evaluate mem program') with

4
lib/miniFun/Semantics.mli
View File

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

4
lib/miniFun/TypeChecker.ml
View File

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

2
lib/miniFun/TypeChecker.mli
View File

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

13
lib/miniFun/Types.ml
View File

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

13
lib/miniFun/Types.mli
View File

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

46
lib/miniImp/Lexer.mll
View File

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

1016
lib/miniImp/Parser.messages
View File

File diff suppressed because it is too large Load Diff

80
lib/miniImp/Parser.mly
View File

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

160
lib/miniImp/Semantics.ml
View File

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

2
lib/miniImp/Semantics.mli
View File

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

6
lib/miniImp/Types.ml
View File

@ -38,5 +38,7 @@ type memory = {
assignments: int VariableMap.t
}
exception AbsentAssignment of string
exception DivisionByZero of string
type error = [
`AbsentAssignment of string
| `DivisionByZero of string
]

6
lib/miniImp/Types.mli
View File

@ -38,5 +38,7 @@ type memory = {
assignments: int VariableMap.t
}
exception AbsentAssignment of string
exception DivisionByZero of string
type error = [
`AbsentAssignment of string
| `DivisionByZero of string
]

4
test/testingImp.expected
View File

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

60
test/testingImp.ml
View File

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

4
test/testingImpParser.expected
View File

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

132
test/testingImpParser.ml
View File

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