Fixed some internal errors

This commit is contained in:
Rakarake 2023-03-21 15:59:47 +01:00
parent ec95e0d9ef
commit 71d07ebf0f

View file

@ -140,7 +140,7 @@ getExpType (T.ELit t _) = t
getExpType (T.EApp t _ _) = t getExpType (T.EApp t _ _) = t
getExpType (T.EAdd t _ _) = t getExpType (T.EAdd t _ _) = t
getExpType (T.EAbs t _ _) = t getExpType (T.EAbs t _ _) = t
getExpType (T.ELet _ _) = error "Lets not allowed🛑👮" getExpType (T.ELet _ _) = error "lets not allowed🛑👮"
-- | If ident not already in env's output, morphed bind to output -- | If ident not already in env's output, morphed bind to output
-- (and all referenced binds within this bind). -- (and all referenced binds within this bind).
@ -173,11 +173,12 @@ morphExp expectedType exp = case exp of
return $ M.EAdd expectedType e1' e2' return $ M.EAdd expectedType e1' e2'
-- Add local vars to locals, this will never be called after the lambda lifter -- Add local vars to locals, this will never be called after the lambda lifter
T.EAbs _ (ident, _) e -> do let (M.TArr _ t) = expectedType T.EAbs _ (ident, _) e -> do let (M.TArr _ t) = expectedType
error "should not be able to happen" error "EAbs found in Monomorpher, should not be possible"
addLocal ident addLocal ident
morphExp t e morphExp t e
T.EId (ident, t) -> do maybeLocal <- localExists ident T.EId (ident@(Ident istr), t) -> do
maybeLocal <- localExists ident
if maybeLocal then do if maybeLocal then do
t' <- getMonoFromPoly t t' <- getMonoFromPoly t
return $ M.EId (ident, t') return $ M.EId (ident, t')
@ -185,7 +186,8 @@ morphExp expectedType exp = case exp of
clearLocals clearLocals
bind <- getInputBind ident bind <- getInputBind ident
case bind of case bind of
Nothing -> error "Wowzers!" Nothing ->
error $ "bind of name: " ++ istr ++ " not found"
Just bind' -> do Just bind' -> do
maybeCurrentFunc <- isCurrentFunc ident maybeCurrentFunc <- isCurrentFunc ident
t' <- getMonoFromPoly t t' <- getMonoFromPoly t
@ -195,7 +197,7 @@ morphExp expectedType exp = case exp of
morphBind t' bind' morphBind t' bind'
return $ M.EId (ident, t') return $ M.EId (ident, t')
T.ELet (T.Bind {}) _ -> error "Lets not possible yet." T.ELet (T.Bind {}) _ -> error "lets not possible yet"
-- Creates a new identifier for a function with an assigned type -- Creates a new identifier for a function with an assigned type
newName :: M.Type -> T.Bind -> Ident newName :: M.Type -> T.Bind -> Ident