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

Fixes

Browse Source
This commit is contained in:
elvis
2025-02-02 20:46:55 +01:00
parent fec0142103
commit ab469ffa39
11 changed files with 79 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
lib/miniFun/Lexer.mll
View File

@ -56,6 +56,7 @@ rule read = parse
| "+" {PLUS}
| "," {COMMA}
| "-" {MINUS}
| "?" {QUESTIONMARK}
| "->" {TYPEFUNCTION}
| "/" {DIVISION}
| ":" {COLUMN}

3
lib/miniFun/Parser.mly
View File

@ -13,7 +13,7 @@
%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 FIRST SECOND QUESTIONMARK
%token EOF
%type <t_exp> prg
@ -90,6 +90,7 @@ texp:
typeexp:
| TYPEINT {IntegerType}
| TYPEBOOL {BooleanType}
| QUESTIONMARK {UnknownType}
| v = delimited(LEFTPAR, typeexp, RIGHTPAR)
{v}
| a = typeexp; COMMA; b = typeexp {TupleType (a, b)}

12
lib/miniFun/TypeChecker.ml
View File

@ -35,13 +35,13 @@ let rec unify type_a type_b =
unify a1 b1
| VariableTypeP ({contents = Link ty_link}), ty_rest
| ty_rest, VariableTypeP ({contents = Link ty_link})
when ty_link = ty_rest ->
Ok ()
| ty_rest, VariableTypeP ({contents = Link ty_link}) ->
unify ty_rest ty_link
| VariableTypeP ({contents = Unbound (a1, _)}),
VariableTypeP ({contents = Unbound (b1, _)})
when a1 = b1 ->
(* should never happen *)
Error (`WrongType "Only a single instance of a type should be available.")
| type_ab, VariableTypeP ({contents = Unbound (_id, _level)} as tvar)
@ -252,7 +252,7 @@ let rec evaluate_type_polimorphic program (env: env) level =
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) ->
let* _ = Error (`RecusrionsNotImplemented "Let Rec is not implemented.") in
let* _ = Error (`RecursionNotImplemented "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
@ -421,7 +421,7 @@ let typecheck (program: t_exp) : (ftype, [> typechecking_error]) result =
let typecheck_polymorphic (program: t_exp)
: (type_f, [> typechecking_error]) result =
: (type_f, [> polytypechecking_error]) result =
global_type_id := 0;
let* type_program = evaluate_type_polimorphic program VariableMap.empty 0 in
let* _ = unifyable type_program (FunctionTypeP (IntegerTypeP, IntegerTypeP))
@ -430,7 +430,7 @@ let typecheck_polymorphic (program: t_exp)
Ok (generalized_ty)
let typecheck_polymorphic_unbound (program: t_exp)
: (type_f, [> typechecking_error]) result =
: (type_f, [> polytypechecking_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

4
lib/miniFun/TypeChecker.mli
View File

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

8
lib/miniFun/Types.ml
View File

@ -76,6 +76,7 @@ let pp_type_f (ty: type_f) : string =
type ftype = (* type used for specification *)
IntegerType
| BooleanType
| UnknownType
| TupleType of ftype * ftype
| FunctionType of ftype * ftype
@ -134,9 +135,14 @@ type base_error = [
type typechecking_error = [
| base_error
| `WrongTypeSpecification of string
| `RecusrionsNotImplemented of string
]
type polytypechecking_error = [
| typechecking_error
| `RecursionNotImplemented of string
]
type error = [
| base_error
| `DivisionByZero of string

7
lib/miniFun/Types.mli
View File

@ -34,6 +34,7 @@ val pp_type_f : type_f -> string
type ftype = (* type used for specification *)
IntegerType
| BooleanType
| UnknownType
| TupleType of ftype * ftype
| FunctionType of ftype * ftype
@ -92,7 +93,11 @@ type base_error = [
type typechecking_error = [
| base_error
| `WrongTypeSpecification of string
| `RecusrionsNotImplemented of string
]
type polytypechecking_error = [
| typechecking_error
| `RecursionNotImplemented of string
]
type error = [