From: pimjager <pim@pimjager.nl>
Date: Thu, 5 May 2016 16:27:12 +0000 (+0200)
Subject: Small improvements, some errors here and there
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=d81ba67093ba9f7a9c2f6d47ec51651f99b4b5b3;p=cc1516.git

Small improvements, some errors here and there
---

diff --git a/examples/Markus/identity(2).spl b/examples/Markus/identity(2).spl
index cba491c..b06167a 100644
--- a/examples/Markus/identity(2).spl
+++ b/examples/Markus/identity(2).spl
@@ -1,31 +1,31 @@
-// Various versions of the identity function
+//// Various versions of the identity function//
 
 // Identity for integers
 // The type signature forces the function to have a more concrete type than it could have.
 id_int(x) :: Int -> Int
 {
   return x;
-}
-
+}//
+//
 
 // Polymorphic identity with type signature
 id_poly_with(x) :: a -> a
 {
   return x;
-}//
+}////
 
 
-//// Polymorphic identity without type signature
-//// Type checking should figure out the type forall a . a -> a
-//id_poly_without(x)
-//{
-//  return x;
-//}//
+// Polymorphic identity without type signature
+// Type checking should figure out the type forall a . a -> a
+id_poly_without(x)
+{
+  return x;
+}//
 
 
 // Clumsy polymorphic identity
 // Type checking should give type forall a . a -> a
-id_poly_wtf(x) :: a -> a
+id_poly_wtf(x)
 {
   var a = x;
   var b = a;
@@ -34,12 +34,14 @@ id_poly_wtf(x) :: a -> a
 }//
 
 
-//// Clumsy identity for integers
-//// Type checking should give type Int -> Int
-//id_int_wtf(x)
-//{
-//  var a = x;
-//  Int b = a;
-//  var c = b;
-//  return c;
-//}
+// Clumsy identity for integers
+// Type checking should give type Int -> Int
+id_int_wtf(x)
+{
+  var a = x;
+  Int b = a;
+  var c = b;
+  return c;
+}
+
+main() {return;}
\ No newline at end of file
diff --git a/examples/Markus/infinite_type_shouldfail.spl b/examples/Markus/infinite_type_shouldfail.spl
index 603cec0..73ac5ed 100644
--- a/examples/Markus/infinite_type_shouldfail.spl
+++ b/examples/Markus/infinite_type_shouldfail.spl
@@ -4,3 +4,7 @@ f(x)
 {
   return f( (x, x) );
 }
+
+main() {return;}
+
+//result: right now no type error... 
\ No newline at end of file
diff --git a/examples/Markus/overloading.spl b/examples/Markus/overloading.spl
index 4d8c615..f3ba7a3 100644
--- a/examples/Markus/overloading.spl
+++ b/examples/Markus/overloading.spl
@@ -1,9 +1,11 @@
 // At this point you maybe don't see what the problem is.
 // Wait until you try to implement your code generator.
 
-var a = equal(1, 2);
-
 equal(x, y)
 {
   return x == y;
 }
+
+a() {return equal(1, 2);}
+
+main() {return;}
\ No newline at end of file
diff --git a/examples/Markus/polymorphic_value_again_shouldfail.spl b/examples/Markus/polymorphic_value_again_shouldfail.spl
index a9bda2e..0381134 100644
--- a/examples/Markus/polymorphic_value_again_shouldfail.spl
+++ b/examples/Markus/polymorphic_value_again_shouldfail.spl
@@ -1,11 +1,13 @@
 // Another variant of the polymorphic value problem.
 
 // This is perfectly fine
-var tuple1 = (1:[], True:[]);
+tuple1() { return (1:[], True:[]); }
 
 // This should fail.
-var l = [];
-var tuple2 = (1:l, True:l);
+l() { return [];}
+tuple2() { return (1:l, True:l);}
 
 
 main() { return; }
+
+//result: does not fail!
\ No newline at end of file
diff --git a/examples/Markus/polymorphic_value_shouldfail.spl b/examples/Markus/polymorphic_value_shouldfail.spl
index 0b868ee..99c5a36 100644
--- a/examples/Markus/polymorphic_value_shouldfail.spl
+++ b/examples/Markus/polymorphic_value_shouldfail.spl
@@ -3,12 +3,13 @@
 
 // The empty list [] usually has polymorphic type forall a.[a], but you
 // cannot give the variable l this type. See below what can go wrong.
