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

Merge with cfg

Browse Source
This commit is contained in:
elvis
2024-11-20 00:17:58 +01:00
parent 19c11ad9c8 67f1659c7a
commit 7ca03faf84
46 changed files with 2158 additions and 413 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
lib/dune
View File

@ -1,5 +0,0 @@
(library
(name lang)
(public_name lang))
(include_subdirs qualified)

5
lib/exercises/dune Normal file
View File

@ -0,0 +1,5 @@
(library
(name exercises)
(public_name exercises))
(include_subdirs qualified)

10
lib/exercises.ml → lib/exercises/exercises.ml
View File

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

0
lib/exercises.mli → lib/exercises/exercises.mli
View File

13
lib/lang.ml
View File

@ -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
View 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
View 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)}

89
lib/miniFun/Semantics.ml
View File

@ -5,7 +5,7 @@ Random.self_init ()
let (let*) = Result.bind
let rec evaluate (mem: memory) (command: t_exp) : (permittedValues, error) result =
let rec evaluate (mem: memory) (command: t_exp) : (permittedValues, [> error]) result =
match command with
Integer n -> Ok (IntegerPermitted n)
| Boolean b -> Ok (BooleanPermitted b)
@ -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

4
lib/miniFun/Semantics.mli
View File

@ -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

159
lib/miniFun/TypeChecker.ml
View File

@ -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.")

2
lib/miniFun/TypeChecker.mli
View File

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

37
lib/miniFun/Types.ml
View File

@ -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
]

37
lib/miniFun/Types.mli
View File

@ -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
View 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
View 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
View 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
View 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
View 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)

160
lib/miniImp/Semantics.ml
View File

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

2
lib/miniImp/Semantics.mli
View File

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

14
lib/miniImp/Types.ml
View File

@ -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
]

14
lib/miniImp/Types.mli
View File

@ -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
View 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
View File

@ -0,0 +1,5 @@
(library
(name utility)
(public_name utility))
(include_subdirs qualified)

0
lib/utility.ml → lib/utility/utility.ml
View File

0
lib/utility.mli → lib/utility/utility.mli
View File