let given = t1 ->> tv in
op1Type op >>= \expected ->
lift (unify expected given) >>= \s2 ->
- pure (compose s2 s1, subst s2 tv)
+ pure (compose s2 s1, subst s2 tv, Op1Expr p op e1)
- EmptyListExpr _ = (\tv->(zero,tv)) <$> fresh
+ EmptyListExpr _ = (\tv->(zero,tv,e)) <$> fresh
- TupleExpr _ (e1, e2) =
- infer e1 >>= \(s1, t1) ->
- infer e2 >>= \(s2, t2) ->
- pure (compose s2 s1, TupleType (t1,t2))
+ TupleExpr p (e1, e2) =
+ infer e1 >>= \(s1, t1, e1_) ->
+ infer e2 >>= \(s2, t2, e2_) ->
+ pure (compose s2 s1, TupleType (t1,t2), TupleExpr p (e1_,e2_))
- FunExpr _ f args fs = //todo: fieldselectors
+ FunExpr p f args fs = //todo: fix print
lookup f >>= \expected ->
- let accST = (\(s,ts) e->infer e >>= \(s_,et)->pure (compose s_ s,ts++[et])) in
- foldM accST (zero,[]) args >>= \(s1, argTs)->
+ let accST = (\(s,ts,es) e->infer e >>= \(s_,et,e_)-> pure (compose s_ s,ts++[et],es++[e_])) in
+ foldM accST (zero,[],[]) args >>= \(s1, argTs, args_)->
- fresh >>= \tv->
- let given = foldr (->>) tv argTs in
- lift (unify expected given) >>= \s2->
- let fReturnType = subst s2 tv in
- foldM foldFieldSelectors fReturnType fs >>= \returnType ->
- (case f of
- "print" = case head argTs of
- IntType = pure "1printint"
- CharType = pure "1printchar"
- BoolType = pure "1printbool"
- ListType (CharType) = pure "1printstr"
- t = liftT $ Left $ SanityError p ("can not print " +++ toString t)
- _ = pure f) >>= \newF->
- pure (compose s2 s1, returnType, FunExpr p newF args_ fs)
+ fresh >>= \tv->case expected of
- FuncType t = pure (s1, t)
- _ = (let given = foldr (->>) tv argTs in
- lift (unify expected given) >>= \s2->
- let fReturnType = subst s2 tv in
- foldM foldFieldSelectors fReturnType fs >>= \returnType ->
- pure (compose s2 s1, returnType))
-
- IntExpr _ _ = pure $ (zero, IntType)
- BoolExpr _ _ = pure $ (zero, BoolType)
- CharExpr _ _ = pure $ (zero, CharType)
++ FuncType t = pure (s1, t, e)
++ _ = (let given = foldr (->>) tv argTs in
++ lift (unify expected given) >>= \s2->
++ let fReturnType = subst s2 tv in
++ foldM foldFieldSelectors fReturnType fs >>= \returnType ->
++ (case f of
++ "print" = case head argTs of
++ IntType = pure "1printint"
++ CharType = pure "1printchar"
++ BoolType = pure "1printbool"
++ ListType (CharType) = pure "1printstr"
++ t = liftT $ Left $ SanityError p ("can not print " +++ toString t)
++ _ = pure f) >>= \newF->
++ pure (compose s2 s1, returnType, FunExpr p newF args_ fs))
+
+ IntExpr _ _ = pure $ (zero, IntType, e)
+ BoolExpr _ _ = pure $ (zero, BoolType, e)
+ CharExpr _ _ = pure $ (zero, CharType, e)
foldFieldSelectors :: Type FieldSelector -> Typing Type
foldFieldSelectors (ListType t) (FieldHd) = pure t