-var l = [];
 
 f()
 {
+  var l = [];
   // If l has polymorphic type forall a . [a], the next two lines are possible.
   l = 1:l;
   l = True:l;
   return;
 }
+main() {return;}
\ No newline at end of file
diff --git a/examples/Markus/recursion.spl b/examples/Markus/recursion.spl
index 6dbd124..b802743 100644
--- a/examples/Markus/recursion.spl
+++ b/examples/Markus/recursion.spl
@@ -12,3 +12,4 @@ gcd(m, n)
   else // n > m
     return gcd(m, n - m);
 }
+main() {return;}
\ No newline at end of file
diff --git a/examples/Markus/self_application_shouldfail(1).spl b/examples/Markus/self_application_shouldfail(1).spl
index 41397da..d048983 100644
--- a/examples/Markus/self_application_shouldfail(1).spl
+++ b/examples/Markus/self_application_shouldfail(1).spl
@@ -4,3 +4,5 @@ f(x)
 {
   return x(x);
 }
+main() {return;}
+//result: proper infinite type
\ No newline at end of file
diff --git a/examples/Markus/stress_test.spl b/examples/Markus/stress_test.spl
index 11e52b2..0cb22c5 100644
--- a/examples/Markus/stress_test.spl
+++ b/examples/Markus/stress_test.spl
@@ -2,7 +2,8 @@
 
 f0(x) { return (x, x); }
 f1(x) { return f0(f0(x)); }
-// f2(x) { return f1(f1(x)); }
-// f3(x) { return f2(f2(x)); }
-// f4(x) { return f3(f3(x)); }
+f2(x) { return f1(f1(x)); }
+f3(x) { return f2(f2(x)); }
+//f4(x) { return f3(f3(x)); } //using f4 gives Heap-full
 // f5(x) { return f4(f4(x)); }
+main() {return;}
\ No newline at end of file
diff --git a/sem.icl b/sem.icl
index 791ae69..7f7cdf4 100644
--- a/sem.icl
+++ b/sem.icl
@@ -222,7 +222,6 @@ instance infer Expr where
         pure ((compose s3 $ compose s2 s1), subst s3 tv)
 
     Op1Expr _ op e1 =
-        abort "infereing op1" >>|
         infer e1 >>= \(s1, t1) -> 
         fresh >>= \tv ->
         let given = t1 ->> tv in 
@@ -230,10 +229,9 @@ instance infer Expr where
         lift (unify expected given) >>= \s2 ->
         pure (compose s2 s1, subst s2 tv)
 
-    EmptyListExpr _ = abort "infereing []" >>| (\tv->(zero,tv)) <$> fresh
+    EmptyListExpr _ = (\tv->(zero,tv)) <$> fresh
 
     TupleExpr _ (e1, e2) = 
-        abort "infereing (,)" >>|
         infer e1 >>= \(s1, t1) -> 
         infer e2 >>= \(s2, t2) ->
         pure (compose s2 s1, TupleType (t1,t2))
@@ -242,7 +240,6 @@ instance infer Expr where
         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)->
-        //abort (concat (["argsTs: "] ++ (map toString argTs))) >>|
         fresh >>= \tv->
         let given = foldr (->>) tv argTs in
         lift (unify expected given) >>= \s2->
@@ -327,15 +324,17 @@ class type a :: a -> Typing a
 
 instance type VarDecl where
     type (VarDecl p expected k e) = 
-        infer e >>= \(s, given) ->
-        applySubst s >>| 
+        infer e >>= \(s1, given) ->
+        applySubst s1 >>| 
         case expected of
             Nothing = pure zero
             Just expected_ = lift (unify expected_ given)
-        >>|
-        generalize given >>= \t ->
+        >>= \s2->
+        applySubst s2 >>|
+        let vtype = subst (compose s2 s1) given in
+        generalize vtype >>= \t ->
         changeGamma (extend k t) >>| 
-        pure (VarDecl p (Just given) k e)
+        pure (VarDecl p (Just vtype) k e)
 
 instance type FunDecl where
     type (FunDecl p f args expected vds stmts) =