alternate day11 with no strings

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
+- [x] update node shim to include idris2-playground changes
-- [ ] refactor playground to better share code with idris2-playground
+- [x] refactor playground to better share code with idris2-playground
-- [ ] accepting DCon for another type (skipping case, but should be an error)
+- [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

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)
+step : List (Int × Int) → List (Int × Int)
-step2 = go Nil
+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

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"

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)
 

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)
 

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