Merge with cfg

This commit is contained in:
elvis
2025-01-27 16:32:22 +01:00
63 changed files with 5823 additions and 777 deletions

View File

@ -81,6 +81,7 @@ rule read = parse
(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

View File

@ -24,7 +24,6 @@
%start prg
(* associativity in order of precedence *)
/*%right rightlowest */
%left lowest
%right TYPEFUNCTION
%left COMMA
@ -35,7 +34,7 @@
%left CMP CMPLESS CMPLESSEQ CMPGREATER CMPGREATEREQ
%left PLUS MINUS
%left TIMES DIVISION MODULO
%left POWER
%right POWER
%right BNOT RAND
%left FIRST SECOND
%left LAMBDA

View File

@ -5,14 +5,17 @@ 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) :
(permitted_values, [> error]) result =
match command with
Integer n -> Ok (IntegerPermitted n)
| Boolean b -> Ok (BooleanPermitted b)
| Variable v -> (
match VariableMap.find_opt v mem.assignments with
None -> Error (`AbsentAssignment ("The variable " ^ v ^ " is not defined."))
| Some a -> Ok a
| None ->
Error (`AbsentAssignment ("The variable " ^ v ^ " is not defined."))
| Some a ->
Ok a
)
| Tuple (x, y) -> (
let* xval = evaluate mem x in
@ -28,7 +31,7 @@ let rec evaluate (mem: memory) (command: t_exp) : (permittedValues, [> error]) r
)
| Application (f, x) -> (
let* evalf = evaluate mem f in
let* funcClosure = (
let* func_closure = (
match evalf with
FunctionPermitted ff -> Ok ff
| IntegerPermitted _ -> Error (`WrongType ("Function is not a function,"
@ -40,15 +43,15 @@ let rec evaluate (mem: memory) (command: t_exp) : (permittedValues, [> error]) r
) in
let* param = evaluate mem x in
let mem2 =
match funcClosure.recursiveness with
match func_closure.recursiveness with
None -> {assignments = (
VariableMap.add funcClosure.input param funcClosure.assignments)}
VariableMap.add func_closure.input param func_closure.assignments)}
| Some nameF -> {assignments = (
VariableMap.add funcClosure.input param funcClosure.assignments |>
VariableMap.add nameF (FunctionPermitted funcClosure)
VariableMap.add func_closure.input param func_closure.assignments |>
VariableMap.add nameF (FunctionPermitted func_closure)
)}
in
evaluate mem2 funcClosure.body
evaluate mem2 func_closure.body
)
| Plus (a, b) ->
let* aval = (

View File

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

View File

@ -53,7 +53,8 @@ let evaluate_type_polimorphic (_program: t_exp) (_context: typingshape) : (typin
(* | LetIn (x, xval, rest) -> failwith "Not Implemented" *)
(* | LetFun (f, xs, typef, fbody, rest) -> failwith "Not Implemented" *)
let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) : (ftype, [> typechecking_error]) result =
let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) :
(ftype, [> typechecking_error]) result =
match program with
Integer _ -> Ok IntegerType
| Boolean _ -> Ok BooleanType
@ -73,7 +74,8 @@ let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) : (ftype,
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
let* typefbody = evaluate_type fbody (VariableMap.add x tin context)
in
if (typefbody = tout) then
Ok typef
else

View File

@ -19,48 +19,49 @@ type typingshape = (* tuple of a simple type environment and a simple type *)
fenvironment * ftype
type t_exp =
Integer of int (* x := a *)
| Boolean of bool (* v *)
| Variable of variable (* 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 *)
| Division of t_exp * t_exp (* x / x *)
| Modulo of t_exp * t_exp (* x % x *)
| 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 && 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 *)
| CmpGreater of t_exp * t_exp (* x > x *)
| 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 * ftype * t_exp * t_exp (* let rec x. y: t. x in x*)
Integer of int (* x := a *)
| Boolean of bool (* v *)
| Variable of variable (* 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 *)
| Division of t_exp * t_exp (* x / x *)
| Modulo of t_exp * t_exp (* x % x *)
| 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 && 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 *)
| CmpGreater of t_exp * t_exp (* x > x *)
| 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 * ftype * t_exp * t_exp
(* let rec x. y: t. x in x*)
type permittedValues =
type permitted_values =
IntegerPermitted of int
| BooleanPermitted of bool
| TuplePermitted of permittedValues * permittedValues
| TuplePermitted of permitted_values * permitted_values
| FunctionPermitted of closure
and closure = {
input: variable;
body: t_exp;
assignments: permittedValues VariableMap.t;
assignments: permitted_values VariableMap.t;
recursiveness: variable option
}
type memory = {
assignments: permittedValues VariableMap.t
assignments: permitted_values VariableMap.t
}

View File

@ -73,20 +73,20 @@ type t_exp =
| LetIn of variable * t_exp * t_exp (* let x = x in x *)
| LetFun of variable * variable * ftype * t_exp * t_exp (* let rec x. y: t. x in x*)
type permittedValues =
type permitted_values =
IntegerPermitted of int
| BooleanPermitted of bool
| TuplePermitted of permittedValues * permittedValues
| TuplePermitted of permitted_values * permitted_values
| FunctionPermitted of closure
and closure = {
input: variable;
body: t_exp;
assignments: permittedValues VariableMap.t;
assignments: permitted_values VariableMap.t;
recursiveness: variable option
}
type memory = {
assignments: permittedValues VariableMap.t
assignments: permitted_values VariableMap.t
}