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 _::_
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

View File

@@ -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)

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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)

View File

@@ -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 "_"

View File

@@ -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