Improvements to erasure checking, fix to codegen issue

playground/samples/Day2.newt

@@ -34,7 +34,7 @@ pfunc repr : {a : U} -> a -> String := `(a,o) => ''+o`
 pfunc jrepr : {a : U} -> a -> String := `(a,o) => JSON.stringify(o, null, '  ')`
 pfunc toInt : String -> Int := `s => Number(s)`
 
-mapM : {a b c : U} -> (a -> Either b c) -> List a -> Either b (List c)
+mapM : ∀ a b c. (a -> Either b c) -> List a -> Either b (List c)
 mapM f Nil = Right Nil
 mapM f (x :: xs) = case f x of
   Left msg => Left msg

playground/samples/Lists.newt

@@ -44,11 +44,11 @@ data _≡_ : ∀ A . A -> A -> U where
     Refl : ∀ A . {a : A} -> a ≡ a
 
 -- If a ≡ b then b ≡ a
-sym : {A} {a b : A} -> a ≡ b -> b ≡ a
+sym : ∀ A. {0 a b : A} -> a ≡ b -> b ≡ a
 sym Refl = Refl
 
 -- if a ≡ b and b ≡ c then a ≡ c
-trans : {A : U} {a b c : A} -> a ≡ b -> b ≡ c -> a ≡ c
+trans : ∀ A. {0 a b c : A} -> a ≡ b -> b ≡ c -> a ≡ c
 trans Refl x = x
 
 -- This lets us replace a with b inside an expression if a ≡ b

playground/samples/Prelude.newt

@@ -29,10 +29,10 @@ instance Eq Nat where
   x == y = False
 
 data Maybe : U -> U where
-  Just : {a : U} -> a -> Maybe a
-  Nothing : {a : U} -> Maybe a
+  Just : ∀ a. a -> Maybe a
+  Nothing : ∀ a. Maybe a
 
-fromMaybe : {a} → a → Maybe a → a
+fromMaybe : ∀ a. a → Maybe a → a
 fromMaybe a Nothing = a
 fromMaybe _ (Just a) = a
 
@@ -45,6 +45,10 @@ data List : U -> U where
   Nil : ∀ A. List A
   _::_ : ∀ A. A → List A → List A
 
+length : ∀ a. List a → Nat
+length Nil = Z
+length (x :: xs) = S (length xs)
+
 
 infixl 7 _:<_
 data SnocList : U → U where
@@ -61,7 +65,7 @@ Lin <>> ys = ys
 -- inference? Figure out why.
 -- Currently very noisy in generated code (if nothing else, optimize it out?)
 infixr 0 _$_
-_$_ : {a b : U} -> (a -> b) -> a -> b
+_$_ : ∀ a b. (a -> b) -> a -> b
 f $ a = f a
 
 infixr 8 _×_
@@ -181,13 +185,6 @@ ptype String
 ptype Int
 ptype Char
 
--- probably want to switch to Int or implement magic Nat
-pfunc length : String → Nat := `(s) => {
-  let rval = Z
-  for (let i = 0; i < s.length; s++) rval = S(rval)
-  return rval
-}`
-
 pfunc sconcat : String → String → String := `(x,y) => x + y`
 instance Concat String where
   _++_ = sconcat
@@ -211,7 +208,7 @@ pfunc alen : {0 a : U} -> Array a -> Int := `(a,arr) => arr.length`
 pfunc aget : {0 a : U} -> Array a -> Int -> a := `(a, arr, ix) => arr[ix]`
 pfunc aempty : {0 a : U} -> Unit -> Array a := `() => []`
 
