diff options
Diffstat (limited to 'Types.sml')
| -rw-r--r-- | Types.sml | 24 |
1 files changed, 17 insertions, 7 deletions
@@ -148,6 +148,8 @@ structure Types = struct bind makeBinding (Syntax.ITVar, v) (GenSym.new ()) env | bindPat makeBinding (Syntax.PTuple pats) env = foldl (fn (pat, env) => bindPat makeBinding pat env) env pats + | bindPat makeBinding (Syntax.PList pats) env = + foldl (fn (pat, env) => bindPat makeBinding pat env) env pats | bindPat makeBinding (Syntax.PCon (_, pat)) env = bindPat makeBinding pat env | bindPat _ _ env = env @@ -157,11 +159,6 @@ structure Types = struct | SOME (Arg t) => TyVar t | NONE => raise Fail ("unbound var " ^ printIdent name) - fun patBindings (Syntax.PVar v) : string list = [v] - | patBindings (Syntax.PTuple pats) = List.concat (map patBindings pats) - | patBindings (Syntax.PCon (_, pat)) = patBindings pat - | patBindings _ = [] - fun tyToSyntaxTy (TyVar v) = Syntax.TVar v | tyToSyntaxTy (TyCon (Bool, [])) = Syntax.TBool | tyToSyntaxTy (TyCon (Int, [])) = Syntax.TInt @@ -220,6 +217,13 @@ structure Types = struct Syntax.PTuple [] => (Syntax.TPCon (con, (Syntax.TPTuple [], Syntax.TTuple [])), conType) | _ => raise Fail ("non-function " ^ (String.concatWith "." con) ^ " applied to argument in pattern") end + | tagPat env (Syntax.PList pats) = + let + val taggedPats = map (tagPat env) pats + val elemType = TyVar (GenSym.new ()) + val _ = app (fn (_, t) => unify elemType t) taggedPats + in (Syntax.TPList (map (fn (x, t) => (x, tyToSyntaxTy t)) taggedPats), TyCon (List, [elemType])) + end fun F (env : env) (Syntax.EIdent i) : Syntax.typedExpr * ty = (Syntax.TEIdent i, lookupBinding i env) @@ -306,7 +310,7 @@ structure Types = struct arms in (Syntax.TECase ((arg, tyToSyntaxTy argType), arms), resultType) end | F env (Syntax.EStruct decls) = - let val (env, decls) = tagDecs env decls + let val (env', decls) = tagDecs env decls in ( Syntax.TEStruct decls , TyStruct @@ -314,7 +318,9 @@ structure Types = struct (map (fn (name, Let v) => (name, TyVar v) | (name, Arg v) => (name, TyVar v)) - (IdentMap.toList (#bindings env)))) + (List.filter + (fn (id, _) => not (isSome (IdentMap.lookup id (#bindings env)))) + (IdentMap.toList (#bindings env'))))) ) end | F env (Syntax.EFunctorApp (func, arg)) = @@ -465,6 +471,10 @@ structure Types = struct , boundVars = TyVarMap.empty , typesByName = StringMap.empty } + val alpha = TyVar (GenSym.new ()) + val cons = GenSym.new () + val _ = unify (TyVar cons) (TyCon (Fun, [TyCon (Tuple, [alpha, TyCon (List, [alpha])]), TyCon (List, [alpha])])) + val env = bind Let (Syntax.ITVar, "::") cons env val (expr, ty) = F env expr in reexpand (expr, tyToSyntaxTy ty) end end |