Fix for let rec, currently not implemented
This commit is contained in:
@ -29,6 +29,14 @@ let () =
|
||||
()
|
||||
in
|
||||
|
||||
let evalb = Clap.flag
|
||||
~description: "Optional flag for evaluating the generated risc code."
|
||||
~section: values
|
||||
~set_long: "eval"
|
||||
~set_short: 'e'
|
||||
false
|
||||
in
|
||||
|
||||
let output = Clap.optional_string
|
||||
~description: "Output file. If not specified output is printed on stdout."
|
||||
~placeholder: "FILENAME"
|
||||
@ -63,26 +71,32 @@ let () =
|
||||
exit (-1)
|
||||
in
|
||||
let ty_program =
|
||||
match TypeChecker.typecheck_polymorphic program with
|
||||
match TypeChecker.typecheck_polymorphic_unbound program with
|
||||
| Ok ty -> ty
|
||||
| Error (`AbsentAssignment msg)
|
||||
| Error (`WrongTypeSpecification msg)
|
||||
| Error (`RecusrionsNotImplemented msg)
|
||||
| Error (`WrongType msg) ->
|
||||
Printf.fprintf stderr "%s\n" msg;
|
||||
exit (-1)
|
||||
in
|
||||
let return_value =
|
||||
if evalb then
|
||||
match Semantics.reduce program inval with
|
||||
Ok o -> o
|
||||
Ok o -> Some o
|
||||
| Error (`AbsentAssignment msg)
|
||||
| Error (`DivisionByZero msg)
|
||||
| Error (`WrongType msg) ->
|
||||
Printf.fprintf stderr "%s\n" msg;
|
||||
exit (-1)
|
||||
else
|
||||
None
|
||||
in
|
||||
|
||||
Printf.fprintf outch "Type of the program: %s\n" (Types.pp_type_f ty_program);
|
||||
Printf.fprintf outch "%d\n" return_value
|
||||
match return_value with
|
||||
| Some v -> Printf.fprintf outch "%d\n" v
|
||||
| None -> ()
|
||||
in
|
||||
|
||||
|
||||
|
||||
@ -1,5 +0,0 @@
|
||||
\n: int =>
|
||||
let fn =
|
||||
\x: int => x + n
|
||||
in
|
||||
fn n
|
||||
@ -251,7 +251,16 @@ let rec evaluate_type_polimorphic program (env: env) level =
|
||||
let* var_ty = evaluate_type_polimorphic xval env (level + 1) in
|
||||
let generalized_ty = generalize level var_ty in
|
||||
evaluate_type_polimorphic rest (VariableMap.add x generalized_ty env) level
|
||||
| LetFun (_f, _xs, _typef, _fbody, _rest) -> failwith "Not Implemented"
|
||||
| LetFun (f, xs, _typef, fbody, rest) ->
|
||||
let* _ = Error (`RecusrionsNotImplemented "Let Rec is not implemented.") in
|
||||
let tmp_type_f = VariableTypeP (ref (Unbound (new_global_id (), level))) in
|
||||
let new_env = VariableMap.add f tmp_type_f env in
|
||||
let param_type = VariableTypeP (ref (Unbound (new_global_id (), level))) in
|
||||
let fn_env = VariableMap.add xs param_type new_env in
|
||||
let* body_type = evaluate_type_polimorphic fbody fn_env level in
|
||||
let* _ = unify tmp_type_f body_type in
|
||||
evaluate_type_polimorphic rest (VariableMap.add f tmp_type_f env) level
|
||||
|
||||
|
||||
(* -------------------------------------------------------------------------- *)
|
||||
|
||||
@ -419,3 +428,10 @@ let typecheck_polymorphic (program: t_exp)
|
||||
in
|
||||
let generalized_ty = generalize (-1) type_program in
|
||||
Ok (generalized_ty)
|
||||
|
||||
let typecheck_polymorphic_unbound (program: t_exp)
|
||||
: (type_f, [> typechecking_error]) result =
|
||||
global_type_id := 0;
|
||||
let* type_program = evaluate_type_polimorphic program VariableMap.empty 0 in
|
||||
let generalized_ty = generalize (-1) type_program in
|
||||
Ok (generalized_ty)
|
||||
|
||||
@ -1,3 +1,5 @@
|
||||
val typecheck : Types.t_exp -> (Types.ftype, [> Types.typechecking_error]) result
|
||||
|
||||
val typecheck_polymorphic : Types.t_exp -> (Types.type_f, [> Types.typechecking_error]) result
|
||||
|
||||
val typecheck_polymorphic_unbound : Types.t_exp -> (Types.type_f, [> Types.typechecking_error]) result
|
||||
|
||||
@ -134,6 +134,7 @@ type base_error = [
|
||||
type typechecking_error = [
|
||||
| base_error
|
||||
| `WrongTypeSpecification of string
|
||||
| `RecusrionsNotImplemented of string
|
||||
]
|
||||
|
||||
type error = [
|
||||
|
||||
@ -29,20 +29,6 @@ module IntegerMap : Map.S with type key = int
|
||||
|
||||
val pp_type_f : type_f -> string
|
||||
|
||||
(* module VariableTypeMap : Map.S with type key = variable_type *)
|
||||
|
||||
(* type substitution = (\* from variable types to politypes *\) *)
|
||||
(* politype VariableTypeMap.t *)
|
||||
|
||||
(* type prefix = *)
|
||||
(* | Lambda *)
|
||||
(* | Let *)
|
||||
(* | LetRec *)
|
||||
|
||||
(* type typed_prefix = *)
|
||||
(* (\* list of free variables in the context and the associated type *\) *)
|
||||
(* (prefix * politype) VariableMap.t *)
|
||||
|
||||
(* -------------------------------------------------------------------------- *)
|
||||
|
||||
type ftype = (* type used for specification *)
|
||||
@ -106,6 +92,7 @@ type base_error = [
|
||||
type typechecking_error = [
|
||||
| base_error
|
||||
| `WrongTypeSpecification of string
|
||||
| `RecusrionsNotImplemented of string
|
||||
]
|
||||
|
||||
type error = [
|
||||
|
||||
Reference in New Issue
Block a user