-pfunc arrayToList : {0 a} → Array a → List a := `(a,arr) => {
+pfunc arrayToList uses (Nil _::_) : {0 a} → Array a → List a := `(a,arr) => {
   let rval = Nil(a)
   for (let i = arr.length - 1;i >= 0; i--) {
     rval = _$3A$3A_(a, arr[i], rval)
@@ -228,11 +225,11 @@ pfunc p_strHead : (s : String) -> Char := `(s) => s[0]`
 pfunc p_strTail : (s : String) -> String := `(s) => s[0]`
 
 pfunc trim : String -> String := `s => s.trim()`
-pfunc split : String -> String -> List String := `(s, by) => {
+pfunc split uses (Nil _::_) : String -> String -> List String := `(s, by) => {
   let parts = s.split(by)
   let rval = Nil(String)
   parts.reverse()
-  parts.forEach(p => { rval = _$3A$3A_(List(String), p, rval) })
+  parts.forEach(p => { rval = _$3A$3A_(undefined, p, rval) })
   return rval
 }`
 
@@ -266,12 +263,28 @@ instance Monad IO where
     MkIORes a w => mab a w
   pure a = \ w => MkIORes a w
 
+bindList : ∀ a b. List a → (a → List b) → List b
+
+instance ∀ a. Concat (List a) where
+  Nil ++ ys = ys
+  (x :: xs) ++ ys = x :: (xs ++ ys)
+
+instance Monad List where
+  pure a = a :: Nil
+  bind Nil amb = Nil
+  bind (x :: xs) amb = amb x ++ bind xs amb
+
 class HasIO (m : U -> U) where
   liftIO : ∀ a. IO a → m a
 
 instance HasIO IO where
   liftIO a = a
 
+pfunc debugLog uses (MkIORes MkUnit) : ∀ a. a -> IO Unit := `(_,s) => (w) => {
+  console.log(s)
+  return MkIORes(undefined,MkUnit,w)
+}`
+
 pfunc primPutStrLn uses (MkIORes MkUnit) : String -> IO Unit := `(s) => (w) => {
   console.log(s)
   return MkIORes(undefined,MkUnit,w)
@@ -303,9 +316,41 @@ pfunc unpack : String -> List Char
     return acc
 }`
 
+pfunc pack : List Char → String := `(cs) => {
+  let rval = ''
+  while (cs.tag === '_::_') {
+    rval += cs.h1
+    cs = cs.h2
+  }
 
+  return rval
+}
+`
 
-foldl : {A B : U} -> (B -> A -> B) -> B -> List A -> B
+pfunc debugStr : ∀ a. a → String := `(_, obj) => {
+  const go = (obj) => {
+    if (obj?.tag) {
+      let rval = '('+obj.tag
+      for(let i=0;;i++) {
+        let key = 'h'+i
+        if (!(key in obj)) break
+        rval += ' ' + go(obj[key])
+      }
+      return rval+')'
+    } else {
+      return JSON.stringify(obj)
+    }
+  }
+  return go(obj)
+}`
+
+pfunc stringToInt : String → Int := `(s) => {
+  let rval = Number(s)
+  if (isNaN(rval)) throw new Error(s + " is NaN")
+  return rval
+}`
+
+foldl : ∀ A B. (B -> A -> B) -> B -> List A -> B
 foldl f acc Nil = acc
 foldl f acc (x :: xs) = foldl f (f acc x) xs
 
@@ -337,3 +382,19 @@ printLn a = putStrLn (show a)
 -- opaque JSObject
 ptype JSObject
 
+reverse : ∀ a. List a → List a
+reverse {a} = go Nil
+  where
+    go : List a → List a → List a
+    go acc Nil = acc
+    go acc (x :: xs) = go (x :: acc) xs
+
+-- Like Idris1, but not idris2, we need {a} to put a in scope.
+span : ∀ a. (a -> Bool) -> List a -> List a × List a
+span {a} f xs = go xs Nil
+  where
+    go : List a -> List a -> List a × List a
+    go Nil left = (reverse left, Nil)
+    go (x :: xs) left = if f x
+      then go xs (x :: left)
+      else (reverse left, x :: xs)

playground/samples/Reasoning.newt

@@ -2,20 +2,20 @@ module Reasoning
 
 infix 4 _≡_
 data _≡_ : {A : U} → A → A → U where
-  Refl : {A} {x : A} → x ≡ x
+  Refl : ∀ A. {x : A} → x ≡ x
 
-sym : {A} {x y : A} → x ≡ y → y ≡ x
+sym : ∀ A. {x y : A} → x ≡ y → y ≡ x
 sym Refl = Refl
 
-trans : {A} {x y z : A} → x ≡ y → y ≡ z → x ≡ z
+trans : ∀ A. {x y z : A} → x ≡ y → y ≡ z → x ≡ z
 trans Refl eq = eq
 
-cong : {A B} (f : A → B) {x y : A}
+cong : ∀ A B. (f : A → B) {x y : A}
   → x ≡ y
   → f x ≡ f y
 cong f Refl = Refl
 
-cong-app : {A B} {f g : A → B}
+cong-app : ∀ A B. {f g : A → B}
   → f ≡ g
   → (x : A) →  f x ≡ g x
 cong-app Refl = λ y => Refl
@@ -24,16 +24,16 @@ infixl 1 begin_
 infixr 2 _≡⟨⟩_ _≡⟨_⟩_
 infixl 3 _∎
 
-begin_ : {A} {x y : A} → x ≡ y → x ≡ y
-begin_ x≡y = x≡y
+begin_ : ∀ A. {x y : A} → x ≡ y → x ≡ y
+begin x≡y = x≡y
 
-_≡⟨⟩_  : {A} (x : A) {y : A} → x ≡ y → x ≡ y
+_≡⟨⟩_  : ∀ A. (x : A) {y : A} → x ≡ y → x ≡ y
 x ≡⟨⟩ x≡y = x≡y
 
-_≡⟨_⟩_ : {A} (x : A) {y z : A} → x ≡ y → y ≡ z → x ≡ z
+_≡⟨_⟩_ : ∀ A. (x : A) {y z : A} → x ≡ y → y ≡ z → x ≡ z
 x ≡⟨ x≡y ⟩ y≡z = trans x≡y y≡z
 
-_∎ : {A} → (x : A) → x ≡ x
+_∎ : ∀ A. (x : A) → x ≡ x
 x ∎ = Refl
 
 

playground/samples/Tour.newt

@@ -136,8 +136,8 @@ concat a b = a + b
 
 -- Now we define Monad
 class Monad (m : U -> U) where
-  pure : {a} -> a -> m a
-  bind : {a b} -> m a -> (a -> m b) -> m b
+  pure : ∀ a. a -> m a
+  bind : ∀ a b. m a -> (a -> m b) -> m b
 
 /-
 This desugars to:

playground/samples/TypeClass.newt

@@ -1,11 +1,11 @@
 module TypeClass
 
 class Monad (m : U → U) where
-  bind : {a b} → m a → (a → m b) → m b
-  pure : {a} → a → m a
+  bind : ∀ a b. m a → (a → m b) → m b
+  pure : ∀ a. a → m a
 
 infixl 1 _>>=_ _>>_
-_>>=_ : {m} {{Monad m}} {a b} -> (m a) -> (a -> m b) -> m b
+_>>=_ : {0 m} {{Monad m}} {0 a b} -> (m a) -> (a -> m b) -> m b
 ma >>= amb = bind ma amb
 
 _>>_ : ∀ m a b. {{Monad m}} -> m a -> m b -> m b
@@ -15,7 +15,7 @@ data Either : U -> U -> U where
   Left : ∀ A B. A -> Either A B
   Right : ∀ A B. B -> Either A B
 
-instance {a} → Monad (Either a) where
+instance {a} -> Monad (Either a) where
   bind (Left a) amb = Left a
   bind (Right b) amb = amb b