diff --git a/playground/samples/DSL.newt b/playground/samples/DSL.newt index 234d48d..d455bf3 100644 --- a/playground/samples/DSL.newt +++ b/playground/samples/DSL.newt @@ -20,15 +20,15 @@ Z * m = Z infixr 4 _::_ data Vec : U → Nat → U where - Nil : {a} → Vec a Z - _::_ : {a k} → a → Vec a k → Vec a (S k) + Nil : ∀ a. Vec a Z + _::_ : ∀ a k. a → Vec a k → Vec a (S k) infixl 5 _++_ -_++_ : {a n m} → Vec a n → Vec a m → Vec a (n + m) +_++_ : ∀ a n m. Vec a n → Vec a m → Vec a (n + m) Nil ++ ys = ys (x :: xs) ++ ys = x :: (xs ++ ys) -map : {a b n} → (a → b) → Vec a n → Vec b n +map : ∀ a b n. (a → b) → Vec a n → Vec b n map f Nil = Nil map f (x :: xs) = f x :: map f xs @@ -57,12 +57,12 @@ data Unit : U where MkUnit : Unit data Either : U -> U -> U where - Left : {A B} → A → Either A B - Right : {A B} → B → Either A B + Left : ∀ a b. a → Either a b + Right : ∀ a b. b → Either a b infixr 4 _,_ data Both : U → U → U where - _,_ : {A B} → A → B → Both A B + _,_ : ∀ a b. a → b → Both a b typ : E → U typ Zero = Empty @@ -85,11 +85,11 @@ BothBoolBool = typ four ex1 : BothBoolBool ex1 = (false, true) -enumAdd : {a b m n} → Vec a m → Vec b n → Vec (Either a b) (m + n) +enumAdd : ∀ a b m n. Vec a m → Vec b n → Vec (Either a b) (m + n) enumAdd xs ys = map Left xs ++ map Right ys -- for this I followed the shape of _*_, the lecture was slightly different -enumMul : {a b m n} → Vec a m → Vec b n → Vec (Both a b) (m * n) +enumMul : ∀ a b m n. Vec a m → Vec b n → Vec (Both a b) (m * n) enumMul Nil ys = Nil enumMul (x :: xs) ys = map (_,_ x) ys ++ enumMul xs ys @@ -111,8 +111,8 @@ test4 = enumerate four -- for now, I'll define ≡ to check infixl 2 _≡_ -data _≡_ : {A} → A → A → U where - Refl : {A} {a : A} → a ≡ a +data _≡_ : ∀ a. a → a → U where + Refl : ∀ a. {x : a} → x ≡ x test2' : test2 ≡ false :: true :: Nil test2' = Refl diff --git a/playground/samples/Lists.newt b/playground/samples/Lists.newt index 4d352a8..db4b91c 100644 --- a/playground/samples/Lists.newt +++ b/playground/samples/Lists.newt @@ -87,7 +87,7 @@ reverse-++-distrib (x :: xs) ys = -- same thing, but using `replace` in the proof reverse-++-distrib' : ∀ A. (xs ys : List A) -> reverse (xs ++ ys) ≡ reverse ys ++ reverse xs reverse-++-distrib' Nil ys = sym (++-identity (reverse ys)) -reverse-++-distrib' {A} (x :: xs) ys = +reverse-++-distrib' {a} (x :: xs) ys = replace (\ z => (reverse (xs ++ ys) ++ (x :: Nil)) ≡ z) (sym (++-associative (reverse ys) (reverse xs) (x :: Nil))) (replace (\ z => (reverse (xs ++ ys)) ++ (x :: Nil) ≡ z ++ (x :: Nil)) (reverse-++-distrib' xs ys) Refl) diff --git a/playground/samples/Tree.newt b/playground/samples/Tree.newt index 4104e22..5059d15 100644 --- a/playground/samples/Tree.newt +++ b/playground/samples/Tree.newt @@ -3,7 +3,6 @@ module Tree -- adapted from Conor McBride's 2-3 tree example -- youtube video: https://youtu.be/v2yXrOkzt5w?t=3013 - data Nat : U where Z : Nat S : Nat -> Nat @@ -16,8 +15,8 @@ data Void : U where infixl 4 _+_ data _+_ : U -> U -> U where - inl : {A B} -> A -> A + B - inr : {A B} -> B -> A + B + inl : ∀ a b. a -> a + b + inr : ∀ a b. b -> a + b infix 4 _<=_ @@ -47,14 +46,14 @@ _ <<= Top = Unit _ <<= _ = Void data Intv : Bnd -> Bnd -> U where - intv : {l u} (x : Nat) (lx : l <<= N x) (xu : N x <<= u) -> Intv l u + intv : ∀ l u. (x : Nat) (lx : l <<= N x) (xu : N x <<= u) -> Intv l u data T23 : Bnd -> Bnd -> Nat -> U where - leaf : {l u} (lu : l <<= u) -> T23 l u Z - node2 : {l u h} (x : _) + leaf : ∀ l u. (lu : l <<= u) -> T23 l u Z + node2 : ∀ l u h. (x : _) (tlx : T23 l (N x) h) (txu : T23 (N x) u h) -> T23 l u (S h) - node3 : {l u h} (x y : _) + node3 : ∀ l u h. (x y : _) (tlx : T23 l (N x) h) (txy : T23 (N x) (N y) h) (tyu : T23 (N y) u h) -> T23 l u (S h) @@ -66,12 +65,12 @@ data Sg : (A : U) -> (A -> U) -> U where _,_ : {A : U} {B : A -> U} -> (a : A) -> B a -> Sg A B _*_ : U -> U -> U -A * B = Sg A (\ _ => B) +a * b = Sg a (\ _ => b) TooBig : Bnd -> Bnd -> Nat -> U TooBig l u h = Sg Nat (\ x => T23 l (N x) h * T23 (N x) u h) -insert : {l u h} -> Intv l u -> T23 l u h -> TooBig l u h + T23 l u h +insert : ∀ l u h. Intv l u -> T23 l u h -> TooBig l u h + T23 l u h insert (intv x lx xu) (leaf lu) = inl (x , (leaf lx , leaf xu)) insert (intv x lx xu) (node2 y tly tyu) = case cmp x y of -- u := N y is not solved at this time diff --git a/playground/samples/TypeClass.newt b/playground/samples/TypeClass.newt index 442149e..5ebebd6 100644 --- a/playground/samples/TypeClass.newt +++ b/playground/samples/TypeClass.newt @@ -5,7 +5,7 @@ class Monad (m : U → U) where pure : ∀ a. a → m a infixl 1 _>>=_ _>>_ -_>>=_ : {0 m} {{Monad m}} {0 a b} -> (m a) -> (a -> m b) -> m b +_>>=_ : ∀ 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 diff --git a/scripts/aoc25 b/scripts/aoc25 index 42fe35e..7293507 100755 --- a/scripts/aoc25 +++ b/scripts/aoc25 @@ -25,7 +25,7 @@ for fn in aoc2025/Day*.newt; do if ! diff -q tmp/${bn}.out ${fn}.golden; then echo "Output mismatch for $fn" failed=$((failed + 1)) - if [ $1 = "--fix" ]; then + if [ "$1" = "--fix" ]; then cp tmp/${bn}.out ${fn}.golden fi fi diff --git a/src/Lib/Parser.newt b/src/Lib/Parser.newt index d515ee3..b37aa18 100644 --- a/src/Lib/Parser.newt +++ b/src/Lib/Parser.newt @@ -314,7 +314,7 @@ lamExpr = do caseAlt : Parser RCaseAlt caseAlt = do pure MkUnit - pat <- typeExpr + pat <- term t <- optional (keyword "=>" >> term) pure $ MkAlt pat t @@ -364,6 +364,7 @@ doCaseLet = do keyword "=" sc <- typeExpr alts <- startBlock $ manySame $ symbol "|" *> caseAlt + -- REVIEW why am I collecting the rest here? bodyFC <- getPos body <- RDo <$> getPos <*> someSame doStmt pure $ DoExpr fc (RCase fc sc Nothing (MkAlt pat (Just body) :: alts)) @@ -457,9 +458,9 @@ ibind = do symbol "{" quant <- quantity names <- (some (addPos varname)) - ty <- optional (symbol ":" *> typeExpr) + ty <- symbol ":" *> typeExpr symbol "}" - pure $ map (makeBind quant ty) names + pure $ map (makeBind quant (Just ty)) names where makeBind : Quant → Maybe Raw → FC × String → BindInfo × Raw makeBind quant ty (pos, name) = (BI pos name Implicit quant, fromMaybe (RImplicit pos) ty) diff --git a/src/Prelude.newt b/src/Prelude.newt index 5b12249..396eaad 100644 --- a/src/Prelude.newt +++ b/src/Prelude.newt @@ -146,7 +146,7 @@ class Functor (m : U → U) where map : ∀ a b. (a → b) → m a → m b infixr 4 _<$>_ _<$_ -_<$>_ : ∀ f. {{Functor f}} {0 a b} → (a → b) → f a → f b +_<$>_ : ∀ f. {{Functor f}} {0 a b : _} → (a → b) → f a → f b f <$> ma = map f ma _<$_ : ∀ f a b. {{Functor f}} → b → f a → f b @@ -214,7 +214,7 @@ instance Applicative Maybe where infixr 2 _<|>_ class Alternative (m : U → U) where - _<|>_ : {0 a} → m a → m a → m a + _<|>_ : ∀ a. m a → m a → m a instance Alternative Maybe where Nothing <|> x = x @@ -368,12 +368,12 @@ instance Monad List where -- This is traverse, but we haven't defined Traversable yet -mapA : ∀ m. {{Applicative m}} {0 a b} → (a → m b) → List a → m (List b) +mapA : ∀ m. {{Applicative m}} {0 a b : _} → (a → m b) → List a → m (List b) mapA f Nil = return Nil mapA f (x :: xs) = return _::_ <*> f x <*> mapA f xs -mapM : ∀ m. {{Monad m}} {0 a b} → (a → m b) → List a → m (List b) +mapM : ∀ m. {{Monad m}} {0 a b : _} → (a → m b) → List a → m (List b) mapM f Nil = pure Nil mapM f (x :: xs) = do b <- f x @@ -433,6 +433,9 @@ pfunc pack : List Char → String := `(cs) => { } ` +-- FIXME this no longer works with numeric tags +-- we could take the best of both worlds and have a debug flag to add extra information +-- but also we could derive Show... pfunc debugStr uses (natToInt listToArray) : ∀ a. a → String := `(_, obj) => { const go = (obj) => { if (obj === null) return "_" diff --git a/tests/Tree.newt b/tests/Tree.newt index 859b8d3..c99f9cc 100644 --- a/tests/Tree.newt +++ b/tests/Tree.newt @@ -3,7 +3,6 @@ module Tree -- adapted from Conor McBride's 2-3 tree example -- youtube video: https://youtu.be/v2yXrOkzt5w?t=3013 - data Nat : U where Z : Nat S : Nat -> Nat @@ -16,8 +15,8 @@ data Void : U where infixl 4 _+_ data _+_ : U -> U -> U where - inl : {A B} -> A -> A + B - inr : {A B} -> B -> A + B + inl : ∀ a b. a -> a + b + inr : ∀ a b. b -> a + b infix 4 _<=_ @@ -47,14 +46,14 @@ _ <<= Top = Unit _ <<= _ = Void data Intv : Bnd -> Bnd -> U where - intv : {l u} (x : Nat) (lx : l <<= N x) (xu : N x <<= u) -> Intv l u + intv : ∀ l u. (x : Nat) (lx : l <<= N x) (xu : N x <<= u) -> Intv l u data T23 : Bnd -> Bnd -> Nat -> U where - leaf : {l u} (lu : l <<= u) -> T23 l u Z - node2 : {l u h} (x : _) + leaf : ∀ l u. (lu : l <<= u) -> T23 l u Z + node2 : ∀ l u h. (x : _) (tlx : T23 l (N x) h) (txu : T23 (N x) u h) -> T23 l u (S h) - node3 : {l u h} (x y : _) + node3 : ∀ l u h. (x y : _) (tlx : T23 l (N x) h) (txy : T23 (N x) (N y) h) (tyu : T23 (N y) u h) -> T23 l u (S h) @@ -71,7 +70,7 @@ a * b = Sg a (\ _ => b) TooBig : Bnd -> Bnd -> Nat -> U TooBig l u h = Sg Nat (\ x => T23 l (N x) h * T23 (N x) u h) -insert : {l u h} -> Intv l u -> T23 l u h -> TooBig l u h + T23 l u h +insert : ∀ l u h. Intv l u -> T23 l u h -> TooBig l u h + T23 l u h insert (intv x lx xu) (leaf lu) = inl (x , (leaf lx , leaf xu)) insert (intv x lx xu) (node2 y tly tyu) = case cmp x y of -- u := N y is not solved at this time