diff --git a/language.cabal b/language.cabal index cbb5260..a098bd7 100644 --- a/language.cabal +++ b/language.cabal @@ -33,6 +33,8 @@ executable language Auxiliary TypeChecker.TypeChecker TypeChecker.TypeCheckerIr + Monomorphizer.Monomorphizer + Monomorphizer.MonomorphizerIr Renamer.Renamer Codegen.Codegen Codegen.LlvmIr diff --git a/src/TypeChecker/TypeChecker.hs b/src/TypeChecker/TypeChecker.hs index b75f4e1..a2b4308 100644 --- a/src/TypeChecker/TypeChecker.hs +++ b/src/TypeChecker/TypeChecker.hs @@ -106,18 +106,20 @@ checkPrg (Program bs) = do checkBind :: Bind -> Infer T.Bind checkBind (Bind name args e) = do - let lambda = makeLambda e (reverse $ coerce args) - e@(_, t') <- inferExp lambda - s <- gets sigs - case M.lookup (coerce name) s of - Just (Just t) -> do - sub <- unify t t' - let newT = apply sub t - insertSig (coerce name) (Just newT) - return $ T.Bind (coerce name, newT) [] e - _ -> do - insertSig (coerce name) (Just t') - return (T.Bind (coerce name, t') [] e) -- (apply s e) + -- let lambda = makeLambda e (reverse $ coerce args) + args <- zip args <$> mapM (const fresh) args + withBindings (map coerce args) $ do + e@(_, t') <- inferExp e + s <- gets sigs + case M.lookup (coerce name) s of + Just (Just t) -> do + sub <- unify t t' + let newT = apply sub t + insertSig (coerce name) (Just newT) + return $ T.Bind (coerce name, newT) (map coerce args) e + _ -> do + insertSig (coerce name) (Just t') + return (T.Bind (coerce name, t') (map coerce args) e) -- (apply s e) where makeLambda :: Exp -> [Ident] -> Exp makeLambda = foldl (flip (EAbs . coerce)) diff --git a/src/TypeChecker/TypeCheckerIr.hs b/src/TypeChecker/TypeCheckerIr.hs index 45ea516..1113dbc 100644 --- a/src/TypeChecker/TypeCheckerIr.hs +++ b/src/TypeChecker/TypeCheckerIr.hs @@ -93,7 +93,7 @@ instance Print Program where prt i (Program sc) = prPrec i 0 $ prt 0 sc instance Print Bind where - prt i (Bind (name, t) _ rhs) = + prt i (Bind (name, t) args rhs) = prPrec i 0 $ concatD [ prt 0 name @@ -101,6 +101,7 @@ instance Print Bind where , prt 0 t , doc $ showString "\n" , prt 0 name + , prtIdPs 0 args , doc $ showString "=" , prt 0 rhs ]