Get AOC day1 working

- Fixes to codegen for literal cases.
- Fix parsing of string literals
- Work around stack overflow in Prettier

aoc2023/Day1.newt

@@ -0,0 +1,94 @@
+module Day1
+
+import Lib
+ptype Int
+
+-- TODO fix import of fixity declarations
+infixr 4 _::_
+infixl 3 _<_
+infixl 4 _-_
+infixl 4 _+_
+infixl 5 _*_
+infixl 5 _/_
+infixr 0 _$_
+-- Code
+
+
+infixl 7 _._
+_._ : {A B C : U} -> (B -> C) -> (A -> B) -> A -> C
+(f . g) x = f ( g x)
+
+
+digits1 : List Char -> List Int
+digits1 Nil = Nil
+digits1 (c :: cs) = let x = ord c in
+  case x < 58 of
+    True => case 48 < x of
+      True => x - 48 :: digits1 cs
+      False => digits1 cs
+    False => digits1 cs
+
+-- This happens with Char and not Nat, but why is Char working at all?
+-- I suspect it will fix if PatLit is implemented correctly
+
+tail : {a : U} -> List a -> List a
+tail Nil = Nil
+tail (x :: xs) = xs
+
+-- TODO I used @ patterns in Lean
+digits2 : List Char -> List Int
+digits2 xs = case xs of
+    ('o' :: 'n' :: 'e' :: _) => 1 :: digits2 (tail xs)
+    ('t' :: 'w' :: 'o' :: _) => 2 :: digits2 (tail xs)
+    ('t' :: 'h' :: 'r' :: 'e' :: 'e' :: _) => 3 :: digits2 (tail xs)
+    ('f' :: 'o' :: 'u' :: 'r' :: _) => 4 :: digits2 (tail xs)
+    ('f' :: 'i' :: 'v' :: 'e' :: _) => 5 :: digits2 (tail xs)
+    ('s' :: 'i' :: 'x' :: _) => 6 :: digits2 (tail xs)
+    ('s' :: 'e' :: 'v' :: 'e' :: 'n' :: _) => 7 :: digits2 (tail xs)
+    ('e' :: 'i' :: 'g' :: 'h' :: 't' :: _) => 8 :: digits2 (tail xs)
+    ('n' :: 'i' :: 'n' :: 'e' :: _) => 9 :: digits2 (tail xs)
+    (c :: cs) => let x = ord c in
+        case x < 58 of
+          True => case 48 < x of
+            True => x - 48 :: digits2 cs
+            False => digits2 cs
+          False => digits2 cs
+    Nil => Nil
+
+
+combine : List Int -> Int
+combine Nil = 0
+combine (x :: Nil) = x * 10 + x
+combine (x :: y :: Nil) = x * 10 + y
+combine (x :: y :: xs) = combine (x :: xs)
+
+part1 : String -> (String -> List Int) -> Int
+part1 text digits =
+  let lines = split (trim text) "\n" in
+  let nums = map combine $ map digits lines in
+  foldl _+_ 0 nums
+
+infixl 3 _>>_
+
+_>>_ : {A B : U} -> A -> B -> B
+a >> b = b
+
+
+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 ""
+
+
+-- 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" >>
+  runFile "aoc2023/day1/input.txt"
+

aoc2023/Lib.newt

@@ -0,0 +1,133 @@
+module Lib
+
+-- Prelude
+
+data Bool : U where
+  True : Bool
+  False : Bool
+
+data Nat : U where
+  Z : Nat
+  S : Nat -> Nat
+
+data Maybe : U -> U where
+  Just : {a : U} -> a -> Maybe a
+  Nothing : {a : U} -> Maybe a
+
+data Either : U -> U -> U where
+  Left : {a b : U} -> a -> Either a b
+  Right : {a b : U} -> b -> Either a b
+
+
+infixr 4 _::_
+data List : U -> U where
+  Nil : {a : U} -> List a
+  _::_ : {a : U} -> a -> List a -> List a
+
+Cons : {a : U} -> a -> List a -> List a
+Cons x xs = x :: xs
+
+-- TODO where clauses
+reverse' : {A : U} -> List A -> List A -> List A
+reverse' Nil acc = acc
+reverse' (x :: xs) acc = reverse' xs (x :: acc)
+
+reverse : {A : U} -> List A -> List A
+reverse xs = reverse' xs Nil
+
+
+infixr 2 _,_
+
+data Pair : U -> U -> U where
+  _,_ : {a b : U} -> a -> b -> Pair a b
+
+infixr 0 _$_
+
+_$_ : {a b : U} -> (a -> b) -> a -> b
+f $ a = f a
+
+-- JS Bridge
+
+ptype Dummy
+
+
+ptype World
+data IO : U -> U where
+  MkIO : {a : U} -> (World -> Pair World a) -> IO a
+
+-- TODO unified Number for now
+ptype Int
+ptype String
+
+ptype Char
+
+ptype Array : U -> U
+
+pfunc arrayToList : {a : U} -> Array a -> List a := "
+(a, arr) => {
+  let rval = Nil(a)
+  for (let i = arr.length - 1; i >= 0; i--) {
+    rval = Cons(a, arr[i], rval)
+  }
+  return rval
+}
+"
+
+pfunc getArgs : List String := "arrayToList(String, process.argv)"
+-- Maybe integrate promises?
+
+
+pfunc ord : Char -> Int := "(c) => c.charCodeAt(0)"
+
+pfunc _<_ : Int -> Int -> Bool := "(x,y) => (x < y) ? True : False"
+pfunc _+_ : Int -> Int -> Int := "(x,y) => x + y"
+pfunc _-_ : Int -> Int -> Int := "(x,y) => x - y"
+pfunc _*_ : Int -> Int -> Int := "(x,y) => x * y"
+pfunc _/_ : Int -> Int -> Int := "(x,y) => x / y"
+infixl 3 _<_
+infixl 4 _-_
+infixl 4 _+_
+infixl 5 _*_
+infixl 5 _/_
+
+
+-- Ideally we'd have newt write the arrows for us to keep things correct
+-- We'd still have difficulty with callbacks...
+pfunc fs : Dummy := "require('fs')"
+pfunc readFile : (fn : String) -> String := "(fn) => fs.readFileSync(fn, 'utf8')"
+pfunc log : {a : U} -> a -> Dummy := "(a, obj) => console.log(obj)"
+
+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 _++_ : String -> String -> String := "(a,b) => a + b"
+
+
+pfunc trace : {a : U} -> String -> a -> a := "(_, lab, a) => {
+  console.log(lab,a)
+  return a
+}"
+
+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
+}"
+
+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
+
+map : {A B : U} -> (A -> B) -> List A -> List B
+map f Nil = Nil
+map f (x :: xs) = f x :: map f xs

aoc2023/README.md

@@ -0,0 +1,2 @@
+
+Attempts to port AOC2023 solutions from Lean4 to see how usable newt is.

aoc2023/day1/eg.txt

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

aoc2023/day1/eg2.txt

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