merge aoc lib and prelude

playground/build

@@ -6,5 +6,5 @@ esbuild src/worker.ts > public/worker.js
 echo copy newt
 cp ../build/exec/newt.js public
 # cat ../build/exec/newt.js |grep -v '^#'>> public/worker.js
-cp samples/* public
+cp -r samples/* public
 # esbuild --minify ../build/exec/newt.min.js > public/newt.js

playground/samples/Day1.newt

@@ -1,6 +1,7 @@
+-- Doesn't run in playground because it's using the node `fs` module
 module Day1
 
-import Lib
+import Prelude
 
 digits1 : List Char -> List Int
 digits1 Nil = Nil
@@ -48,27 +49,22 @@ part1 text digits =
   let nums = map combine $ map digits lines in
   foldl _+_ 0 nums
 
--- Hack from before I had support for typeclasses
-infixl 1 _>>_
-_>>_ : {A B : U} -> A -> B -> B
-a >> b = b
+#check digits1 ∘ unpack : String -> List Int
 
-
-runFile : String -> Dummy
-runFile fn =
-  let text = readFile fn in
-  log fn >>
-  log "part1" >>
-  log (part1 text (digits1 ∘ unpack)) >>
-  log "part2" >>
-  log (part1 text (digits2 ∘ unpack)) >>
-  log ""
+runFile : String -> IO Unit
+runFile fn = do
+  text <- readFile fn
+  putStrLn fn
+  putStrLn "part1"
+  putStrLn $ show (part1 text (digits1 ∘ unpack))
+  putStrLn "part2"
+  putStrLn $ show (part1 text (digits2 ∘ unpack))
+  putStrLn ""
 
 
 -- Argument is a hack to keep it from running at startup.  Need to add IO
-main : Int -> Dummy
-main _ =
-  runFile "aoc2023/day1/eg.txt" >>
-  runFile "aoc2023/day1/eg2.txt" >>
+main : IO Unit
+main = do
+  runFile "aoc2023/day1/eg.txt"
+  runFile "aoc2023/day1/eg2.txt"
   runFile "aoc2023/day1/input.txt"
-

playground/samples/Day2.newt

@@ -1,9 +1,9 @@
 module Day2
 
-import Lib
+import Prelude
 
 Draw : U
-Draw = Pair Int (Pair Int Int)
+Draw = Int × Int × Int
 
 data Game : U where
   MkGame : Int -> List Draw -> Game
@@ -68,11 +68,6 @@ parseGame line =
       _ => Left "No Game"
     _ => Left $ "No colon in " ++ line
 
-infixl 1 _>>_
-
-_>>_ : {A B : U} -> A -> B -> B
-a >> b = b
-
 part1 : List Game -> Int
 part1 Nil = 0
 part1 (MkGame n parts :: rest) =
@@ -87,18 +82,18 @@ part2 (MkGame n parts :: rest) =
   case foldl maxd (0,0,0) parts of
     (a,b,c) => a * b * c + part2 rest
 
-run : String -> Dummy
-run fn =
-  let text = readFile fn in
+run : String -> IO Unit
+run fn = do
+  text <- readFile fn
   case mapM parseGame (split (trim text) "\n") of
-    Left err => log $ "fail " ++ err
-    Right games =>
-      log "part1" >>
-      log (part1 games) >>
-      log "part2" >>
-      log (part2 games)
+    Left err => putStrLn $ "fail " ++ err
+    Right games => do
+      putStrLn "part1"
+      printLn (part1 games)
+      putStrLn "part2"
+      printLn (part2 games)
 
-main : Dummy -> Dummy
-main _ =
-  run "aoc2023/day2/eg.txt" >>
+main : IO Unit
+main = do
+  run "aoc2023/day2/eg.txt"
   run "aoc2023/day2/input.txt"

playground/samples/Prelude.newt

@@ -1,47 +1,331 @@
 module Prelude
 
+
+data Bool : U where
+  True False : Bool
+
+not : Bool → Bool
+not True = False
+not False = True
+
+-- In Idris, this is lazy in the second arg, we're not doing
+-- magic laziness for now, it's messy
+infixr 4 _||_
+_||_ : Bool → Bool → Bool
+True || _ = True
+False || b = b
+
+infixl 6 _==_
+class Eq a where
+  _==_ : a → a → Bool
+
 data Nat : U where
   Z : Nat
   S : Nat -> Nat
 
+instance Eq Nat where
+  Z == Z = True
+  S n == S m = n == m
+  x == y = False
+
 data Maybe : U -> U where
   Just : {a : U} -> a -> Maybe a
   Nothing : {a : U} -> Maybe a
 
+fromMaybe : {a} → a → Maybe a → a
+fromMaybe a Nothing = a
+fromMaybe _ (Just a) = a
+
 data Either : U -> U -> U where
   Left : {a b : U} -> a -> Either a b
   Right : {a b : U} -> b -> Either a b
 
+infixr 7 _::_
+data List : U -> U where
+  Nil : {A} → List A
+  _::_ : {A} → A → List A → List A
+
+
+infixl 7 _:<_
+data SnocList : U → U where
+  Lin : {A} → SnocList A
+  _:<_ : {A} → SnocList A → A → SnocList A
+
+-- 'chips'
+infixr 6 _<>>_
+_<>>_ : {a} → SnocList a → List a → List a
+Lin <>> ys = ys
+(xs :< x) <>> ys = xs <>> x :: ys
+
 -- TODO this is special cased in some languages, maybe for easier
 -- inference? Figure out why.
-
+-- Currently very noisy in generated code (if nothing else, optimize it out?)
 infixr 0 _$_
-
--- Currently very noisy in generated code
 _$_ : {a b : U} -> (a -> b) -> a -> b
 f $ a = f a
 
+infixr 8 _×_
+infixr 2 _,_
+data _×_ : U → U → U where
+  _,_ : {A B} → A → B → A × B
+
+infixl 6 _<_
+class Ord a where
+  _<_ : a → a → Bool
+
+instance Ord Nat where
+  _ < Z = False
+  Z < S _ = True
+  S n < S m = n < m
 
 -- Monad
 
--- TODO stack with Applicative, etc?
-
-data Monad : (U -> U) -> U where
-  MkMonad : { M : U -> U } ->
-            (bind : {A B : U} -> (M A) -> (A -> M B) -> M B) ->
-            (pure : {A : U} -> A -> M A) ->
-            Monad M
+class Monad (m : U → U) where
+  bind : {a b} → m a → (a → m b) → m b
+  pure : {a} → a → m a
 
 infixl 1 _>>=_ _>>_
-_>>=_ : {a b : U} -> {m : U -> U} -> {{x : Monad m}} -> (m a) -> (a -> m b) -> m b
-_>>=_ {a} {b} {m} {{MkMonad bind' _}}  ma amb = bind' {a} {b} ma amb
+_>>=_ : {m} {{Monad m}} {a b} -> (m a) -> (a -> m b) -> m b
+ma >>= amb = bind ma amb
 
-_>>_ : {a b : U} -> {m : U -> U} -> {{x : Monad m}} -> m a -> m b -> m b
+_>>_ :  {m} {{Monad m}} {a b} -> m a -> m b -> m b
 ma >> mb = mb
 
-pure : {a : U} {m : U -> U} {{_ : Monad m}} -> a -> m a
-pure {_} {_} {{MkMonad _ pure'}} a = pure' a
+-- Equality
 
--- IO
+infixl 1 _≡_
+data _≡_ : {A : U} -> A -> A -> U where
+  Refl :  {A : U} -> {a : A} -> a ≡ a
+
+replace : {A : U} {a b : A} -> (P : A -> U) -> a ≡ b -> P a -> P b
+replace p Refl x = x
+
+cong : {A B : U} {a b : A} -> (f : A -> B) -> a ≡ b -> f a ≡ f b
+
+sym : {A : U} -> {a b : A} -> a ≡ b -> b ≡ a
+sym Refl = Refl
+
+-- Functor
+
+class Functor (m : U → U) where
+  map : {a b} → (a → b) → m a → m b
+
+infixr 4 _<$>_
+_<$>_ : {f} {{Functor f}} {a b} → (a → b) → f a → f b
+f <$> ma = map f ma
+
+instance Functor Maybe where
+  map f Nothing = Nothing
+  map f (Just a) = Just (f a)
+
+instance Functor List where
+  map f Nil = Nil
+  map f (x :: xs) = f x :: map f xs
+
+instance Functor SnocList where
+  map f Lin = Lin
+  map f (xs :< x) = map f xs :< f x
+
+-- TODO this probably should depend on / entail Functor
+infixl 3 _<*>_
+class Applicative (f : U → U) where
+  -- appIsFunctor : Functor f
+  return : {a} → a → f a
+  _<*>_ : {a b} -> f (a → b) → f a → f b
+
+infixr 2 _<|>_
+class Alternative (m : U → U) where
+  _<|>_ : {a} → m a → m a → m a
+
+instance Alternative Maybe where
+  Nothing <|> x = x
+  Just x <|> _ = Just x
+
+-- Semigroup
+
+infixl 8 _<+>_
+class Semigroup a where
+  _<+>_ : a → a → a
+
+infixl 7 _+_
+class Add a where
+  _+_ : a → a → a
+
+infixl 8 _*_
+class Mul a where
+  _*_ : a → a → a
+
+instance Add Nat where
+  Z + m = m
+  S n + m = S (n + m)
+
+instance Mul Nat where
+  Z * _ = Z
+  S n * m = m + n * m
 
 
+infixl 7 _-_
+class Sub a where
+  _-_ : a → a → a
+
+instance Sub Nat where
+  Z - m = Z
+  n - Z = n
+  S n - S m = n - m
+
+infixr 7 _++_
+class Concat a where
+  _++_ : a → a → a
+
+ptype String
+ptype Int
+ptype Char
+
+-- probably want to switch to Int or implement magic Nat
+pfunc length : String → Nat := "(s) => {
+  let rval = Z
+  for (let i = 0; i < s.length; s++) rval = S(rval)
+  return rval
+}"
+
+pfunc sconcat : String → String → String := "(x,y) => x + y"
+instance Concat String where
+  _++_ = sconcat
+
+data Unit : U where
+  MkUnit : Unit
+
+ptype Array : U → U
+pfunc listToArray : {a : U} -> List a -> Array a := "
+(a, l) => {
+  let rval = []
+  while (l.tag !== 'Nil') {
+    rval.push(l.h1)
+    l = l.h2
+  }
+  return rval
+}
+"
+
+pfunc alen : {a : U} -> Array a -> Int := "(a,arr) => arr.length"
+pfunc aget : {a : U} -> Array a -> Int -> a := "(a, arr, ix) => arr[ix]"
+pfunc aempty : {a : U} -> Unit -> Array a := "() => []"
+
+pfunc arrayToList : {a} → Array a → List a := "(a,arr) => {
+  let rval = Nil(a)
+  for (let i = arr.length - 1;i >= 0; i--) {
+    rval = _$3A$3A_(a, arr[i], rval)
+  }
+  return rval
+}"
+
+
+pfunc getArgs : List String := "arrayToList(String, process.argv)"
+
+-- for now I'll run this in JS
+pfunc lines : String → List String := "(s) => arrayToList(s.split('\\n'))"
+
+pfunc p_strHead : (s : String) -> Char := "(s) => s[0]"
+pfunc p_strTail : (s : String) -> String := "(s) => s[0]"
+
+pfunc trim : String -> String := "s => s.trim()"
+pfunc split : String -> String -> List String := "(s, by) => {
+  let parts = s.split(by)
+  let rval = Nil(String)
+  parts.reverse()
+  parts.forEach(p => { rval = _$3A$3A_(List(String), p, rval) })
+  return rval
+}"
+
+pfunc slen : String -> Int := "s => s.length"
+pfunc sindex : String -> Int -> Char := "(s,i) => s[i]"
+
+-- TODO represent Nat as number at runtime
+pfunc natToInt : Nat -> Int := "(n) => {
+  let rval = 0
+  while (n.tag === 'S') {
+    n = n.h0
+    rval++
+  }
+  return rval
+}"
+
+pfunc fastConcat : List String → String := "(xs) => listToArray(undefined, xs).join('')"
+pfunc replicate : Nat -> Char → String := "(n,c) => c.repeat(natToInt(n))"
+
+-- I don't want to use an empty type because it would be a proof of void
+ptype World
+
+data IORes : U -> U where
+  MkIORes : {a : U} -> a -> World -> IORes a
+
+IO : U -> U
+IO a = World -> IORes a
+
+instance Monad IO where
+  bind ma mab = \ w => case ma w of
+    MkIORes a w => mab a w
+  pure a = \ w => MkIORes a w
+
+pfunc putStrLn : String -> IO Unit := "(s) => (w) => {
+  console.log(s)
+  return MkIORes(Unit,MkUnit,w)
+}"
+
+pfunc showInt : Int -> String := "(i) => String(i)"
+
+class Show a where
+  show : a → String
+
+instance Show String where
+  show a = a
+
+instance Show Int where
+  show = showInt
+
+pfunc ord : Char -> Int := "(c) => c.charCodeAt(0)"
+
+infix 6 _<=_
+pfunc _<=_ : Int -> Int -> Bool := "(x,y) => (x <= y) ? True : False"
+
+
+pfunc unpack : String -> List Char
+  := "(s) => {
+    let acc = Nil(Char)
+    for (let i = s.length - 1; 0 <= i; i--) acc = _$3A$3A_(Char, s[i], acc)
+    return acc
+}"
+
+
+ptype Dummy
+pfunc fs : Dummy := "require('fs')"
+pfunc readFile : (fn : String) -> IO String := "(fn) => (w) => MkIORes(Unit, fs.readFileSync(fn, 'utf8'), w)"
+
+foldl : {A B : U} -> (B -> A -> B) -> B -> List A -> B
+foldl f acc Nil = acc
+foldl f acc (x :: xs) = foldl f (f acc x) xs
+
+infixl 9 _∘_
+_∘_ : {A B C : U} -> (B -> C) -> (A -> B) -> A -> C
+(f ∘ g) x = f (g x)
+
+
+pfunc addInt : Int → Int → Int := "(x,y) => x + y"
+pfunc mulInt : Int → Int → Int := "(x,y) => x * y"
+pfunc subInt : Int → Int → Int := "(x,y) => x - y"
+pfunc ltInt : Int → Int → Bool := "(x,y) => x < y ? True : False"
+
+instance Mul Int where
+  x * y = mulInt x y
+
+instance Add Int where
+  x + y = addInt x y
+
+instance Sub Int where
+  x - y = subInt x y
+
+instance Ord Int where
+  x < y = ltInt x y
+
+printLn : {a} {{Show a}} → a → IO Unit
+printLn a = putStrLn $ show a

playground/samples/aoc2023/day1/eg.txt

@@ -0,0 +1,5 @@
+1abc2
+pqr3stu8vwx
+a1b2c3d4e5f
+treb7uchet
+

playground/samples/aoc2023/day1/eg2.txt

@@ -0,0 +1,7 @@
+two1nine
+eightwothree
+abcone2threexyz
+xtwone3four
+4nineeightseven2
+zoneight234
+7pqrstsixteen

playground/samples/aoc2023/day2/eg.txt

@@ -0,0 +1,5 @@
+Game 1: 3 blue, 4 red; 1 red, 2 green, 6 blue; 2 green
+Game 2: 1 blue, 2 green; 3 green, 4 blue, 1 red; 1 green, 1 blue
+Game 3: 8 green, 6 blue, 20 red; 5 blue, 4 red, 13 green; 5 green, 1 red
+Game 4: 1 green, 3 red, 6 blue; 3 green, 6 red; 3 green, 15 blue, 14 red
+Game 5: 6 red, 1 blue, 3 green; 2 blue, 1 red, 2 green

playground/src/worker.ts

@@ -117,22 +117,27 @@ process.stdout.write = (s) => {
   stdout += s
 };
 // hack for now
-const preload = ["Lib.newt"]
+const preload = [
+  "Lib.newt",
+  "Prelude.newt",
+  "aoc2023/day1/eg.txt",
+  "aoc2023/day1/eg2.txt",
+]
 onmessage = async function (e) {
   for (let fn of preload) {
 
-    if (!files['src/'+fn]) {
+    if (!files[fn]) {
       console.log('preload', fn)
       let res = await fetch(fn)
       let text = await res.text()
-      files['src/'+fn] = text
+      files[fn] = text
     }
   }
   let {src} = e.data
   let module = 'Main'
   let m = src.match(/module (\w+)/)
   if (m) module = m[1]
-  let fn = `src/${module}.newt`
+  let fn = `${module}.newt`
   process.argv = ["", "", fn, "-o", "out.js"];
   console.log("args", process.argv);
   files[fn] = src;