Fix for let rec, currently not implemented

This commit is contained in:
elvis
2025-01-31 16:44:14 +01:00
parent 9991efafbf
commit fec0142103
6 changed files with 46 additions and 31 deletions

View File

@ -29,6 +29,14 @@ let () =
() ()
in 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 let output = Clap.optional_string
~description: "Output file. If not specified output is printed on stdout." ~description: "Output file. If not specified output is printed on stdout."
~placeholder: "FILENAME" ~placeholder: "FILENAME"
@ -63,26 +71,32 @@ let () =
exit (-1) exit (-1)
in in
let ty_program = let ty_program =
match TypeChecker.typecheck_polymorphic program with match TypeChecker.typecheck_polymorphic_unbound program with
| Ok ty -> ty | Ok ty -> ty
| Error (`AbsentAssignment msg) | Error (`AbsentAssignment msg)
| Error (`WrongTypeSpecification msg) | Error (`WrongTypeSpecification msg)
| Error (`RecusrionsNotImplemented msg)
| Error (`WrongType msg) -> | Error (`WrongType msg) ->
Printf.fprintf stderr "%s\n" msg; Printf.fprintf stderr "%s\n" msg;
exit (-1) exit (-1)
in in
let return_value = let return_value =
if evalb then
match Semantics.reduce program inval with match Semantics.reduce program inval with
Ok o -> o Ok o -> Some o
| Error (`AbsentAssignment msg) | Error (`AbsentAssignment msg)
| Error (`DivisionByZero msg) | Error (`DivisionByZero msg)
| Error (`WrongType msg) -> | Error (`WrongType msg) ->
Printf.fprintf stderr "%s\n" msg; Printf.fprintf stderr "%s\n" msg;
exit (-1) exit (-1)
else
None
in in
Printf.fprintf outch "Type of the program: %s\n" (Types.pp_type_f ty_program); 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 in

View File

@ -1,5 +0,0 @@
\n: int =>
let fn =
\x: int => x + n
in
fn n

View File

@ -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* var_ty = evaluate_type_polimorphic xval env (level + 1) in
let generalized_ty = generalize level var_ty in let generalized_ty = generalize level var_ty in
evaluate_type_polimorphic rest (VariableMap.add x generalized_ty env) level 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 in
let generalized_ty = generalize (-1) type_program in let generalized_ty = generalize (-1) type_program in
Ok (generalized_ty) 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)

View File

@ -1,3 +1,5 @@
val typecheck : Types.t_exp -> (Types.ftype, [> Types.typechecking_error]) result 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 : Types.t_exp -> (Types.type_f, [> Types.typechecking_error]) result
val typecheck_polymorphic_unbound : Types.t_exp -> (Types.type_f, [> Types.typechecking_error]) result

View File

@ -134,6 +134,7 @@ type base_error = [
type typechecking_error = [ type typechecking_error = [
| base_error | base_error
| `WrongTypeSpecification of string | `WrongTypeSpecification of string
| `RecusrionsNotImplemented of string
] ]
type error = [ type error = [

View File

@ -29,20 +29,6 @@ module IntegerMap : Map.S with type key = int
val pp_type_f : type_f -> string 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 *) type ftype = (* type used for specification *)
@ -106,6 +92,7 @@ type base_error = [
type typechecking_error = [ type typechecking_error = [
| base_error | base_error
| `WrongTypeSpecification of string | `WrongTypeSpecification of string
| `RecusrionsNotImplemented of string
] ]
type error = [ type error = [