Remove some ambiguities in parsing

This commit is contained in:
2026-03-06 21:41:26 -08:00
parent b1c2bfc896
commit 90e36d8faf
8 changed files with 41 additions and 39 deletions

View File

@@ -20,15 +20,15 @@ Z * m = Z
infixr 4 _::_ infixr 4 _::_
data Vec : U Nat U where data Vec : U Nat U where
Nil : {a} Vec a Z Nil : a. Vec a Z
_::_ : {a k} a Vec a k Vec a (S k) _::_ : a k. a Vec a k Vec a (S k)
infixl 5 _++_ 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 Nil ++ ys = ys
(x :: xs) ++ ys = x :: (xs ++ 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 Nil = Nil
map f (x :: xs) = f x :: map f xs map f (x :: xs) = f x :: map f xs
@@ -57,12 +57,12 @@ data Unit : U where
MkUnit : Unit MkUnit : Unit
data Either : U -> U -> U where data Either : U -> U -> U where
Left : {A B} A Either A B Left : a b. a Either a b
Right : {A B} B Either A B Right : a b. b Either a b
infixr 4 _,_ infixr 4 _,_
data Both : U U U where data Both : U U U where
_,_ : {A B} A B Both A B _,_ : a b. a b Both a b
typ : E U typ : E U
typ Zero = Empty typ Zero = Empty
@@ -85,11 +85,11 @@ BothBoolBool = typ four
ex1 : BothBoolBool ex1 : BothBoolBool
ex1 = (false, true) 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 enumAdd xs ys = map Left xs ++ map Right ys
-- for this I followed the shape of _*_, the lecture was slightly different -- 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 Nil ys = Nil
enumMul (x :: xs) ys = map (_,_ x) ys ++ enumMul xs ys enumMul (x :: xs) ys = map (_,_ x) ys ++ enumMul xs ys
@@ -111,8 +111,8 @@ test4 = enumerate four
-- for now, I'll define ≡ to check -- for now, I'll define ≡ to check
infixl 2 _≡_ infixl 2 _≡_
data _≡_ : {A} A A U where data _≡_ : a. a a U where
Refl : {A} {a : A} a a Refl : a. {x : a} x x
test2' : test2 false :: true :: Nil test2' : test2 false :: true :: Nil
test2' = Refl test2' = Refl

View File

@@ -87,7 +87,7 @@ reverse-++-distrib (x :: xs) ys =
-- same thing, but using `replace` in the proof -- same thing, but using `replace` in the proof
reverse-++-distrib' : A. (xs ys : List A) -> reverse (xs ++ ys) reverse ys ++ reverse xs reverse-++-distrib' : A. (xs ys : List A) -> reverse (xs ++ ys) reverse ys ++ reverse xs
reverse-++-distrib' Nil ys = sym (++-identity (reverse ys)) 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) replace (\ z => (reverse (xs ++ ys) ++ (x :: Nil)) z)
(sym (++-associative (reverse ys) (reverse xs) (x :: Nil))) (sym (++-associative (reverse ys) (reverse xs) (x :: Nil)))
(replace (\ z => (reverse (xs ++ ys)) ++ (x :: Nil) z ++ (x :: Nil)) (reverse-++-distrib' xs ys) Refl) (replace (\ z => (reverse (xs ++ ys)) ++ (x :: Nil) z ++ (x :: Nil)) (reverse-++-distrib' xs ys) Refl)

View File

@@ -3,7 +3,6 @@ module Tree
-- adapted from Conor McBride's 2-3 tree example -- adapted from Conor McBride's 2-3 tree example
-- youtube video: https://youtu.be/v2yXrOkzt5w?t=3013 -- youtube video: https://youtu.be/v2yXrOkzt5w?t=3013
data Nat : U where data Nat : U where
Z : Nat Z : Nat
S : Nat -> Nat S : Nat -> Nat
@@ -16,8 +15,8 @@ data Void : U where
infixl 4 _+_ infixl 4 _+_
data _+_ : U -> U -> U where data _+_ : U -> U -> U where
inl : {A B} -> A -> A + B inl : a b. a -> a + b
inr : {A B} -> B -> A + B inr : a b. b -> a + b
infix 4 _<=_ infix 4 _<=_
@@ -47,14 +46,14 @@ _ <<= Top = Unit
_ <<= _ = Void _ <<= _ = Void
data Intv : Bnd -> Bnd -> U where 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 data T23 : Bnd -> Bnd -> Nat -> U where
leaf : {l u} (lu : l <<= u) -> T23 l u Z leaf : l u. (lu : l <<= u) -> T23 l u Z
node2 : {l u h} (x : _) node2 : l u h. (x : _)
(tlx : T23 l (N x) h) (txu : T23 (N x) u h) -> (tlx : T23 l (N x) h) (txu : T23 (N x) u h) ->
T23 l u (S 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) -> (tlx : T23 l (N x) h) (txy : T23 (N x) (N y) h) (tyu : T23 (N y) u h) ->
T23 l u (S 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 _,_ : {A : U} {B : A -> U} -> (a : A) -> B a -> Sg A B
_*_ : U -> U -> U _*_ : U -> U -> U
A * B = Sg A (\ _ => B) a * b = Sg a (\ _ => b)
TooBig : Bnd -> Bnd -> Nat -> U TooBig : Bnd -> Bnd -> Nat -> U
TooBig l u h = Sg Nat (\ x => T23 l (N x) h * T23 (N x) u h) 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) (leaf lu) = inl (x , (leaf lx , leaf xu))
insert (intv x lx xu) (node2 y tly tyu) = case cmp x y of insert (intv x lx xu) (node2 y tly tyu) = case cmp x y of
-- u := N y is not solved at this time -- u := N y is not solved at this time

View File

@@ -5,7 +5,7 @@ class Monad (m : U → U) where
pure : a. a m a pure : a. a m a
infixl 1 _>>=_ _>>_ 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 ma >>= amb = bind ma amb
_>>_ : m a b. {{Monad m}} -> m a -> m b -> m b _>>_ : 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 Left : A B. A -> Either A B
Right : A B. B -> 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 (Left a) amb = Left a
bind (Right b) amb = amb b bind (Right b) amb = amb b

View File

@@ -25,7 +25,7 @@ for fn in aoc2025/Day*.newt; do
if ! diff -q tmp/${bn}.out ${fn}.golden; then if ! diff -q tmp/${bn}.out ${fn}.golden; then
echo "Output mismatch for $fn" echo "Output mismatch for $fn"
failed=$((failed + 1)) failed=$((failed + 1))
if [ $1 = "--fix" ]; then if [ "$1" = "--fix" ]; then
cp tmp/${bn}.out ${fn}.golden cp tmp/${bn}.out ${fn}.golden
fi fi
fi fi

View File

@@ -314,7 +314,7 @@ lamExpr = do
caseAlt : Parser RCaseAlt caseAlt : Parser RCaseAlt
caseAlt = do caseAlt = do
pure MkUnit pure MkUnit
pat <- typeExpr pat <- term
t <- optional (keyword "=>" >> term) t <- optional (keyword "=>" >> term)
pure $ MkAlt pat t pure $ MkAlt pat t
@@ -364,6 +364,7 @@ doCaseLet = do
keyword "=" keyword "="
sc <- typeExpr sc <- typeExpr
alts <- startBlock $ manySame $ symbol "|" *> caseAlt alts <- startBlock $ manySame $ symbol "|" *> caseAlt
-- REVIEW why am I collecting the rest here?
bodyFC <- getPos bodyFC <- getPos
body <- RDo <$> getPos <*> someSame doStmt body <- RDo <$> getPos <*> someSame doStmt
pure $ DoExpr fc (RCase fc sc Nothing (MkAlt pat (Just body) :: alts)) pure $ DoExpr fc (RCase fc sc Nothing (MkAlt pat (Just body) :: alts))
@@ -457,9 +458,9 @@ ibind = do
symbol "{" symbol "{"
quant <- quantity quant <- quantity
names <- (some (addPos varname)) names <- (some (addPos varname))
ty <- optional (symbol ":" *> typeExpr) ty <- symbol ":" *> typeExpr
symbol "}" symbol "}"
pure $ map (makeBind quant ty) names pure $ map (makeBind quant (Just ty)) names
where where
makeBind : Quant Maybe Raw FC × String BindInfo × Raw makeBind : Quant Maybe Raw FC × String BindInfo × Raw
makeBind quant ty (pos, name) = (BI pos name Implicit quant, fromMaybe (RImplicit pos) ty) makeBind quant ty (pos, name) = (BI pos name Implicit quant, fromMaybe (RImplicit pos) ty)

View File

@@ -146,7 +146,7 @@ class Functor (m : U → U) where
map : a b. (a b) m a m b map : a b. (a b) m a m b
infixr 4 _<$>_ _<$_ 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 <$> ma = map f ma
_<$_ : f a b. {{Functor f}} b f a f b _<$_ : f a b. {{Functor f}} b f a f b
@@ -214,7 +214,7 @@ instance Applicative Maybe where
infixr 2 _<|>_ infixr 2 _<|>_
class Alternative (m : U U) where 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 instance Alternative Maybe where
Nothing <|> x = x Nothing <|> x = x
@@ -368,12 +368,12 @@ instance Monad List where
-- This is traverse, but we haven't defined Traversable yet -- 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 Nil = return Nil
mapA f (x :: xs) = return _::_ <*> f x <*> mapA f xs 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 Nil = pure Nil
mapM f (x :: xs) = do mapM f (x :: xs) = do
b <- f x 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) => { pfunc debugStr uses (natToInt listToArray) : a. a String := `(_, obj) => {
const go = (obj) => { const go = (obj) => {
if (obj === null) return "_" if (obj === null) return "_"

View File

@@ -3,7 +3,6 @@ module Tree
-- adapted from Conor McBride's 2-3 tree example -- adapted from Conor McBride's 2-3 tree example
-- youtube video: https://youtu.be/v2yXrOkzt5w?t=3013 -- youtube video: https://youtu.be/v2yXrOkzt5w?t=3013
data Nat : U where data Nat : U where
Z : Nat Z : Nat
S : Nat -> Nat S : Nat -> Nat
@@ -16,8 +15,8 @@ data Void : U where
infixl 4 _+_ infixl 4 _+_
data _+_ : U -> U -> U where data _+_ : U -> U -> U where
inl : {A B} -> A -> A + B inl : a b. a -> a + b
inr : {A B} -> B -> A + B inr : a b. b -> a + b
infix 4 _<=_ infix 4 _<=_
@@ -47,14 +46,14 @@ _ <<= Top = Unit
_ <<= _ = Void _ <<= _ = Void
data Intv : Bnd -> Bnd -> U where 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 data T23 : Bnd -> Bnd -> Nat -> U where
leaf : {l u} (lu : l <<= u) -> T23 l u Z leaf : l u. (lu : l <<= u) -> T23 l u Z
node2 : {l u h} (x : _) node2 : l u h. (x : _)
(tlx : T23 l (N x) h) (txu : T23 (N x) u h) -> (tlx : T23 l (N x) h) (txu : T23 (N x) u h) ->
T23 l u (S 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) -> (tlx : T23 l (N x) h) (txy : T23 (N x) (N y) h) (tyu : T23 (N y) u h) ->
T23 l u (S h) T23 l u (S h)
@@ -71,7 +70,7 @@ a * b = Sg a (\ _ => b)
TooBig : Bnd -> Bnd -> Nat -> U TooBig : Bnd -> Bnd -> Nat -> U
TooBig l u h = Sg Nat (\ x => T23 l (N x) h * T23 (N x) u h) 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) (leaf lu) = inl (x , (leaf lx , leaf xu))
insert (intv x lx xu) (node2 y tly tyu) = case cmp x y of insert (intv x lx xu) (node2 y tly tyu) = case cmp x y of
-- u := N y is not solved at this time -- u := N y is not solved at this time