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

Start new

Browse Source
This commit is contained in:
elvis
2024-10-27 15:37:10 +01:00
parent 9a71d5011b
commit a6daee916e
4 changed files with 2 additions and 85 deletions
Download Patch File Download Diff File Expand all files Collapse all files

65
lib/miniFun/TypeChecker.ml
View File

@ -5,71 +5,6 @@ Random.self_init ()
let (let*) = Result.bind let (let*) = Result.bind
module VariableSet = Set.Make(String)
let rec freevariables (t: intermediaryTypes) : VariableSet.t =
match t with
(IntermediaryBooleanType) -> VariableSet.empty
| (IntermediaryIntegerType) -> VariableSet.empty
| (IntermediaryVariableType x) -> VariableSet.singleton x
| (IntermediaryFunctionType (Some name, tin)) ->
let partres = List.fold_left (fun acc x -> VariableSet.union acc (freevariables x)) VariableSet.empty tin in
VariableSet.add name partres
| (IntermediaryFunctionType (None, tin)) ->
List.fold_left (fun acc x -> VariableSet.union acc (freevariables x)) VariableSet.empty tin
let rec replaceunified (t: intermediaryTypes) (unifier: substitution) : intermediaryTypes =
match t with
IntermediaryIntegerType
| IntermediaryBooleanType -> t
| IntermediaryVariableType x -> (
match VariableMap.find_opt x unifier with
Some tnew -> tnew
| None -> t
)
| IntermediaryFunctionType (Some name, tin) -> (
match VariableMap.find_opt name unifier with
Some tnew -> tnew
| None -> IntermediaryFunctionType (Some name, List.map (fun x -> replaceunified x unifier) tin)
)
| IntermediaryFunctionType (None, tin) ->
IntermediaryFunctionType (None, List.map (fun x -> replaceunified x unifier) tin)
let rec unify t1 t2 =
match (t1, t2) with
| (_, IntermediaryVariableType x2) ->
if VariableSet.mem x2 (freevariables t1) then
Error (`WrongType "Cannot unify")
else
Ok (VariableMap.add x2 t1 VariableMap.empty)
| (IntermediaryVariableType x1, _) ->
if VariableSet.mem x1 (freevariables t2) then
Error (`WrongType "Cannot unify")
else
Ok (VariableMap.add x1 t2 VariableMap.empty)
| (IntermediaryIntegerType, IntermediaryIntegerType)
| (IntermediaryBooleanType, IntermediaryBooleanType) -> Ok VariableMap.empty
| (IntermediaryFunctionType (Some name1, tin1), IntermediaryFunctionType (Some name2, tin2)) ->
if name1 <> name2 then
Error (`WrongType "Different functions cannot be unified")
else
List.fold_left2 (
fun acc t1 t2 ->
if Result.is_error acc then (* stop at the first error *)
acc
else
let* partres = unify (replaceunified t1 (Result.get_ok acc)) (replaceunified t2 (Result.get_ok acc)) in
try
Ok (VariableMap.union (fun _ val1 val2 -> if val1 = val2 then Some val1 else failwith "Should not happen") partres acc)
with Failure e ->
Error (`WrongType e)
) (Ok VariableMap.empty) tin1 tin2
| (IntermediaryFunctionType (None, _), IntermediaryFunctionType _)
| (IntermediaryFunctionType _, IntermediaryFunctionType (None, _)) ->
Error (`WrongType "Unnamed Functions cannot be unified")
| _ -> failwith "Not implemented"
let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) : (ftype, error) result = let rec evaluate_type (program: t_exp) (context: ftype VariableMap.t) : (ftype, error) result =
match program with match program with
Integer _ -> Ok IntegerType Integer _ -> Ok IntegerType

6
lib/miniFun/TypeChecker.mli
View File

@ -1,7 +1 @@
val typecheck : Types.t_exp -> (Types.ftype, Types.error) result val typecheck : Types.t_exp -> (Types.ftype, Types.error) result
val unify : Types.intermediaryTypes -> Types.intermediaryTypes -> (Types.substitution, Types.error) result
module VariableSet : Set.S with type elt = string
val freevariables : Types.intermediaryTypes -> VariableSet.t

8
lib/miniFun/Types.ml
View File

@ -1,13 +1,7 @@
type variable = string type variable = string
module VariableMap = Map.Make(String) module VariableMap = Map.Make(String)
module VariableSet = Set.Make(String)
type intermediaryTypes =
IntermediaryIntegerType
| IntermediaryBooleanType
| IntermediaryFunctionType of (variable option) * (intermediaryTypes list)
| IntermediaryVariableType of variable
type substitution = intermediaryTypes VariableMap.t
type ftype = type ftype =
IntegerType IntegerType

8
lib/miniFun/Types.mli
View File

@ -1,13 +1,7 @@
type variable = string type variable = string
module VariableMap : Map.S with type key = variable module VariableMap : Map.S with type key = variable
module VariableSet : Set.S with type elt = string
type intermediaryTypes =
IntermediaryIntegerType
| IntermediaryBooleanType
| IntermediaryFunctionType of (variable option) * (intermediaryTypes list)
| IntermediaryVariableType of variable
type substitution = intermediaryTypes VariableMap.t
type ftype = type ftype =
IntegerType IntegerType