Merge with cfg
This commit is contained in:
elvis
1
.gitignore
vendored
1
.gitignore
vendored
@ -25,6 +25,7 @@ setup.log
|
||||
|
||||
# Dune generated files
|
||||
*.install
|
||||
*.opam
|
||||
|
||||
# Local OPAM switch
|
||||
_opam/
|
||||
|
||||
30
bin/dune
30
bin/dune
@ -1,4 +1,28 @@
|
||||
(executable
|
||||
(public_name main)
|
||||
(name main)
|
||||
(libraries lang))
|
||||
(name main)
|
||||
(public_name main)
|
||||
(libraries exercises
|
||||
miniImp
|
||||
miniFun
|
||||
utility)
|
||||
(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
15
bin/fibonacci-fixed-point.minifun
Normal 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
|
||||
21
bin/main.ml
21
bin/main.ml
@ -1 +1,20 @@
|
||||
print_endline "Hello!"
|
||||
open MiniImp
|
||||
open MiniImp.Cfg
|
||||
|
||||
let () =
|
||||
let program = "def main with input x output y as
|
||||
x := 2;
|
||||
if y < 0 then (
|
||||
y := x + 3;
|
||||
x := y;
|
||||
) else
|
||||
x := 1 - y;" in
|
||||
|
||||
|
||||
let get_result x = Lexing.from_string x |> Parser.prg Lexer.lex in
|
||||
|
||||
let p = get_result program in
|
||||
|
||||
let converted = convert p in
|
||||
|
||||
Printf.printf "%a" Cfg.pp converted
|
||||
|
||||
25
bin/miller-rabin.miniimp
Normal file
25
bin/miller-rabin.miniimp
Normal 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
100
bin/miniFunInterpreter.ml
Normal 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
91
bin/miniImpInterpreter.ml
Normal 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
8
bin/sum.miniimp
Normal 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
|
||||
16
dune-project
16
dune-project
@ -4,6 +4,20 @@
|
||||
|
||||
(generate_opam_files true)
|
||||
|
||||
(using menhir 3.0)
|
||||
|
||||
(package
|
||||
(name lang)
|
||||
(name utility)
|
||||
(depends ocaml dune))
|
||||
|
||||
(package
|
||||
(name miniImp)
|
||||
(depends ocaml dune utility))
|
||||
|
||||
(package
|
||||
(name miniFun)
|
||||
(depends ocaml dune utility))
|
||||
|
||||
(package
|
||||
(name exercises)
|
||||
(depends ocaml dune))
|
||||
|
||||
21
lang.opam
21
lang.opam
@ -1,21 +0,0 @@
|
||||
# This file is generated by dune, edit dune-project instead
|
||||
opam-version: "2.0"
|
||||
depends: [
|
||||
"ocaml"
|
||||
"dune" {>= "3.16"}
|
||||
"odoc" {with-doc}
|
||||
]
|
||||
build: [
|
||||
["dune" "subst"] {dev}
|
||||
[
|
||||
"dune"
|
||||
"build"
|
||||
"-p"
|
||||
name
|
||||
"-j"
|
||||
jobs
|
||||
"@install"
|
||||
"@runtest" {with-test}
|
||||
"@doc" {with-doc}
|
||||
]
|
||||
]
|
||||
5
lib/dune
5
lib/dune
@ -1,5 +0,0 @@
|
||||
(library
|
||||
(name lang)
|
||||
(public_name lang))
|
||||
|
||||
(include_subdirs qualified)
|
||||
5
lib/exercises/dune
Normal file
5
lib/exercises/dune
Normal file
@ -0,0 +1,5 @@
|
||||
(library
|
||||
(name exercises)
|
||||
(public_name exercises))
|
||||
|
||||
(include_subdirs qualified)
|
||||
@ -34,10 +34,10 @@ type 'a my_tree =
|
||||
let mod_list y =
|
||||
(List.fold_left
|
||||
(fun acc x ->
|
||||
match acc with
|
||||
| [a] when ((List.hd a) = x) -> [x :: a]
|
||||
| a :: tl when ((List.hd a) = x) -> (x :: a) :: tl
|
||||
| _ -> [x] :: acc)
|
||||
match acc with
|
||||
| [a] when ((List.hd a) = x) -> [x :: a]
|
||||
| a :: tl when ((List.hd a) = x) -> (x :: a) :: tl
|
||||
| _ -> [x] :: acc)
|
||||
[]
|
||||
y)
|
||||
|> List.rev
|
||||
@ -46,7 +46,7 @@ let mod_list y =
|
||||
|
||||
let to_tup f g =
|
||||
fun x -> match x with
|
||||
(a, b) -> (f a, g b)
|
||||
(a, b) -> (f a, g b)
|
||||
|
||||
let partialsum l =
|
||||
snd (List.fold_left_map (fun acc x -> (acc+x, acc+x)) 0 l)
|
||||
13
lib/lang.ml
13
lib/lang.ml
@ -1,13 +0,0 @@
|
||||
module Exercises = Exercises
|
||||
|
||||
(* -------------------------------- MINI IMP -------------------------------- *)
|
||||
module MiniImpTypes = MiniImp.Types
|
||||
|
||||
module MiniImp = MiniImp.Semantics
|
||||
|
||||
(* -------------------------------- MINI FUN -------------------------------- *)
|
||||
module MiniFunTypes = MiniFun.Types
|
||||
|
||||
module MiniTyFun = MiniFun.TypeChecker
|
||||
|
||||
module MiniFun = MiniFun.Semantics
|
||||
95
lib/miniFun/Lexer.mll
Normal file
95
lib/miniFun/Lexer.mll
Normal file
@ -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
|
||||
}
|
||||
98
lib/miniFun/Parser.mly
Normal file
98
lib/miniFun/Parser.mly
Normal file
@ -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)}
|
||||
@ -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)
|
||||
@ -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})
|
||||
@ -344,8 +341,8 @@ 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 program' = (Application (program, [(Integer iin)])) in
|
||||
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
|
||||
Ok IntegerPermitted a -> Ok a
|
||||
|
||||
@ -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
|
||||
|
||||
val reduce : Types.t_exp -> int -> (int, [> Types.error]) result
|
||||
|
||||
@ -5,11 +5,10 @@ Random.self_init ()
|
||||
|
||||
let (let*) = Result.bind
|
||||
|
||||
|
||||
let rec principalTypings (D: ) (e: t_exp) : () result
|
||||
|
||||
let evaluate_type (_program: t_exp) (_context: typingshape) : (typingshape, error) result =
|
||||
failwith "asd"
|
||||
let evaluate_type_polimorphic (_program: t_exp) (_context: typingshape) : (typingshape, error) result =
|
||||
failwith "Not implemented"
|
||||
(* match program with *)
|
||||
(* Integer _ -> Ok (VariableMap.empty, IntegerType) *)
|
||||
(* | Boolean _ -> Ok (VariableMap.empty, BooleanType) *)
|
||||
@ -56,5 +55,155 @@ let evaluate_type (_program: t_exp) (_context: typingshape) : (typingshape, erro
|
||||
(* | LetIn (x, xval, rest) -> failwith "Not Implemented" *)
|
||||
(* | LetFun (f, xs, typef, fbody, rest) -> failwith "Not Implemented" *)
|
||||
|
||||
let typecheck (_program: t_exp) : (ftype, error) result =
|
||||
failwith "Not Implemented"
|
||||
let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) : (ftype, [> typechecking_error]) result =
|
||||
match program with
|
||||
Integer _ -> Ok IntegerType
|
||||
| Boolean _ -> Ok BooleanType
|
||||
| Variable x -> ( (* check for the type in the context *)
|
||||
match VariableMap.find_opt x context with
|
||||
None -> Error (`AbsentAssignment
|
||||
("The variable " ^ x ^ " is not defined."))
|
||||
| Some t -> Ok t
|
||||
)
|
||||
| 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
|
||||
the type of the body using the bindings for the input *)
|
||||
match typef with
|
||||
FunctionType (tin, tout) -> (
|
||||
let* typefbody = evaluate_type fbody (VariableMap.add x tin context) 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, x) -> (
|
||||
let* evalf = evaluate_type f context in
|
||||
let* evalx = evaluate_type x context in
|
||||
match evalf with
|
||||
FunctionType (tin, 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")
|
||||
)
|
||||
| Plus (x, y)
|
||||
| Minus (x, y)
|
||||
| Times (x, y)
|
||||
| Division (x, y)
|
||||
| Modulo (x, y)
|
||||
| Power (x, y) -> (
|
||||
let* typex = evaluate_type x context in
|
||||
let* typey = evaluate_type y context in
|
||||
match typex, typey with
|
||||
| (IntegerType, IntegerType) -> Ok IntegerType
|
||||
| (IntegerType, _) -> Error (`WrongType "Second term is not an integer.")
|
||||
| (_, _) -> Error (`WrongType "First term is not an integer.")
|
||||
)
|
||||
| PowerMod (x, y, z) -> (
|
||||
let* typex = evaluate_type x context in
|
||||
let* typey = evaluate_type y context in
|
||||
let* typez = evaluate_type z context in
|
||||
match typex, typey, typez with
|
||||
| (IntegerType, IntegerType, IntegerType) -> Ok IntegerType
|
||||
| (IntegerType, IntegerType, _) -> Error (`WrongType ("Third term is " ^
|
||||
"not an integer."))
|
||||
| (IntegerType, _, _) -> Error (`WrongType
|
||||
("Second term is not an integer."))
|
||||
| (_, _, _) -> Error (`WrongType "First term is not an integer.")
|
||||
)
|
||||
| Rand (x) -> (
|
||||
let* typex = evaluate_type x context in
|
||||
match typex with
|
||||
| (IntegerType) -> Ok IntegerType
|
||||
| (_) -> Error (`WrongType "Term is not an integer.")
|
||||
)
|
||||
| BAnd (x, y)
|
||||
| BOr (x, y) -> (
|
||||
let* typex = evaluate_type x context in
|
||||
let* typey = evaluate_type y context in
|
||||
match typex, typey with
|
||||
| (BooleanType, BooleanType) -> Ok BooleanType
|
||||
| (BooleanType, _) -> Error (`WrongType "Second term is not a boolean.")
|
||||
| (_, _) -> Error (`WrongType "First term is not a boolean.")
|
||||
)
|
||||
| BNot (x) -> (
|
||||
let* typex = evaluate_type x context in
|
||||
match typex with
|
||||
| (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)
|
||||
| CmpGreater (x, y)
|
||||
| CmpGreaterEq (x, y) -> (
|
||||
let* typex = evaluate_type x context in
|
||||
let* typey = evaluate_type y context in
|
||||
match typex, typey with
|
||||
| (IntegerType, IntegerType) -> Ok BooleanType
|
||||
| (IntegerType, _) -> Error (`WrongType "Second term is not an integer.")
|
||||
| (_, _) -> Error (`WrongType "First term is not an integer.")
|
||||
)
|
||||
| IfThenElse (guard, if_exp, else_exp) -> (
|
||||
let* typeguard = evaluate_type guard context in
|
||||
let* typeif_exp = evaluate_type if_exp context in
|
||||
let* typeelse_exp = evaluate_type else_exp context in
|
||||
match typeguard, typeif_exp, typeelse_exp with
|
||||
(BooleanType, t1, t2) -> (
|
||||
if t1 = t2 then
|
||||
Ok t1
|
||||
else
|
||||
Error (`WrongType "If branches do not have the same type.")
|
||||
)
|
||||
| (_, _, _) -> Error (`WrongType "If guard is not a boolean.")
|
||||
)
|
||||
| LetIn (x, xval, rest) ->
|
||||
(* 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, x, typef, fbody, rest) ->
|
||||
(* like with the function case, but also add f itself to the bindings *)
|
||||
match typef with
|
||||
FunctionType (tin, tout) -> (
|
||||
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.")
|
||||
|
||||
let typecheck (program: t_exp) : (ftype, [> typechecking_error]) result =
|
||||
let* typeprogram = evaluate_type program VariableMap.empty in
|
||||
match typeprogram with
|
||||
FunctionType (IntegerType, IntegerType) -> (
|
||||
Ok (typeprogram)
|
||||
)
|
||||
| _ -> Error (`WrongType "Program is not a function from int to int.")
|
||||
|
||||
@ -1 +1 @@
|
||||
val typecheck : Types.t_exp -> (Types.ftype, Types.error) result
|
||||
val typecheck : Types.t_exp -> (Types.ftype, [> Types.typechecking_error]) result
|
||||
|
||||
@ -8,8 +8,9 @@ module VariableSet = Set.Make(String)
|
||||
type ftype =
|
||||
IntegerType
|
||||
| BooleanType
|
||||
| TupleType of ftype * ftype
|
||||
| PolimorphicType of string
|
||||
| FunctionType of ftype list * ftype
|
||||
| FunctionType of ftype * ftype
|
||||
type fsubstitution = (* goes from polimorphic types to types *)
|
||||
ftype VariableMap.t
|
||||
type fenvironment = (* goes from variables to types *)
|
||||
@ -21,8 +22,9 @@ 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 *)
|
||||
@ -31,9 +33,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 *)
|
||||
@ -41,14 +45,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
|
||||
@ -58,10 +63,18 @@ type memory = {
|
||||
assignments: permittedValues VariableMap.t
|
||||
}
|
||||
|
||||
type error = [
|
||||
|
||||
type base_error = [
|
||||
`AbsentAssignment of string
|
||||
| `WrongType of string
|
||||
| `DivisionByZero of string
|
||||
| `WrongArity of string
|
||||
]
|
||||
|
||||
type typechecking_error = [
|
||||
| base_error
|
||||
| `WrongTypeSpecification of string
|
||||
]
|
||||
|
||||
type error = [
|
||||
| base_error
|
||||
| `DivisionByZero of string
|
||||
]
|
||||
|
||||
@ -8,8 +8,9 @@ module VariableSet : Set.S with type elt = string
|
||||
type ftype =
|
||||
IntegerType
|
||||
| BooleanType
|
||||
| TupleType of ftype * ftype
|
||||
| PolimorphicType of variable
|
||||
| FunctionType of ftype list * ftype
|
||||
| FunctionType of ftype * ftype
|
||||
type fsubstitution = (* goes from polimorphic types to types *)
|
||||
ftype VariableMap.t
|
||||
type fenvironment = (* goes from variables to types *)
|
||||
@ -47,8 +48,9 @@ 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 *)
|
||||
@ -57,9 +59,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 *)
|
||||
@ -67,14 +71,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
|
||||
@ -84,10 +89,18 @@ type memory = {
|
||||
assignments: permittedValues VariableMap.t
|
||||
}
|
||||
|
||||
type error = [
|
||||
|
||||
type base_error = [
|
||||
`AbsentAssignment of string
|
||||
| `WrongType of string
|
||||
| `DivisionByZero of string
|
||||
| `WrongArity of string
|
||||
]
|
||||
|
||||
type typechecking_error = [
|
||||
| base_error
|
||||
| `WrongTypeSpecification of string
|
||||
]
|
||||
|
||||
type error = [
|
||||
| base_error
|
||||
| `DivisionByZero of string
|
||||
]
|
||||
|
||||
16
lib/miniFun/dune
Normal file
16
lib/miniFun/dune
Normal file
@ -0,0 +1,16 @@
|
||||
(ocamllex Lexer)
|
||||
|
||||
(menhir
|
||||
(modules Parser)
|
||||
(explain true)
|
||||
(infer true)
|
||||
(flags --dump --table)
|
||||
)
|
||||
|
||||
(library
|
||||
(name miniFun)
|
||||
(public_name miniFun)
|
||||
(modules Lexer Parser Types Semantics TypeChecker)
|
||||
(libraries utility menhirLib))
|
||||
|
||||
(include_subdirs qualified)
|
||||
316
lib/miniImp/Cfg.ml
Normal file
316
lib/miniImp/Cfg.ml
Normal file
@ -0,0 +1,316 @@
|
||||
type simpleStatements =
|
||||
| SimpleSkip
|
||||
| SimpleAssignment of Types.variable * simpleArithmetic
|
||||
| SimpleGuard of simpleBoolean
|
||||
and simpleBoolean =
|
||||
| SimpleBoolean of bool
|
||||
| SimpleBAnd of simpleBoolean * simpleBoolean
|
||||
| SimpleBOr of simpleBoolean * simpleBoolean
|
||||
| SimpleBNot of simpleBoolean
|
||||
| SimpleBCmp of simpleArithmetic * simpleArithmetic
|
||||
| SimpleBCmpLess of simpleArithmetic * simpleArithmetic
|
||||
| SimpleBCmpLessEq of simpleArithmetic * simpleArithmetic
|
||||
| SimpleBCmpGreater of simpleArithmetic * simpleArithmetic
|
||||
| SimpleBCmpGreaterEq of simpleArithmetic * simpleArithmetic
|
||||
and simpleArithmetic =
|
||||
| SimpleVariable of Types.variable
|
||||
| SimpleInteger of int
|
||||
| SimplePlus of simpleArithmetic * simpleArithmetic
|
||||
| SimpleMinus of simpleArithmetic * simpleArithmetic
|
||||
| SimpleTimes of simpleArithmetic * simpleArithmetic
|
||||
| SimpleDivision of simpleArithmetic * simpleArithmetic
|
||||
| SimpleModulo of simpleArithmetic * simpleArithmetic
|
||||
| SimplePower of simpleArithmetic * simpleArithmetic
|
||||
| SimplePowerMod of simpleArithmetic * simpleArithmetic * simpleArithmetic
|
||||
| SimpleRand of simpleArithmetic
|
||||
|
||||
let printSingleStatement (ppf) (c: simpleStatements) : unit =
|
||||
let rec helper_c (ppf) (c: simpleStatements) : unit =
|
||||
match c with
|
||||
| SimpleSkip -> Printf.fprintf ppf "Skip"
|
||||
| SimpleAssignment (v, a) -> Printf.fprintf ppf "Assignment {%s, %a}" v helper_a a
|
||||
| SimpleGuard (b) -> Printf.fprintf ppf "Guard {%a}" helper_b b
|
||||
and helper_b (ppf) (c: simpleBoolean) : unit =
|
||||
match c with
|
||||
| SimpleBoolean b -> Printf.fprintf ppf "%b" b
|
||||
| SimpleBAnd (b1, b2) -> Printf.fprintf ppf "{%a && %a}" helper_b b1 helper_b b2
|
||||
| SimpleBOr (b1, b2) -> Printf.fprintf ppf "{%a || %a}" helper_b b1 helper_b b2
|
||||
| SimpleBNot b -> Printf.fprintf ppf "{not %a}" helper_b b
|
||||
| SimpleBCmp (a1, a2) -> Printf.fprintf ppf "{%a == %a}" helper_a a1 helper_a a2
|
||||
| SimpleBCmpLess (a1, a2) -> Printf.fprintf ppf "{%a < %a}" helper_a a1 helper_a a2
|
||||
| SimpleBCmpLessEq (a1, a2) -> Printf.fprintf ppf "{%a <= %a}" helper_a a1 helper_a a2
|
||||
| SimpleBCmpGreater (a1, a2) -> Printf.fprintf ppf "{%a > %a}" helper_a a1 helper_a a2
|
||||
| SimpleBCmpGreaterEq (a1, a2) -> Printf.fprintf ppf "{%a >= %a}" helper_a a1 helper_a a2
|
||||
and helper_a (ppf) (c: simpleArithmetic) : unit =
|
||||
match c with
|
||||
| SimpleVariable (v) -> Printf.fprintf ppf "%s" v
|
||||
| SimpleInteger (i) -> Printf.fprintf ppf "%d" i
|
||||
| SimplePlus (a1, a2) -> Printf.fprintf ppf "{%a + %a}" helper_a a1 helper_a a2
|
||||
| SimpleMinus (a1, a2) -> Printf.fprintf ppf "{%a - %a}" helper_a a1 helper_a a2
|
||||
| SimpleTimes (a1, a2) -> Printf.fprintf ppf "{%a * %a}" helper_a a1 helper_a a2
|
||||
| SimpleDivision (a1, a2) -> Printf.fprintf ppf "{%a / %a}" helper_a a1 helper_a a2
|
||||
| SimpleModulo (a1, a2) -> Printf.fprintf ppf "{%a %% %a}" helper_a a1 helper_a a2
|
||||
| SimplePower (a1, a2) -> Printf.fprintf ppf "{%a ^ %a}" helper_a a1 helper_a a2
|
||||
| SimplePowerMod (a1, a2, a3) -> Printf.fprintf ppf "{powmod %a %a %a}" helper_a a1 helper_a a2 helper_a a3
|
||||
| SimpleRand (a) -> Printf.fprintf ppf "{rand %a}" helper_a a
|
||||
in
|
||||
helper_c ppf c
|
||||
|
||||
let printSimpleStatements (ppf) (c: simpleStatements list) : unit =
|
||||
List.iter (fun x -> printSingleStatement ppf x; Printf.printf "; ") c
|
||||
|
||||
|
||||
|
||||
let globalIdNode = ref 0;
|
||||
|
||||
module Node = struct
|
||||
type t = {
|
||||
id: int
|
||||
}
|
||||
let compare a b = compare a.id b.id
|
||||
|
||||
let newNode () =
|
||||
globalIdNode := !globalIdNode + 1;
|
||||
{id = !globalIdNode}
|
||||
end
|
||||
;;
|
||||
|
||||
module NodeMap = Map.Make(Node)
|
||||
module NodeSet = Set.Make(Node)
|
||||
|
||||
module Cfg = struct
|
||||
type t = {
|
||||
empty: bool;
|
||||
nodes: NodeSet.t;
|
||||
edges: (Node.t * (Node.t option)) NodeMap.t;
|
||||
reverseedges: (Node.t list) NodeMap.t;
|
||||
initial: Node.t option;
|
||||
terminal: Node.t option;
|
||||
code: (simpleStatements list) NodeMap.t
|
||||
}
|
||||
|
||||
let newCfg () =
|
||||
{ empty = true;
|
||||
nodes = NodeSet.empty;
|
||||
edges = NodeMap.empty;
|
||||
reverseedges = NodeMap.empty;
|
||||
initial = None;
|
||||
terminal = None;
|
||||
code = NodeMap.empty }
|
||||
|
||||
let mergeCfg (cfg1: t) (cfg2: t) (entryNode: Node.t) (exitNode: Node.t) : t =
|
||||
match (cfg1.empty, cfg2.empty) with
|
||||
true, _ -> cfg2
|
||||
| _, true -> cfg1
|
||||
| false, false ->
|
||||
let cfg1initial = Option.get cfg1.initial in
|
||||
let cfg2initial = Option.get cfg2.initial in
|
||||
let cfg1terminal = Option.get cfg1.terminal in
|
||||
let cfg2terminal = Option.get cfg2.terminal in
|
||||
{ empty = false;
|
||||
nodes = NodeSet.union cfg1.nodes cfg2.nodes |>
|
||||
NodeSet.add entryNode |>
|
||||
NodeSet.add exitNode;
|
||||
edges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
|
||||
cfg1.edges cfg2.edges |>
|
||||
NodeMap.add entryNode (cfg1initial, Some cfg2initial) |>
|
||||
NodeMap.add cfg1terminal (exitNode, None) |>
|
||||
NodeMap.add cfg2terminal (exitNode, None);
|
||||
reverseedges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
|
||||
cfg1.reverseedges cfg2.reverseedges |>
|
||||
NodeMap.add_to_list cfg1initial entryNode |>
|
||||
NodeMap.add_to_list cfg2initial entryNode |>
|
||||
NodeMap.add_to_list exitNode cfg1terminal |>
|
||||
NodeMap.add_to_list exitNode cfg2terminal;
|
||||
initial = Some entryNode;
|
||||
terminal = Some exitNode;
|
||||
code = NodeMap.union (fun _ -> failwith "Failed merging code of cfg.")
|
||||
cfg1.code cfg2.code
|
||||
}
|
||||
|
||||
let concatCfg (cfg1: t) (cfg2: t) : t =
|
||||
match (cfg1.empty, cfg2.empty) with
|
||||
true, _ -> cfg2
|
||||
| _, true -> cfg1
|
||||
| false, false ->
|
||||
let cfg1initial = Option.get cfg1.initial in
|
||||
let cfg2initial = Option.get cfg2.initial in
|
||||
let cfg1terminal = Option.get cfg1.terminal in
|
||||
let cfg2terminal = Option.get cfg2.terminal in
|
||||
{ empty = false;
|
||||
nodes = NodeSet.union cfg1.nodes cfg2.nodes;
|
||||
edges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
|
||||
cfg1.edges cfg2.edges |>
|
||||
NodeMap.add cfg1terminal (cfg2initial, None);
|
||||
reverseedges = NodeMap.union (fun _ -> failwith "Failed merging edges of cfg.")
|
||||
cfg1.reverseedges cfg2.reverseedges |>
|
||||
NodeMap.add_to_list cfg2initial cfg1terminal;
|
||||
initial = Some cfg1initial;
|
||||
terminal = Some cfg2terminal;
|
||||
code = NodeMap.union (fun _ -> failwith "Failed merging code of cfg.")
|
||||
cfg1.code cfg2.code
|
||||
}
|
||||
|
||||
let addToLastNode (newcode: simpleStatements) (cfg: t) : t =
|
||||
match cfg.empty with
|
||||
| true -> let newnode = Node.newNode () in
|
||||
{ empty = false;
|
||||
nodes = NodeSet.singleton newnode;
|
||||
edges = NodeMap.empty;
|
||||
reverseedges = NodeMap.empty;
|
||||
initial = Some newnode;
|
||||
terminal = Some newnode;
|
||||
code = NodeMap.singleton newnode [newcode]
|
||||
}
|
||||
| false ->
|
||||
let prevcfgterminal = Option.get cfg.terminal in
|
||||
{ cfg with
|
||||
code = (NodeMap.add_to_list
|
||||
prevcfgterminal
|
||||
newcode
|
||||
cfg.code) }
|
||||
|
||||
let pp (ppf) (c: t) : unit =
|
||||
Printf.fprintf ppf "Nodes' ids: ";
|
||||
List.iter (fun (x : Node.t) -> Printf.fprintf ppf "%d " x.id) (NodeSet.to_list c.nodes);
|
||||
Printf.fprintf ppf "\n";
|
||||
|
||||
Printf.fprintf ppf "Nodes' edges:\n";
|
||||
List.iter (fun ((n, (a, b)) : (Node.t * (Node.t * Node.t option))) : unit ->
|
||||
match b with None -> Printf.fprintf ppf "\t%d -> %d\n" n.id a.id
|
||||
| Some b -> Printf.fprintf ppf "\t%d -> %d, %d\n" n.id a.id b.id
|
||||
) (NodeMap.to_list c.edges);
|
||||
Printf.fprintf ppf "\n";
|
||||
|
||||
Printf.fprintf ppf "Nodes' back edges:\n";
|
||||
List.iter (fun ((n, xs) : (Node.t * (Node.t list))) : unit ->
|
||||
Printf.fprintf ppf "\t%d -> " n.id;
|
||||
List.iter (fun (x: Node.t) -> Printf.fprintf ppf "%d, " x.id) xs;
|
||||
Printf.fprintf ppf "\n"
|
||||
) (NodeMap.to_list c.reverseedges);
|
||||
Printf.fprintf ppf "\n";
|
||||
|
||||
Printf.fprintf ppf "Initial node's id: ";
|
||||
Printf.fprintf ppf "%d" ((Option.get c.initial).id);
|
||||
Printf.fprintf ppf "\n";
|
||||
|
||||
Printf.fprintf ppf "Terminal node's id: ";
|
||||
Printf.fprintf ppf "%d" ((Option.get c.terminal).id);
|
||||
Printf.fprintf ppf "\n";
|
||||
|
||||
Printf.fprintf ppf "Code:\n";
|
||||
List.iter (fun ((n, stms) : Node.t * simpleStatements list) : unit ->
|
||||
Printf.fprintf ppf "\tid %d --> %a\n%!" n.id printSimpleStatements (List.rev stms)
|
||||
) (NodeMap.to_list c.code);
|
||||
Printf.fprintf ppf "\n";
|
||||
end
|
||||
;;
|
||||
|
||||
|
||||
let rec convert_c (prevcfg: Cfg.t) (prg: Types.c_exp) : Cfg.t =
|
||||
match prg with
|
||||
| Skip -> prevcfg |> Cfg.addToLastNode SimpleSkip
|
||||
| Assignment (x, a) -> prevcfg |> Cfg.addToLastNode (SimpleAssignment (x, convert_a a))
|
||||
| Sequence (c1, c2) ->
|
||||
let cfg1 = convert_c prevcfg c1 in
|
||||
let cfg2 = convert_c cfg1 c2 in
|
||||
cfg2
|
||||
| If (b, c1, c2) ->
|
||||
let convertedb = convert_b b in
|
||||
let cfg1 = convert_c (Cfg.newCfg ()) c1 in
|
||||
let cfg2 = convert_c (Cfg.newCfg ()) c2 in
|
||||
let entrynode = Node.newNode () in
|
||||
let exitnode = Node.newNode () in
|
||||
let newcfg = Cfg.mergeCfg cfg1 cfg2 entrynode exitnode in
|
||||
let mergedcfg = Cfg.concatCfg prevcfg newcfg in
|
||||
{ mergedcfg with
|
||||
code = mergedcfg.code |>
|
||||
NodeMap.add_to_list entrynode (SimpleGuard convertedb) |>
|
||||
NodeMap.add_to_list exitnode (SimpleSkip) }
|
||||
| While (b, c) ->
|
||||
let convertedb = convert_b b in
|
||||
let cfg = convert_c (Cfg.newCfg ()) c in
|
||||
let cfginitial = Option.get cfg.initial in
|
||||
let cfgterminal = Option.get cfg.terminal in
|
||||
let entrynode = Node.newNode () in
|
||||
let guardnode = Node.newNode () in
|
||||
let exitnode = Node.newNode () in
|
||||
{ empty = false;
|
||||
nodes = cfg.nodes |>
|
||||
NodeSet.add entrynode |>
|
||||
NodeSet.add guardnode |>
|
||||
NodeSet.add exitnode;
|
||||
edges = cfg.edges |>
|
||||
NodeMap.add entrynode (guardnode, None) |>
|
||||
NodeMap.add guardnode (cfginitial, Some exitnode) |>
|
||||
NodeMap.add cfgterminal (guardnode, None);
|
||||
reverseedges = cfg.reverseedges |>
|
||||
NodeMap.add_to_list guardnode entrynode |>
|
||||
NodeMap.add_to_list cfginitial guardnode |>
|
||||
NodeMap.add_to_list exitnode guardnode |>
|
||||
NodeMap.add_to_list guardnode cfgterminal;
|
||||
initial = Some entrynode;
|
||||
terminal = Some exitnode;
|
||||
code = NodeMap.add_to_list guardnode (SimpleGuard (convertedb)) cfg.code |>
|
||||
NodeMap.add_to_list exitnode (SimpleSkip)
|
||||
} |> Cfg.concatCfg prevcfg
|
||||
| For (assignment, guard, increment, body) ->
|
||||
let cfgassignment = convert_c (Cfg.newCfg ()) assignment in
|
||||
let convertedguard = convert_b guard in
|
||||
let cfgincrement = convert_c (Cfg.newCfg ()) increment in
|
||||
let cfgbody = convert_c (Cfg.newCfg ()) body in
|
||||
|
||||
let prevassignment = Cfg.concatCfg prevcfg cfgassignment in
|
||||
let bodyincrement = Cfg.concatCfg cfgbody cfgincrement in
|
||||
|
||||
let cfginitial = Option.get bodyincrement.initial in
|
||||
let cfgterminal = Option.get bodyincrement.terminal in
|
||||
|
||||
let guardnode = Node.newNode () in
|
||||
let exitnode = Node.newNode () in
|
||||
{ empty = false;
|
||||
nodes = bodyincrement.nodes |>
|
||||
NodeSet.add guardnode |>
|
||||
NodeSet.add exitnode;
|
||||
edges = bodyincrement.edges |>
|
||||
NodeMap.add guardnode (cfginitial, Some exitnode) |>
|
||||
NodeMap.add cfgterminal (guardnode, None);
|
||||
reverseedges = bodyincrement.reverseedges |>
|
||||
NodeMap.add_to_list cfginitial guardnode |>
|
||||
NodeMap.add_to_list exitnode guardnode |>
|
||||
NodeMap.add_to_list guardnode cfgterminal;
|
||||
initial = Some guardnode;
|
||||
terminal = Some exitnode;
|
||||
code = NodeMap.add_to_list guardnode (SimpleGuard (convertedguard)) bodyincrement.code |>
|
||||
NodeMap.add_to_list exitnode (SimpleSkip)
|
||||
} |> Cfg.concatCfg prevassignment
|
||||
|
||||
and convert_b (prg: Types.b_exp) : simpleBoolean =
|
||||
match prg with
|
||||
| Boolean (b) -> SimpleBoolean b
|
||||
| BAnd (b1, b2) -> SimpleBAnd (convert_b b1, convert_b b2)
|
||||
| BOr (b1, b2) -> SimpleBOr (convert_b b1, convert_b b2)
|
||||
| BNot (b) -> SimpleBNot (convert_b b)
|
||||
| BCmp (a1, a2) -> SimpleBCmp (convert_a a1, convert_a a2)
|
||||
| BCmpLess (a1, a2) -> SimpleBCmpLess (convert_a a1, convert_a a2)
|
||||
| BCmpLessEq (a1, a2) -> SimpleBCmpLessEq (convert_a a1, convert_a a2)
|
||||
| BCmpGreater (a1, a2) -> SimpleBCmpGreater (convert_a a1, convert_a a2)
|
||||
| BCmpGreaterEq (a1, a2) -> SimpleBCmpGreaterEq (convert_a a1, convert_a a2)
|
||||
|
||||
and convert_a (prg: Types.a_exp) : simpleArithmetic =
|
||||
match prg with
|
||||
| Variable x -> SimpleVariable x
|
||||
| Integer n -> SimpleInteger n
|
||||
| Plus (a1, a2) -> SimplePlus (convert_a a1, convert_a a2)
|
||||
| Minus (a1, a2) -> SimpleMinus (convert_a a1, convert_a a2)
|
||||
| Times (a1, a2) -> SimpleTimes (convert_a a1, convert_a a2)
|
||||
| Division (a1, a2) -> SimpleDivision (convert_a a1, convert_a a2)
|
||||
| Modulo (a1, a2) -> SimpleModulo (convert_a a1, convert_a a2)
|
||||
| Power (a1, a2) -> SimplePower (convert_a a1, convert_a a2)
|
||||
| PowerMod (a1, a2, a3) -> SimplePowerMod (convert_a a1, convert_a a2, convert_a a3)
|
||||
| Rand (a) -> SimpleRand (convert_a a)
|
||||
|
||||
let convert (prg: Types.p_exp) : Cfg.t =
|
||||
match prg with
|
||||
| Main (_, _, exp) ->
|
||||
convert_c (Cfg.newCfg ()) exp
|
||||
40
lib/miniImp/Cfg.mli
Normal file
40
lib/miniImp/Cfg.mli
Normal file
@ -0,0 +1,40 @@
|
||||
type simpleStatements =
|
||||
| SimpleSkip
|
||||
| SimpleAssignment of Types.variable * simpleArithmetic
|
||||
| SimpleGuard of simpleBoolean
|
||||
and simpleBoolean =
|
||||
| SimpleBoolean of bool
|
||||
| SimpleBAnd of simpleBoolean * simpleBoolean
|
||||
| SimpleBOr of simpleBoolean * simpleBoolean
|
||||
| SimpleBNot of simpleBoolean
|
||||
| SimpleBCmp of simpleArithmetic * simpleArithmetic
|
||||
| SimpleBCmpLess of simpleArithmetic * simpleArithmetic
|
||||
| SimpleBCmpLessEq of simpleArithmetic * simpleArithmetic
|
||||
| SimpleBCmpGreater of simpleArithmetic * simpleArithmetic
|
||||
| SimpleBCmpGreaterEq of simpleArithmetic * simpleArithmetic
|
||||
and simpleArithmetic =
|
||||
| SimpleVariable of Types.variable
|
||||
| SimpleInteger of int
|
||||
| SimplePlus of simpleArithmetic * simpleArithmetic
|
||||
| SimpleMinus of simpleArithmetic * simpleArithmetic
|
||||
| SimpleTimes of simpleArithmetic * simpleArithmetic
|
||||
| SimpleDivision of simpleArithmetic * simpleArithmetic
|
||||
| SimpleModulo of simpleArithmetic * simpleArithmetic
|
||||
| SimplePower of simpleArithmetic * simpleArithmetic
|
||||
| SimplePowerMod of simpleArithmetic * simpleArithmetic * simpleArithmetic
|
||||
| SimpleRand of simpleArithmetic
|
||||
|
||||
module Node : sig
|
||||
type t
|
||||
val compare : t -> t -> int
|
||||
end
|
||||
|
||||
module NodeMap : Map.S with type key = Node.t
|
||||
module NodeSet : Set.S with type elt = Node.t
|
||||
|
||||
module Cfg : sig
|
||||
type t
|
||||
val pp : out_channel -> t -> unit
|
||||
end
|
||||
|
||||
val convert : Types.p_exp -> Cfg.t
|
||||
92
lib/miniImp/Lexer.mll
Normal file
92
lib/miniImp/Lexer.mll
Normal file
@ -0,0 +1,92 @@
|
||||
{
|
||||
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 = [
|
||||
("as", AS);
|
||||
("def", DEF);
|
||||
("do", DO);
|
||||
("else", ELSE);
|
||||
("false", BOOL(false));
|
||||
("for", FOR);
|
||||
("if", IF);
|
||||
("input", INPUT);
|
||||
("main", MAIN);
|
||||
("not", BNOT);
|
||||
("output", OUTPUT);
|
||||
("powmod", POWERMOD);
|
||||
("rand", RAND);
|
||||
("skip", SKIP);
|
||||
("then", THEN);
|
||||
("true", BOOL(true));
|
||||
("while", WHILE);
|
||||
("with", WITH);
|
||||
]
|
||||
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}
|
||||
| "/" {DIVISION}
|
||||
| ":=" {ASSIGNMENT}
|
||||
| ";" {SEQUENCE}
|
||||
| "<" {BCMPLESS}
|
||||
| "<=" {BCMPLESSEQ}
|
||||
| "==" {BCMP}
|
||||
| ">" {BCMPGREATER}
|
||||
| ">=" {BCMPGREATEREQ}
|
||||
| "^" {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
|
||||
}
|
||||
85
lib/miniImp/Parser.mly
Normal file
85
lib/miniImp/Parser.mly
Normal file
@ -0,0 +1,85 @@
|
||||
(* code to be copied in the scanner module *)
|
||||
(*
|
||||
*)
|
||||
%{
|
||||
open Types
|
||||
%}
|
||||
|
||||
(* tokens *)
|
||||
%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
|
||||
%type <b_exp> bexpp
|
||||
%type <a_exp> aexpp
|
||||
%type <p_exp> prg
|
||||
|
||||
(* start nonterminal *)
|
||||
%start prg
|
||||
|
||||
(* associativity in order of precedence *)
|
||||
%left lowest
|
||||
%left SEQUENCE
|
||||
%left ELSE
|
||||
%left PLUS MINUS BOR BAND
|
||||
%left BNOT
|
||||
%left DIVISION
|
||||
%left MODULO
|
||||
%left TIMES
|
||||
%left POWER
|
||||
%left DO
|
||||
|
||||
%%
|
||||
|
||||
(* grammar *)
|
||||
prg:
|
||||
| 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 := 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; body = cexpp;
|
||||
{For (ass, guard, iter, body)} // for (..., ..., ...) do ...
|
||||
| LEFTPAR; t = cexpp; RIGHTPAR {t} // (...)
|
||||
bexpp:
|
||||
| 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)} // -
|
||||
| MINUS; i = INT {Integer (-i)}
|
||||
| t1 = aexpp; TIMES; t2 = aexpp {Times (t1, t2)} // *
|
||||
| t1 = aexpp; DIVISION; t2 = aexpp {Division (t1, t2)} // /
|
||||
| t1 = aexpp; MODULO; t2 = aexpp {Modulo (t1, t2)} // %
|
||||
| t1 = aexpp; POWER; t2 = aexpp {Power (t1, t2)} // ^
|
||||
| POWERMOD; LEFTPAR; t1 = aexpp; COMMA;
|
||||
t2 = aexpp; COMMA;
|
||||
t3 = aexpp; RIGHTPAR
|
||||
{PowerMod (t1, t2, t3)} // powmod(..., ..., ...)
|
||||
| RAND; LEFTPAR; t = aexpp; RIGHTPAR {Rand (t)} // rand()
|
||||
| LEFTPAR; a = aexpp; RIGHTPAR {a} // (a)
|
||||
@ -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
|
||||
)
|
||||
|
||||
@ -1,3 +1,3 @@
|
||||
open Types
|
||||
|
||||
val reduce : p_exp -> int -> int
|
||||
val reduce : p_exp -> int -> (int, [> Types.error]) result
|
||||
|
||||
@ -8,13 +8,13 @@ and c_exp =
|
||||
| Sequence of c_exp * c_exp (* c; c *)
|
||||
| If of b_exp * c_exp * c_exp (* if b then c else c *)
|
||||
| While of b_exp * c_exp (* while b do c *)
|
||||
| For of c_exp * b_exp * c_exp * c_exp (* for c; b; c do c *)
|
||||
| For of c_exp * b_exp * c_exp * c_exp (* for (c; b; c) do c *)
|
||||
and b_exp =
|
||||
Boolean of bool (* v *)
|
||||
| BAnd of b_exp * b_exp (* b and b *)
|
||||
| BOr of b_exp * b_exp (* b or b *)
|
||||
| BAnd of b_exp * b_exp (* b && b *)
|
||||
| BOr of b_exp * b_exp (* b || b *)
|
||||
| BNot of b_exp (* not b *)
|
||||
| BCmp of a_exp * a_exp (* a = a *)
|
||||
| BCmp of a_exp * a_exp (* a == a *)
|
||||
| BCmpLess of a_exp * a_exp (* a < a *)
|
||||
| BCmpLessEq of a_exp * a_exp (* a <= a *)
|
||||
| BCmpGreater of a_exp * a_exp (* a > a *)
|
||||
@ -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
|
||||
]
|
||||
|
||||
@ -8,13 +8,13 @@ and c_exp =
|
||||
| Sequence of c_exp * c_exp (* c; c *)
|
||||
| If of b_exp * c_exp * c_exp (* if b then c else c *)
|
||||
| While of b_exp * c_exp (* while b do c *)
|
||||
| For of c_exp * b_exp * c_exp * c_exp (* for c; b; c do c *)
|
||||
| For of c_exp * b_exp * c_exp * c_exp (* for (c; b; c) do c *)
|
||||
and b_exp =
|
||||
Boolean of bool (* v *)
|
||||
| BAnd of b_exp * b_exp (* b and b *)
|
||||
| BOr of b_exp * b_exp (* b or b *)
|
||||
| BAnd of b_exp * b_exp (* b && b *)
|
||||
| BOr of b_exp * b_exp (* b || b *)
|
||||
| BNot of b_exp (* not b *)
|
||||
| BCmp of a_exp * a_exp (* a = a *)
|
||||
| BCmp of a_exp * a_exp (* a == a *)
|
||||
| BCmpLess of a_exp * a_exp (* a < a *)
|
||||
| BCmpLessEq of a_exp * a_exp (* a <= a *)
|
||||
| BCmpGreater of a_exp * a_exp (* a > a *)
|
||||
@ -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
|
||||
]
|
||||
|
||||
16
lib/miniImp/dune
Normal file
16
lib/miniImp/dune
Normal file
@ -0,0 +1,16 @@
|
||||
(ocamllex Lexer)
|
||||
|
||||
(menhir
|
||||
(modules Parser)
|
||||
(explain true)
|
||||
(infer true)
|
||||
(flags --dump --table)
|
||||
)
|
||||
|
||||
(library
|
||||
(name miniImp)
|
||||
(public_name miniImp)
|
||||
(modules Lexer Parser Types Semantics Cfg)
|
||||
(libraries utility menhirLib))
|
||||
|
||||
(include_subdirs qualified)
|
||||
5
lib/utility/dune
Normal file
5
lib/utility/dune
Normal file
@ -0,0 +1,5 @@
|
||||
(library
|
||||
(name utility)
|
||||
(public_name utility))
|
||||
|
||||
(include_subdirs qualified)
|
||||
14
test/dune
14
test/dune
@ -1,11 +1,19 @@
|
||||
(test
|
||||
(name testingImp)
|
||||
(libraries lang))
|
||||
(libraries miniImp))
|
||||
|
||||
(test
|
||||
(name testingImpParser)
|
||||
(libraries miniImp))
|
||||
|
||||
(test
|
||||
(name testingFun)
|
||||
(libraries lang))
|
||||
(libraries miniFun))
|
||||
|
||||
(test
|
||||
(name testingTypeFun)
|
||||
(libraries lang))
|
||||
(libraries miniFun))
|
||||
|
||||
(test
|
||||
(name testingTypeFunParser)
|
||||
(libraries miniFun))
|
||||
@ -1,59 +1,70 @@
|
||||
open Lang.MiniFun
|
||||
open Lang.MiniFunTypes
|
||||
open MiniFun.Semantics
|
||||
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"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
open Lang.MiniImp
|
||||
open Lang.MiniImpTypes
|
||||
open MiniImp.Semantics
|
||||
open MiniImp.Types
|
||||
|
||||
(* -------------------------------------------------------------------------- *)
|
||||
(* Identity program *)
|
||||
@ -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
|
||||
;;
|
||||
|
||||
9
test/testingImpParser.expected
Normal file
9
test/testingImpParser.expected
Normal file
@ -0,0 +1,9 @@
|
||||
Identity program: 1
|
||||
y not defined program: The variable y is not defined.
|
||||
Factorial program: 3628800
|
||||
Hailstone sequence's lenght program: 351
|
||||
Sum multiples of 3 and 5 program: 35565945
|
||||
Rand program: true
|
||||
Fibonacci program: 4807526976
|
||||
Miller-Rabin primality test program 1: 0
|
||||
Miller-Rabin primality test program 2: 1
|
||||
166
test/testingImpParser.ml
Normal file
166
test/testingImpParser.ml
Normal file
@ -0,0 +1,166 @@
|
||||
open MiniImp
|
||||
|
||||
let get_result x =
|
||||
Lexing.from_string x |> Parser.prg Lexer.lex |> Semantics.reduce
|
||||
|
||||
(* -------------------------------------------------------------------------- *)
|
||||
(* Identity program *)
|
||||
let program =
|
||||
"def main with input a output b as b := a"
|
||||
;;
|
||||
|
||||
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 =
|
||||
"def main with input a output b as x := 1; b := a + x + y"
|
||||
;;
|
||||
|
||||
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 =
|
||||
"def main with input a output b as
|
||||
b := 1;
|
||||
for (i := 1, i <= a, i := i + 1) do
|
||||
b := b * i;
|
||||
"
|
||||
;;
|
||||
|
||||
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 =
|
||||
"def main with input a output b as
|
||||
b := 1;
|
||||
while not a == 1 do (
|
||||
b := b + 1;
|
||||
if ((a % 2) == 1) then a := 3 * a + 1 else a := a / 2
|
||||
)
|
||||
"
|
||||
;;
|
||||
|
||||
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 =
|
||||
"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) then b := b + i;
|
||||
else skip;
|
||||
"
|
||||
;;
|
||||
|
||||
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 =
|
||||
"def main with input a output b as b := rand(a)"
|
||||
;;
|
||||
|
||||
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 =
|
||||
"def main with input n output fnext as
|
||||
fnow := 0;
|
||||
fnext := 1;
|
||||
while (n > 1) do (
|
||||
tmp := fnow + fnext;
|
||||
fnow := fnext;
|
||||
fnext := tmp;
|
||||
n := n - 1;
|
||||
)
|
||||
"
|
||||
;;
|
||||
|
||||
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 =
|
||||
"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;
|
||||
)
|
||||
)
|
||||
"
|
||||
;;
|
||||
|
||||
(* should return 0 because prime *)
|
||||
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 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
|
||||
;;
|
||||
@ -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)
|
||||
|
||||
@ -1,13 +1,13 @@
|
||||
open Lang.MiniTyFun
|
||||
open Lang.MiniFunTypes
|
||||
open MiniFun.TypeChecker
|
||||
open MiniFun.Types
|
||||
|
||||
(* -------------------------------------------------------------------------- *)
|
||||
(* Error absent assignment program *)
|
||||
|
||||
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
|
||||
|
||||
20
test/testingTypeFunParser.expected
Normal file
20
test/testingTypeFunParser.expected
Normal file
@ -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
|
||||
251
test/testingTypeFunParser.ml
Normal file
251
test/testingTypeFunParser.ml
Normal file
@ -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"
|
||||
Reference in New Issue
Block a user