diff --git a/TODO.md b/TODO.md index 1765518..c3c4e7c 100644 --- a/TODO.md +++ b/TODO.md @@ -5,10 +5,11 @@ - [x] SortedMap.newt issue in `where` - [x] fix "insufficient patterns", wire in M or Either String - [x] Matching _,_ when Maybe is expected should be an error +- [ ] There are issues with matching inside do blocks, I think we need to guess scrutinee? I could imagine constraining metas too (e.g. if Just ... at ?m123 then ?m123 =?= Maybe ?m456) - [ ] error for non-linear pattern - [ ] typeclass dependencies - need to flag internal functions to not search (or flag functions for search). I need to decide on syntax for this. - - don't search functions that are currently being defined. This is subtle... We do want to recurse in bind, we don't want to do that for the isEq function. Maybe something idris like. + - for something like an `isEq` field in `Ord`, auto-search is picking up the function being defined. - [ ] default implementations (use them if nothing is defined, where do we store them?) e.g. Ord compare, <, etc in Idris - [ ] syntax for negative integers - [ ] White box tests in `test` directory @@ -52,25 +53,26 @@ - [x] dead code elimination - [x] imported files leak info messages everywhere - For now, take the start ix for the file and report at end starting there -- [ ] update node shim to include idris2-playground changes -- [ ] refactor playground to better share code with idris2-playground -- [ ] accepting DCon for another type (skipping case, but should be an error) +- [x] update node shim to include idris2-playground changes +- [x] refactor playground to better share code with idris2-playground +- [x] accepting DCon for another type (skipping case, but should be an error) - [ ] don't allow (or dot) duplicate names on LHS - [x] remove metas from context, M has TopContext - [ ] improve test driver - maybe a file listing jobs, whether they are known broken, optional expected output, optional expected JS execution output. - [x] forall / ∀ sugar (Maybe drop this, issues with `.` and `{A}` works fine) - [x] Bad module name error has FC 0,0 instead of the module or name -- [ ] Remove context lambdas when printing solutions (show names from context) +- [ ] ~~Remove context lambdas when printing solutions (show names from context)~~ - maybe build list of names and strip λ, then call pprint with names + - I've removed solution printing, so this is moot - [ ] Revisit substitution in case building - [x] Check for shadowing when declaring dcon - Handles the forward decl in `Zoo1.newt`, but we'll need different syntax if we have different core terms for TCon/DCon/Function -- [ ] Require infix decl before declaring names with `_` (helps find bugs) +- [ ] Require infix decl before declaring names with `_` (helps find bugs) or implicitly define infixl something if it's missing - [x] sugar for typeclasses - [x] maybe add implicits in core to help resugar operators? -- [ ] consider binders in environment, like Idris, to better mark `let` and to provide names +- [ ] consider putting binders in environment, like Idris, to better mark `let` and to provide names - [x] move some top-level chattiness to `debug` - [ ] consider optionally compiling to eliminators for a second type-checking pass to help catch bugs. - [x] Allow unicode operators/names diff --git a/aoc2024/Day11.newt b/aoc2024/Day11.newt index eabff3f..4277be2 100644 --- a/aoc2024/Day11.newt +++ b/aoc2024/Day11.newt @@ -14,26 +14,14 @@ pfunc divide uses (_,_) : String → String × String := `(s) => { return _$2C_(undefined, undefined, s.slice(0,l), s.slice(l)) }` -step : List Int → List Int -step = go Nil - where - go : List Int → List Int → List Int - go acc Nil = acc - go acc (0 :: xs) = go (1 :: acc) xs - go acc (x :: xs) = - let str = show x in - if slen str % 2 == 0 - then let (a,b) = divide str in go (stringToInt a :: stringToInt b :: acc) xs - else go (2024 * x :: acc) xs - foldMap : ∀ a b. {{Ord a}} {{Eq a}} → (b → b → b) → SortedMap a b → List (a × b) → SortedMap a b foldMap f m Nil = m foldMap f m ((a,b) :: xs) = case lookupMap a m of Nothing => foldMap f (updateMap a b m) xs Just (_, b') => foldMap f (updateMap a (f b' b) m) xs -step2 : List (Int × Int) → List (Int × Int) -step2 = go Nil +step : List (Int × Int) → List (Int × Int) +step = go Nil where go : List (Int × Int) → List (Int × Int) → List (Int × Int) go acc Nil = acc @@ -49,7 +37,7 @@ iter count parts = let x = go count parts in foldl _+_ 0 $ map snd $ toList x where go : Int → SortedMap Int Int → SortedMap Int Int go 0 stuff = stuff - go x stuff = go (x - 1) $ foldMap _+_ EmptyMap $ step2 $ toList stuff + go x stuff = go (x - 1) $ foldMap _+_ EmptyMap $ step $ toList stuff run : String -> IO Unit run fn = do @@ -59,7 +47,7 @@ run fn = do let p1 = iter 25 stuff putStrLn $ "part1 " ++ show p1 let p2 = iter 75 stuff - putStrLn $ "iter " ++ show p2 + putStrLn $ "part2 " ++ show p2 main : IO Unit main = do diff --git a/aoc2024/Day11b.newt b/aoc2024/Day11b.newt new file mode 100644 index 0000000..a5be114 --- /dev/null +++ b/aoc2024/Day11b.newt @@ -0,0 +1,60 @@ +module Day11b + +import Prelude +import Node +import Aoc +import SortedMap + +-- Alternate version that doesn't use string + +infixl 7 _%_ +pfunc _%_ : Int → Int → Int := `(x,y) => x % y` + +-- 32 bit ints are too small +pfunc div53 : Int → Int → Int := `(x,y) => Math.floor(x / y)` + +stone : Int → Either Int (Int × Int) +stone num = if num == 0 then Left 1 else go num num 1 + where + go : Int → Int → Int → Either Int (Int × Int) + go a b mod = + if b == 0 then Right (a, num % mod) + else if b < 10 then Left (2024 * num) + else go (div53 a 10) (div53 b 100) (mod * 10) + +foldMap : ∀ a b. {{Ord a}} {{Eq a}} → (b → b → b) → SortedMap a b → List (a × b) → SortedMap a b +foldMap f m Nil = m +foldMap f m ((a,b) :: xs) = case lookupMap a m of + Nothing => foldMap f (updateMap a b m) xs + Just (_, b') => foldMap f (updateMap a (f b' b) m) xs + +step : List (Int × Int) → List (Int × Int) +step xs = go Nil xs + where + go : List (Int × Int) → List (Int × Int) → List (Int × Int) + go acc Nil = acc + go acc ((x,c) :: xs) = case stone x of + Left a => go ((a,c) :: acc) xs + Right (a,b) => go ((a,c) :: (b,c) :: acc) xs + +iter : Int → SortedMap Int Int → Int +iter count parts = let x = go count parts in foldl _+_ 0 $ map snd $ toList x + where + go : Int → SortedMap Int Int → SortedMap Int Int + go 0 stuff = stuff + go x stuff = go (x - 1) $ foldMap _+_ EmptyMap $ step $ toList stuff + +run : String -> IO Unit +run fn = do + putStrLn fn + text <- readFile fn + let stuff = foldMap _+_ EmptyMap $ map (\ x => (stringToInt x, 1)) $ split (trim text) " " + let p1 = iter 25 stuff + putStrLn $ "part1 " ++ show p1 + let p2 = iter 75 stuff + putStrLn $ "part2 " ++ show p2 + +main : IO Unit +main = do + run "aoc2024/day11/eg.txt" + run "aoc2024/day11/input.txt" diff --git a/newt/Prelude.newt b/newt/Prelude.newt index f7d60e4..19d40d8 100644 --- a/newt/Prelude.newt +++ b/newt/Prelude.newt @@ -441,6 +441,7 @@ _∘_ : {A B C : U} -> (B -> C) -> (A -> B) -> A -> C pfunc addInt : Int → Int → Int := `(x,y) => x + y` pfunc mulInt : Int → Int → Int := `(x,y) => x * y` +pfunc divInt : Int → Int → Int := `(x,y) => x / y | 0` pfunc subInt : Int → Int → Int := `(x,y) => x - y` pfunc ltInt uses (True False) : Int → Int → Bool := `(x,y) => x < y ? True : False` @@ -453,6 +454,9 @@ instance Add Int where instance Sub Int where x - y = subInt x y +instance Div Int where + x / y = divInt x y + printLn : {m} {{HasIO m}} {a} {{Show a}} → a → m Unit printLn a = putStrLn (show a) diff --git a/playground/samples/aoc2023/Prelude.newt b/playground/samples/aoc2023/Prelude.newt index f7d60e4..ed156b8 100644 --- a/playground/samples/aoc2023/Prelude.newt +++ b/playground/samples/aoc2023/Prelude.newt @@ -441,6 +441,7 @@ _∘_ : {A B C : U} -> (B -> C) -> (A -> B) -> A -> C pfunc addInt : Int → Int → Int := `(x,y) => x + y` pfunc mulInt : Int → Int → Int := `(x,y) => x * y` +pfunc divInt : Int → Int → Int := `(x,y) => x / y|0` pfunc subInt : Int → Int → Int := `(x,y) => x - y` pfunc ltInt uses (True False) : Int → Int → Bool := `(x,y) => x < y ? True : False` @@ -453,6 +454,9 @@ instance Add Int where instance Sub Int where x - y = subInt x y +instance Div Int where + x / y = divInt x y + printLn : {m} {{HasIO m}} {a} {{Show a}} → a → m Unit printLn a = putStrLn (show a) diff --git a/src/Lib/Erasure.idr b/src/Lib/Erasure.idr index 1fec464..723da8d 100644 --- a/src/Lib/Erasure.idr +++ b/src/Lib/Erasure.idr @@ -1,18 +1,22 @@ module Lib.Erasure import Lib.Types +import Data.Maybe import Data.SnocList import Lib.TopContext EEnv = List (String, Quant, Maybe Tm) +-- TODO look into removing Nothing below, can we recover all of the types? +-- Idris does this in `chk` for linearity checking. + -- check App at type getType : Tm -> M (Maybe Tm) getType (Ref fc nm x) = do top <- get case lookup nm top of - Nothing => pure Nothing + Nothing => error fc "\{nm} not in scope" (Just (MkEntry _ name type def)) => pure $ Just type getType tm = pure Nothing @@ -20,14 +24,17 @@ export erase : EEnv -> Tm -> List (FC, Tm) -> M Tm -- App a spine using type -eraseSpine : EEnv -> Tm -> List (FC, Tm) -> Maybe Tm -> M Tm +eraseSpine : EEnv -> Tm -> List (FC, Tm) -> (ty : Maybe Tm) -> M Tm eraseSpine env tm [] _ = pure tm eraseSpine env t ((fc, arg) :: args) (Just (Pi fc1 str icit Zero a b)) = do let u = Erased (getFC arg) eraseSpine env (App fc t u) args (Just b) eraseSpine env t ((fc, arg) :: args) (Just (Pi fc1 str icit Many a b)) = do u <- erase env arg [] + -- TODO this seems wrong, we need to subst u into b to get the type eraseSpine env (App fc t u) args (Just b) +-- eraseSpine env t ((fc, arg) :: args) (Just ty) = do +-- error fc "ceci n'est pas une ∏ \{showTm ty}" -- e.g. Bnd 1 eraseSpine env t ((fc, arg) :: args) _ = do u <- erase env arg [] eraseSpine env (App fc t u) args Nothing @@ -57,14 +64,14 @@ erase env t sp = case t of (Ref fc nm x) => do top <- get case lookup nm top of - Nothing => eraseSpine env t sp Nothing + Nothing => error fc "\{nm} not in scope" (Just (MkEntry _ name type def)) => eraseSpine env t sp (Just type) (Lam fc nm icit rig u) => Lam fc nm icit rig <$> erase ((nm, rig, Nothing) :: env) u [] -- If we get here, we're looking at a runtime pi type (Pi fc nm icit rig u v) => do u' <- erase env u [] v' <- erase ((nm, Many, Just u) :: env) v [] - eraseSpine env (Pi fc nm icit rig u' v') sp Nothing + eraseSpine env (Pi fc nm icit rig u' v') sp (Just $ U emptyFC) -- leaving as-is for now, we don't know the quantity of the apps (Meta fc k) => pure t (Case fc u alts) => do @@ -86,8 +93,8 @@ erase env t sp = case t of -- This is working, but empty FC Just (nm, Zero, ty) => error fc "used erased value \{show nm} (FIXME FC may be wrong here)" Just (nm, Many, ty) => eraseSpine env t sp ty - (U fc) => eraseSpine env t sp Nothing + (U fc) => eraseSpine env t sp (Just $ U fc) (Lit fc lit) => eraseSpine env t sp Nothing - Erased fc => eraseSpine env t sp Nothing + Erased fc => error fc "erased value in relevant context" -- eraseSpine env t sp Nothing