merge aoc lib and prelude
This commit is contained in:
3
TODO.md
3
TODO.md
@@ -1,6 +1,9 @@
|
|||||||
|
|
||||||
## TODO
|
## 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)
|
- [ ] accepting DCon for another type (skipping case, but should be an error)
|
||||||
- [ ] don't allow (or dot) duplicate names on LHS
|
- [ ] don't allow (or dot) duplicate names on LHS
|
||||||
- [ ] remove metas from context, M has TopContext
|
- [ ] remove metas from context, M has TopContext
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
module Day1
|
module Day1
|
||||||
|
|
||||||
import Lib
|
import Prelude
|
||||||
|
|
||||||
digits1 : List Char -> List Int
|
digits1 : List Char -> List Int
|
||||||
digits1 Nil = Nil
|
digits1 Nil = Nil
|
||||||
@@ -48,27 +48,22 @@ part1 text digits =
|
|||||||
let nums = map combine $ map digits lines in
|
let nums = map combine $ map digits lines in
|
||||||
foldl _+_ 0 nums
|
foldl _+_ 0 nums
|
||||||
|
|
||||||
-- Hack from before I had support for typeclasses
|
#check digits1 ∘ unpack : String -> List Int
|
||||||
infixl 1 _>>_
|
|
||||||
_>>_ : {A B : U} -> A -> B -> B
|
|
||||||
a >> b = b
|
|
||||||
|
|
||||||
|
runFile : String -> IO Unit
|
||||||
runFile : String -> Dummy
|
runFile fn = do
|
||||||
runFile fn =
|
text <- readFile fn
|
||||||
let text = readFile fn in
|
putStrLn fn
|
||||||
log fn >>
|
putStrLn "part1"
|
||||||
log "part1" >>
|
putStrLn $ show (part1 text (digits1 ∘ unpack))
|
||||||
log (part1 text (digits1 ∘ unpack)) >>
|
putStrLn "part2"
|
||||||
log "part2" >>
|
putStrLn $ show (part1 text (digits2 ∘ unpack))
|
||||||
log (part1 text (digits2 ∘ unpack)) >>
|
putStrLn ""
|
||||||
log ""
|
|
||||||
|
|
||||||
|
|
||||||
-- Argument is a hack to keep it from running at startup. Need to add IO
|
-- Argument is a hack to keep it from running at startup. Need to add IO
|
||||||
main : Int -> Dummy
|
main : IO Unit
|
||||||
main _ =
|
main = do
|
||||||
runFile "aoc2023/day1/eg.txt" >>
|
runFile "aoc2023/day1/eg.txt"
|
||||||
runFile "aoc2023/day1/eg2.txt" >>
|
runFile "aoc2023/day1/eg2.txt"
|
||||||
runFile "aoc2023/day1/input.txt"
|
runFile "aoc2023/day1/input.txt"
|
||||||
|
|
||||||
|
|||||||
@@ -1,9 +1,9 @@
|
|||||||
module Day2
|
module Day2
|
||||||
|
|
||||||
import Lib
|
import Prelude
|
||||||
|
|
||||||
Draw : U
|
Draw : U
|
||||||
Draw = Pair Int (Pair Int Int)
|
Draw = Int × Int × Int
|
||||||
|
|
||||||
data Game : U where
|
data Game : U where
|
||||||
MkGame : Int -> List Draw -> Game
|
MkGame : Int -> List Draw -> Game
|
||||||
@@ -68,11 +68,6 @@ parseGame line =
|
|||||||
_ => Left "No Game"
|
_ => Left "No Game"
|
||||||
_ => Left $ "No colon in " ++ line
|
_ => Left $ "No colon in " ++ line
|
||||||
|
|
||||||
infixl 1 _>>_
|
|
||||||
|
|
||||||
_>>_ : {A B : U} -> A -> B -> B
|
|
||||||
a >> b = b
|
|
||||||
|
|
||||||
part1 : List Game -> Int
|
part1 : List Game -> Int
|
||||||
part1 Nil = 0
|
part1 Nil = 0
|
||||||
part1 (MkGame n parts :: rest) =
|
part1 (MkGame n parts :: rest) =
|
||||||
@@ -87,18 +82,18 @@ part2 (MkGame n parts :: rest) =
|
|||||||
case foldl maxd (0,0,0) parts of
|
case foldl maxd (0,0,0) parts of
|
||||||
(a,b,c) => a * b * c + part2 rest
|
(a,b,c) => a * b * c + part2 rest
|
||||||
|
|
||||||
run : String -> Dummy
|
run : String -> IO Unit
|
||||||
run fn =
|
run fn = do
|
||||||
let text = readFile fn in
|
text <- readFile fn
|
||||||
case mapM parseGame (split (trim text) "\n") of
|
case mapM parseGame (split (trim text) "\n") of
|
||||||
Left err => log $ "fail " ++ err
|
Left err => putStrLn $ "fail " ++ err
|
||||||
Right games =>
|
Right games => do
|
||||||
log "part1" >>
|
putStrLn "part1"
|
||||||
log (part1 games) >>
|
printLn (part1 games)
|
||||||
log "part2" >>
|
putStrLn "part2"
|
||||||
log (part2 games)
|
printLn (part2 games)
|
||||||
|
|
||||||
main : Dummy -> Dummy
|
main : IO Unit
|
||||||
main _ =
|
main = do
|
||||||
run "aoc2023/day2/eg.txt" >>
|
run "aoc2023/day2/eg.txt"
|
||||||
run "aoc2023/day2/input.txt"
|
run "aoc2023/day2/input.txt"
|
||||||
|
|||||||
@@ -6,5 +6,5 @@ esbuild src/worker.ts > public/worker.js
|
|||||||
echo copy newt
|
echo copy newt
|
||||||
cp ../build/exec/newt.js public
|
cp ../build/exec/newt.js public
|
||||||
# cat ../build/exec/newt.js |grep -v '^#'>> public/worker.js
|
# 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
|
# esbuild --minify ../build/exec/newt.min.js > public/newt.js
|
||||||
|
|||||||
@@ -1,6 +1,7 @@
|
|||||||
|
-- Doesn't run in playground because it's using the node `fs` module
|
||||||
module Day1
|
module Day1
|
||||||
|
|
||||||
import Lib
|
import Prelude
|
||||||
|
|
||||||
digits1 : List Char -> List Int
|
digits1 : List Char -> List Int
|
||||||
digits1 Nil = Nil
|
digits1 Nil = Nil
|
||||||
@@ -48,27 +49,22 @@ part1 text digits =
|
|||||||
let nums = map combine $ map digits lines in
|
let nums = map combine $ map digits lines in
|
||||||
foldl _+_ 0 nums
|
foldl _+_ 0 nums
|
||||||
|
|
||||||
-- Hack from before I had support for typeclasses
|
#check digits1 ∘ unpack : String -> List Int
|
||||||
infixl 1 _>>_
|
|
||||||
_>>_ : {A B : U} -> A -> B -> B
|
|
||||||
a >> b = b
|
|
||||||
|
|
||||||
|
runFile : String -> IO Unit
|
||||||
runFile : String -> Dummy
|
runFile fn = do
|
||||||
runFile fn =
|
text <- readFile fn
|
||||||
let text = readFile fn in
|
putStrLn fn
|
||||||
log fn >>
|
putStrLn "part1"
|
||||||
log "part1" >>
|
putStrLn $ show (part1 text (digits1 ∘ unpack))
|
||||||
log (part1 text (digits1 ∘ unpack)) >>
|
putStrLn "part2"
|
||||||
log "part2" >>
|
putStrLn $ show (part1 text (digits2 ∘ unpack))
|
||||||
log (part1 text (digits2 ∘ unpack)) >>
|
putStrLn ""
|
||||||
log ""
|
|
||||||
|
|
||||||
|
|
||||||
-- Argument is a hack to keep it from running at startup. Need to add IO
|
-- Argument is a hack to keep it from running at startup. Need to add IO
|
||||||
main : Int -> Dummy
|
main : IO Unit
|
||||||
main _ =
|
main = do
|
||||||
runFile "aoc2023/day1/eg.txt" >>
|
runFile "aoc2023/day1/eg.txt"
|
||||||
runFile "aoc2023/day1/eg2.txt" >>
|
runFile "aoc2023/day1/eg2.txt"
|
||||||
runFile "aoc2023/day1/input.txt"
|
runFile "aoc2023/day1/input.txt"
|
||||||
|
|
||||||
|
|||||||
@@ -1,9 +1,9 @@
|
|||||||
module Day2
|
module Day2
|
||||||
|
|
||||||
import Lib
|
import Prelude
|
||||||
|
|
||||||
Draw : U
|
Draw : U
|
||||||
Draw = Pair Int (Pair Int Int)
|
Draw = Int × Int × Int
|
||||||
|
|
||||||
data Game : U where
|
data Game : U where
|
||||||
MkGame : Int -> List Draw -> Game
|
MkGame : Int -> List Draw -> Game
|
||||||
@@ -68,11 +68,6 @@ parseGame line =
|
|||||||
_ => Left "No Game"
|
_ => Left "No Game"
|
||||||
_ => Left $ "No colon in " ++ line
|
_ => Left $ "No colon in " ++ line
|
||||||
|
|
||||||
infixl 1 _>>_
|
|
||||||
|
|
||||||
_>>_ : {A B : U} -> A -> B -> B
|
|
||||||
a >> b = b
|
|
||||||
|
|
||||||
part1 : List Game -> Int
|
part1 : List Game -> Int
|
||||||
part1 Nil = 0
|
part1 Nil = 0
|
||||||
part1 (MkGame n parts :: rest) =
|
part1 (MkGame n parts :: rest) =
|
||||||
@@ -87,18 +82,18 @@ part2 (MkGame n parts :: rest) =
|
|||||||
case foldl maxd (0,0,0) parts of
|
case foldl maxd (0,0,0) parts of
|
||||||
(a,b,c) => a * b * c + part2 rest
|
(a,b,c) => a * b * c + part2 rest
|
||||||
|
|
||||||
run : String -> Dummy
|
run : String -> IO Unit
|
||||||
run fn =
|
run fn = do
|
||||||
let text = readFile fn in
|
text <- readFile fn
|
||||||
case mapM parseGame (split (trim text) "\n") of
|
case mapM parseGame (split (trim text) "\n") of
|
||||||
Left err => log $ "fail " ++ err
|
Left err => putStrLn $ "fail " ++ err
|
||||||
Right games =>
|
Right games => do
|
||||||
log "part1" >>
|
putStrLn "part1"
|
||||||
log (part1 games) >>
|
printLn (part1 games)
|
||||||
log "part2" >>
|
putStrLn "part2"
|
||||||
log (part2 games)
|
printLn (part2 games)
|
||||||
|
|
||||||
main : Dummy -> Dummy
|
main : IO Unit
|
||||||
main _ =
|
main = do
|
||||||
run "aoc2023/day2/eg.txt" >>
|
run "aoc2023/day2/eg.txt"
|
||||||
run "aoc2023/day2/input.txt"
|
run "aoc2023/day2/input.txt"
|
||||||
|
|||||||
@@ -1,47 +1,331 @@
|
|||||||
module Prelude
|
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
|
data Nat : U where
|
||||||
Z : Nat
|
Z : Nat
|
||||||
S : Nat -> 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
|
data Maybe : U -> U where
|
||||||
Just : {a : U} -> a -> Maybe a
|
Just : {a : U} -> a -> Maybe a
|
||||||
Nothing : {a : U} -> 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
|
data Either : U -> U -> U where
|
||||||
Left : {a b : U} -> a -> Either a b
|
Left : {a b : U} -> a -> Either a b
|
||||||
Right : {a b : U} -> b -> 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
|
-- TODO this is special cased in some languages, maybe for easier
|
||||||
-- inference? Figure out why.
|
-- inference? Figure out why.
|
||||||
|
-- Currently very noisy in generated code (if nothing else, optimize it out?)
|
||||||
infixr 0 _$_
|
infixr 0 _$_
|
||||||
|
|
||||||
-- Currently very noisy in generated code
|
|
||||||
_$_ : {a b : U} -> (a -> b) -> a -> b
|
_$_ : {a b : U} -> (a -> b) -> a -> b
|
||||||
f $ a = f a
|
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
|
-- Monad
|
||||||
|
|
||||||
-- TODO stack with Applicative, etc?
|
class Monad (m : U → U) where
|
||||||
|
bind : {a b} → m a → (a → m b) → m b
|
||||||
data Monad : (U -> U) -> U where
|
pure : {a} → a → m a
|
||||||
MkMonad : { M : U -> U } ->
|
|
||||||
(bind : {A B : U} -> (M A) -> (A -> M B) -> M B) ->
|
|
||||||
(pure : {A : U} -> A -> M A) ->
|
|
||||||
Monad M
|
|
||||||
|
|
||||||
infixl 1 _>>=_ _>>_
|
infixl 1 _>>=_ _>>_
|
||||||
_>>=_ : {a b : U} -> {m : U -> U} -> {{x : Monad m}} -> (m a) -> (a -> m b) -> m b
|
_>>=_ : {m} {{Monad m}} {a b} -> (m a) -> (a -> m b) -> m b
|
||||||
_>>=_ {a} {b} {m} {{MkMonad bind' _}} ma amb = bind' {a} {b} ma amb
|
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
|
ma >> mb = mb
|
||||||
|
|
||||||
pure : {a : U} {m : U -> U} {{_ : Monad m}} -> a -> m a
|
-- Equality
|
||||||
pure {_} {_} {{MkMonad _ pure'}} a = pure' a
|
|
||||||
|
|
||||||
-- 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
5
playground/samples/aoc2023/day1/eg.txt
Normal file
@@ -0,0 +1,5 @@
|
|||||||
|
1abc2
|
||||||
|
pqr3stu8vwx
|
||||||
|
a1b2c3d4e5f
|
||||||
|
treb7uchet
|
||||||
|
|
||||||
7
playground/samples/aoc2023/day1/eg2.txt
Normal file
7
playground/samples/aoc2023/day1/eg2.txt
Normal file
@@ -0,0 +1,7 @@
|
|||||||
|
two1nine
|
||||||
|
eightwothree
|
||||||
|
abcone2threexyz
|
||||||
|
xtwone3four
|
||||||
|
4nineeightseven2
|
||||||
|
zoneight234
|
||||||
|
7pqrstsixteen
|
||||||
5
playground/samples/aoc2023/day2/eg.txt
Normal file
5
playground/samples/aoc2023/day2/eg.txt
Normal 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
|
||||||
@@ -117,22 +117,27 @@ process.stdout.write = (s) => {
|
|||||||
stdout += s
|
stdout += s
|
||||||
};
|
};
|
||||||
// hack for now
|
// 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) {
|
onmessage = async function (e) {
|
||||||
for (let fn of preload) {
|
for (let fn of preload) {
|
||||||
|
|
||||||
if (!files['src/'+fn]) {
|
if (!files[fn]) {
|
||||||
console.log('preload', fn)
|
console.log('preload', fn)
|
||||||
let res = await fetch(fn)
|
let res = await fetch(fn)
|
||||||
let text = await res.text()
|
let text = await res.text()
|
||||||
files['src/'+fn] = text
|
files[fn] = text
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
let {src} = e.data
|
let {src} = e.data
|
||||||
let module = 'Main'
|
let module = 'Main'
|
||||||
let m = src.match(/module (\w+)/)
|
let m = src.match(/module (\w+)/)
|
||||||
if (m) module = m[1]
|
if (m) module = m[1]
|
||||||
let fn = `src/${module}.newt`
|
let fn = `${module}.newt`
|
||||||
process.argv = ["", "", fn, "-o", "out.js"];
|
process.argv = ["", "", fn, "-o", "out.js"];
|
||||||
console.log("args", process.argv);
|
console.log("args", process.argv);
|
||||||
files[fn] = src;
|
files[fn] = src;
|
||||||
|
|||||||
@@ -118,6 +118,14 @@ instance Functor Maybe where
|
|||||||
map f Nothing = Nothing
|
map f Nothing = Nothing
|
||||||
map f (Just a) = Just (f a)
|
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
|
-- TODO this probably should depend on / entail Functor
|
||||||
infixl 3 _<*>_
|
infixl 3 _<*>_
|
||||||
class Applicative (f : U → U) where
|
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) => {
|
pfunc arrayToList : {a} → Array a → List a := "(a,arr) => {
|
||||||
let rval = Nil(a)
|
let rval = Nil(a)
|
||||||
for (let i = arr.length - 1;i >= 0; i--) {
|
for (let i = arr.length - 1;i >= 0; i--) {
|
||||||
rval = Cons(a, arr[i], rval)
|
rval = _$3A$3A_(a, arr[i], rval)
|
||||||
}
|
}
|
||||||
return rval
|
return rval
|
||||||
}"
|
}"
|
||||||
|
|
||||||
|
|
||||||
|
pfunc getArgs : List String := "arrayToList(String, process.argv)"
|
||||||
|
|
||||||
-- for now I'll run this in JS
|
-- 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
|
-- TODO represent Nat as number at runtime
|
||||||
pfunc natToInt : Nat -> Int := "(n) => {
|
pfunc natToInt : Nat -> Int := "(n) => {
|
||||||
@@ -223,6 +249,7 @@ pfunc natToInt : Nat -> Int := "(n) => {
|
|||||||
}
|
}
|
||||||
return rval
|
return rval
|
||||||
}"
|
}"
|
||||||
|
|
||||||
pfunc fastConcat : List String → String := "(xs) => listToArray(undefined, xs).join('')"
|
pfunc fastConcat : List String → String := "(xs) => listToArray(undefined, xs).join('')"
|
||||||
pfunc replicate : Nat -> Char → String := "(n,c) => c.repeat(natToInt(n))"
|
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)
|
return MkIORes(Unit,MkUnit,w)
|
||||||
}"
|
}"
|
||||||
|
|
||||||
|
pfunc showInt : Int -> String := "(i) => String(i)"
|
||||||
|
|
||||||
class Show a where
|
class Show a where
|
||||||
show : a → String
|
show : a → String
|
||||||
|
|
||||||
instance Show String where
|
instance Show String where
|
||||||
show a = a
|
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
|
||||||
|
|||||||
@@ -168,7 +168,7 @@ jsString str = text (show str)
|
|||||||
|
|
||||||
keywords : List String
|
keywords : List String
|
||||||
keywords = [
|
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"
|
"function", "void", "undefined", "null", "await", "async", "return", "const"
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|||||||
@@ -58,7 +58,7 @@ processModule base stk name = do
|
|||||||
top <- get
|
top <- get
|
||||||
let False := elem name top.loaded | _ => pure ""
|
let False := elem name top.loaded | _ => pure ""
|
||||||
modify { loaded $= (name::) }
|
modify { loaded $= (name::) }
|
||||||
let fn = base ++ "/" ++ name ++ ".newt"
|
let fn = if base == "" then name ++ ".newt" else base ++ "/" ++ name ++ ".newt"
|
||||||
Right src <- readFile $ fn
|
Right src <- readFile $ fn
|
||||||
| Left err => fail (show err)
|
| Left err => fail (show err)
|
||||||
let Right toks = tokenise src
|
let Right toks = tokenise src
|
||||||
|
|||||||
Reference in New Issue
Block a user