dunham/newt
1
0
Fork 0
Code Issues Pull Requests Actions 1 Packages Projects Releases Wiki Activity

merge aoc lib and prelude

Browse Source
This commit is contained in:
Steve Dunham
2024-11-23 15:08:49 -08:00
parent dda0bf6fb9
commit 5cbe594993
14 changed files with 472 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
TODO.md
View File

@@ -1,6 +1,9 @@
## TODO
- [ ] 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
- [ ] accepting DCon for another type (skipping case, but should be an error)
- [ ] don't allow (or dot) duplicate names on LHS
- [ ] remove metas from context, M has TopContext

35
aoc2023/Day1.newt
View File

@@ -1,6 +1,6 @@
module Day1
import Lib
import Prelude
digits1 : List Char -> List Int
digits1 Nil = Nil
@@ -48,27 +48,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"

33
aoc2023/Day2.newt
View File

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

2
playground/build
View File

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

36
playground/samples/Day1.newt
View File

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

33
playground/samples/Day2.newt
View File

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

316
playground/samples/Prelude.newt
View File

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

5
playground/samples/aoc2023/day1/eg.txt Normal file
View File

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

7
playground/samples/aoc2023/day1/eg2.txt Normal file
View File

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

5
playground/samples/aoc2023/day2/eg.txt Normal file
View File

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

13
playground/src/worker.ts
View File

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

83
port/Prelude.newt
View File

@@ -118,6 +118,14 @@ 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
@@ -206,13 +214,31 @@ 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 = Cons(a, arr[i], rval)
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 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) => {
@@ -223,6 +249,7 @@ pfunc natToInt : Nat -> Int := "(n) => {
}
return rval
}"
pfunc fastConcat : List String → String := "(xs) => listToArray(undefined, xs).join('')"
pfunc replicate : Nat -> Char → String := "(n,c) => c.repeat(natToInt(n))"
@@ -245,8 +272,60 @@ pfunc putStrLn : String -> IO Unit := "(s) => (w) => {
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

2
src/Lib/Compile.idr
View File

@@ -168,7 +168,7 @@ jsString str = text (show str)
keywords : List String
keywords = [
"var", "true", "false", "let", "case", "switch", "if", "then", "else",
"var", "true", "false", "let", "case", "switch", "if", "then", "else", "String",
"function", "void", "undefined", "null", "await", "async", "return", "const"
]

2
src/Main.idr
View File

@@ -58,7 +58,7 @@ processModule base stk name = do
top <- get
let False := elem name top.loaded | _ => pure ""
modify { loaded $= (name::) }
let fn = base ++ "/" ++ name ++ ".newt"
let fn = if base == "" then name ++ ".newt" else base ++ "/" ++ name ++ ".newt"
Right src <- readFile $ fn
| Left err => fail (show err)
let Right toks = tokenise src