├── .editorconfig ├── .gitattributes ├── .github └── workflows │ └── publish.yml ├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── TODO.md ├── aoc2023 ├── Aoc.newt ├── Day1.newt ├── Day2.newt ├── Day3.newt ├── Day4.newt ├── Day5.newt ├── Day6.newt ├── Lib.newt ├── Node.newt ├── Prelude.newt ├── README.md ├── day1 │ ├── eg.txt │ ├── eg2.txt │ └── input.txt ├── day2 │ └── eg.txt ├── day3 │ └── eg.txt ├── day4 │ └── eg.txt ├── day5 │ └── eg.txt └── day6 │ └── eg.txt ├── aoc2024 ├── Day1.newt ├── Day1.newt.golden ├── Day10.newt ├── Day10.newt.golden ├── Day11.newt ├── Day11.newt.golden ├── Day11b.newt ├── Day11b.newt.golden ├── Day12.newt ├── Day12.newt.golden ├── Day13.newt ├── Day13.newt.golden ├── Day14.newt ├── Day14.newt.golden ├── Day15.newt ├── Day15.newt.golden ├── Day16.newt ├── Day16.newt.golden ├── Day17.newt ├── Day17.newt.golden ├── Day18.newt ├── Day18.newt.golden ├── Day19.newt ├── Day19.newt.golden ├── Day2.newt ├── Day2.newt.golden ├── Day20.newt ├── Day20.newt.golden ├── Day21.newt ├── Day21.newt.golden ├── Day21monad.newt ├── Day21monad.newt.golden ├── Day22.newt ├── Day22.newt.golden ├── Day22b.newt ├── Day22b.newt.golden ├── Day23.newt ├── Day23.newt.golden ├── Day24.newt ├── Day24.newt.golden ├── Day25.newt ├── Day25.newt.golden ├── Day3.newt ├── Day3.newt.golden ├── Day4.newt ├── Day4.newt.golden ├── Day5.newt ├── Day5.newt.golden ├── Day6.newt ├── Day6.newt.golden ├── Day7.newt ├── Day7.newt.golden ├── Day8.newt ├── Day8.newt.golden ├── Day9.newt ├── Day9.newt.golden ├── DayXX.newt ├── Node.newt ├── Parser.newt ├── Prelude.newt ├── SortedMap.newt ├── day1 │ └── eg.txt ├── day10 │ ├── eg.txt │ ├── eg2.txt │ ├── eg3.txt │ ├── eg4.txt │ └── eg5.txt ├── day11 │ └── eg.txt ├── day12 │ ├── eg.txt │ ├── eg2.txt │ └── eg3.txt ├── day13 │ └── eg.txt ├── day14 │ └── eg.txt ├── day15 │ └── eg.txt ├── day16 │ ├── eg.txt │ └── eg2.txt ├── day17 │ ├── eg.txt │ └── eg2.txt ├── day18 │ └── eg.txt ├── day19 │ └── eg.txt ├── day2 │ └── eg.txt ├── day20 │ └── eg.txt ├── day21 │ └── eg.txt ├── day22 │ ├── eg.txt │ └── eg2.txt ├── day23 │ └── eg.txt ├── day24 │ ├── eg.txt │ ├── eg2.txt │ └── eg3.txt ├── day25 │ └── eg.txt ├── day3 │ └── eg.txt ├── day4 │ └── eg.txt ├── day5 │ └── eg.txt ├── day6 │ └── eg.txt ├── day7 │ └── eg.txt ├── day8 │ └── eg.txt ├── day9 │ └── eg.txt └── mkday ├── bootstrap └── newt.js ├── misc └── casetree.ts ├── newt-vscode ├── .eslintrc.json ├── .gitignore ├── .vscodeignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── esbuild.js ├── language-configuration.json ├── package-lock.json ├── package.json ├── src │ ├── abbrev.ts │ └── extension.ts ├── syntaxes │ ├── inject.json │ └── newt.tmLanguage.json └── tsconfig.json ├── newt.ipkg ├── newt ├── Debug.newt ├── Equality.newt ├── Equality1.newt ├── Fix.newt ├── Foo.newt ├── JSLib.newt ├── Order.newt ├── Prelude.newt ├── SortedMap.newt ├── TypeClass.newt └── tutorial.newt ├── orig ├── Lib │ ├── Common.idr │ ├── Compile.idr │ ├── CompileExp.idr │ ├── Elab.idr │ ├── Erasure.idr │ ├── Eval.idr │ ├── Parser.idr │ ├── Parser │ │ └── Impl.idr │ ├── Prettier.idr │ ├── ProcessDecl.idr │ ├── Syntax.idr │ ├── Token.idr │ ├── Tokenizer.idr │ ├── TopContext.idr │ ├── Types.idr │ └── Util.idr └── Main.idr ├── pack.toml ├── papers ├── elaborating-dependent-copattern-matching.pdf ├── prettier.pdf └── unifiers-as-equivalences.pdf ├── playground ├── .gitignore ├── README.md ├── TODO.md ├── build ├── index.html ├── package-lock.json ├── package.json ├── samples │ ├── Combinatory.newt │ ├── DSL.newt │ ├── Hello.newt │ ├── Lists.newt │ ├── Prelude.newt │ ├── Reasoning.newt │ ├── Tour.newt │ ├── Tree.newt │ ├── TypeClass.newt │ ├── aoc2024 │ │ ├── Aoc.newt │ │ ├── Day1.newt │ │ ├── Day10.newt │ │ ├── Day11.newt │ │ ├── Day11b.newt │ │ ├── Day12.newt │ │ ├── Day13.newt │ │ ├── Day14.newt │ │ ├── Day15.newt │ │ ├── Day16.newt │ │ ├── Day17.newt │ │ ├── Day18.newt │ │ ├── Day19.newt │ │ ├── Day2.newt │ │ ├── Day20.newt │ │ ├── Day21.newt │ │ ├── Day22.newt │ │ ├── Day23.newt │ │ ├── Day24.newt │ │ ├── Day25.newt │ │ ├── Day3.newt │ │ ├── Day4.newt │ │ ├── Day5.newt │ │ ├── Day6.newt │ │ ├── Day7.newt │ │ ├── Day8.newt │ │ ├── Day9.newt │ │ ├── DayXX.newt │ │ ├── Node.newt │ │ ├── Parser.newt │ │ ├── Prelude.newt │ │ ├── SortedMap.newt │ │ ├── day1 │ │ ├── day10 │ │ ├── day11 │ │ ├── day12 │ │ ├── day13 │ │ ├── day14 │ │ ├── day15 │ │ ├── day16 │ │ ├── day17 │ │ ├── day18 │ │ ├── day19 │ │ ├── day2 │ │ ├── day20 │ │ ├── day21 │ │ ├── day22 │ │ ├── day23 │ │ ├── day24 │ │ ├── day25 │ │ ├── day3 │ │ ├── day4 │ │ ├── day5 │ │ ├── day6 │ │ ├── day7 │ │ ├── day8 │ │ └── day9 │ └── newt ├── src │ ├── abbrev.ts │ ├── emul.ts │ ├── frame.ts │ ├── global.d.ts │ ├── main.ts │ ├── monarch.ts │ ├── preload.ts │ ├── types.ts │ ├── worker.ts │ └── zipfile.ts ├── static │ ├── frame.html │ └── worker.html ├── style.css └── tsconfig.json ├── scripts ├── aoc ├── orig_aoc ├── orig_test ├── stats.py ├── test └── translate.sh ├── serializer.ts ├── src ├── Data │ ├── Graph.newt │ ├── IORef.newt │ ├── Int.newt │ ├── List1.newt │ ├── SnocList.newt │ ├── SortedMap.newt │ ├── String.newt │ └── TestGraph.newt ├── Lib │ ├── Common.newt │ ├── Compile.newt │ ├── CompileExp.newt │ ├── Elab.newt │ ├── Erasure.newt │ ├── Eval.newt │ ├── LiftWhere.newt │ ├── Parser.newt │ ├── Parser │ │ └── Impl.newt │ ├── Prettier.newt │ ├── ProcessDecl.newt │ ├── Ref2.newt │ ├── Syntax.newt │ ├── TCO.newt │ ├── Token.newt │ ├── Tokenizer.newt │ ├── TopContext.newt │ ├── Types.newt │ └── Util.newt ├── Main.newt ├── Monad │ └── State.newt ├── Node.newt ├── Prelude.newt ├── Serialize.newt └── Test │ └── Parser.newt ├── test ├── src │ └── Main.idr └── test.ipkg ├── tests ├── CaseEval.newt ├── Concat.newt ├── DupImport.newt ├── Equality.newt ├── ForwardRecord.newt ├── ForwardRecord.newt.golden ├── InferenceIssue.newt ├── Let.newt ├── Neighbors.newt ├── Oper.newt ├── Prelude.newt ├── RUTest.newt ├── RUTest.newt.golden ├── SortedMap.newt ├── TestCase.newt ├── TestCase2.newt ├── TestCase3.newt ├── TestCase4.newt ├── TestCase5.newt ├── TestImport.newt ├── TestMap.newt ├── TestMap.newt.golden ├── TestPrim.newt ├── Tree.newt ├── TypeClass.newt ├── Zoo1.newt ├── Zoo2eg.newt ├── Zoo3eg.newt ├── Zoo4eg.newt └── aside │ └── Test1.newt └── vim ├── compiler └── newt.vim ├── ftdetect └── newt.vim ├── ftplugin └── newt.vim ├── indent └── newt.vim └── syntax └── newt.vim /.editorconfig: -------------------------------------------------------------------------------- 1 | # https://editorconfig.org/ 2 | [*] 3 | end_of_line = lf 4 | insert_final_newline = true 5 | indent_size = 2 6 | indent_style = space 7 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | *.newt linguist-language=agda 2 | -------------------------------------------------------------------------------- /.github/workflows/publish.yml: -------------------------------------------------------------------------------- 1 | name: Publish Playground 2 | concurrency: 3 | group: production 4 | cancel-in-progress: true 5 | on: 6 | push: 7 | branches: 8 | - main 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | # container: ghcr.io/stefan-hoeck/idris2-pack:latest 13 | steps: 14 | - name: checkout 15 | uses: actions/checkout@v2 16 | 17 | - name: dependencies 18 | uses: actions/setup-node@v4 19 | with: 20 | node-version: 23 21 | - name: setup 22 | run: | 23 | sudo apt-get update 24 | sudo apt-get install -y zip 25 | # pack install contrib 26 | # - name: use bun 27 | # uses: oven-sh/setup-bun@v2 28 | - name: build 29 | run: | 30 | make 31 | cd playground 32 | npm install -g esbuild vite 33 | npm install 34 | mkdir public 35 | ./build 36 | vite build --base /newt 37 | #npm run build 38 | - name: Upload playground 39 | id: deployment 40 | uses: actions/upload-pages-artifact@v3 41 | with: 42 | path: playground/dist/ 43 | deploy: 44 | needs: build 45 | permissions: 46 | pages: write 47 | id-token: write 48 | environment: 49 | name: github-pages 50 | url: ${{ steps.deployment.outputs.page_url }} 51 | runs-on: ubuntu-latest 52 | steps: 53 | - name: Deploy to GitHub Pages 54 | id: deployment 55 | uses: actions/deploy-pages@v4 56 | 57 | 58 | 59 | 60 | 61 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | build/ 2 | \#* 3 | *~ 4 | *.swp 5 | *.log 6 | *.agda 7 | *.agdai 8 | /*.js 9 | input.txt 10 | node_modules 11 | mkday.py 12 | tmp 13 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | 3 | Anyone is free to copy, modify, publish, use, compile, sell, or 4 | distribute this software, either in source code form or as a compiled 5 | binary, for any purpose, commercial or non-commercial, and by any 6 | means. 7 | 8 | In jurisdictions that recognize copyright laws, the author or authors 9 | of this software dedicate any and all copyright interest in the 10 | software to the public domain. We make this dedication for the benefit 11 | of the public at large and to the detriment of our heirs and 12 | successors. We intend this dedication to be an overt act of 13 | relinquishment in perpetuity of all present and future rights to this 14 | software under copyright law. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | For more information, please refer to 25 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | OSRCS=$(shell find orig -name "*.idr") 2 | SRCS=$(shell find src -name "*.newt") 3 | 4 | # Node shaves off 40% of the time. 5 | # RUNJS=bun run 6 | RUNJS=node 7 | 8 | .PHONY: 9 | 10 | # all: build/exec/newt build/exec/newt.js build/exec/newt.min.js newt.js 11 | all: newt.js 12 | 13 | # Original idris version 14 | 15 | build/exec/newt: ${OSRCS} 16 | idris2 --build newt.ipkg 17 | 18 | build/exec/newt.js: ${OSRCS} 19 | idris2 --cg node -o newt.js -p contrib -c orig/Main.idr 20 | 21 | build/exec/newt.min.js: ${OSRCS} 22 | idris2 --cg node -o newt.min.js -p contrib -c orig/Main.idr --directive minimal 23 | 24 | orig_aoctest: build/exec/newt 25 | scripts/orig_aoc 26 | 27 | orig_test: build/exec/newt 28 | scripts/orig_test 29 | 30 | # New version 31 | 32 | newt.js: ${SRCS} 33 | -rm build/* 34 | $(RUNJS) bootstrap/newt.js src/Main.newt -o newt.js 35 | 36 | newt2.js: newt.js 37 | -rm build/* 38 | $(RUNJS) newt.js src/Main.newt -o newt2.js 39 | 40 | newt3.js: newt2.js 41 | rm -f build/* 42 | time $(RUNJS) newt2.js src/Main.newt -o newt3.js 43 | cmp newt2.js newt3.js 44 | 45 | test: newt.js 46 | scripts/test 47 | 48 | aoctest: newt.js 49 | scripts/aoc 50 | 51 | # Misc 52 | 53 | vscode: 54 | cd newt-vscode && vsce package && code --install-extension *.vsix 55 | 56 | playground: .PHONY 57 | cd playground && ./build 58 | -------------------------------------------------------------------------------- /aoc2023/Aoc.newt: -------------------------------------------------------------------------------- 1 | module Aoc 2 | 3 | import Prelude 4 | 5 | -- `by` is the first argument for use in `map` 6 | nums' : String → String → List Int 7 | nums' by s = map stringToInt $ filter (_/=_ "") $ split (trim s) by 8 | 9 | nums : String → List Int 10 | nums s = map stringToInt $ filter (_/=_ "") $ split (trim s) " " 11 | 12 | indexOf? : ∀ a. {{Eq a}} → a → List a → Maybe Nat 13 | indexOf? {a} z xs = go Z z xs 14 | where 15 | go : Nat → a → List a → Maybe Nat 16 | go ix z Nil = Nothing 17 | go ix z (x :: xs) = 18 | if z == x then Just ix else go (S ix) z xs 19 | 20 | -- TODO move to Aoc library 21 | Point : U 22 | Point = Int × Int 23 | 24 | instance Add Point where 25 | (a,b) + (c,d) = (a + c, b + d) 26 | 27 | instance Sub Point where 28 | (a,b) - (c,d) = (a - c, b - d) 29 | 30 | 31 | 32 | -- instance Ord Point where 33 | -- (a,b) < (c,d) = a < c || a == c && b < d 34 | 35 | -- instance Eq Point where 36 | -- (a,b) == (c,d) = a == c && b == d 37 | -------------------------------------------------------------------------------- /aoc2023/Day1.newt: -------------------------------------------------------------------------------- 1 | module Day1 2 | 3 | import Prelude 4 | import Node 5 | 6 | digits1 : List Char -> List Int 7 | digits1 Nil = Nil 8 | digits1 (c :: cs) = let x = ord c in 9 | if 48 < x && x < 58 10 | then x - 48 :: digits1 cs 11 | else digits1 cs 12 | 13 | -- TODO I used @ patterns in Lean 14 | digits2 : List Char -> List Int 15 | digits2 xs = case xs of 16 | ('o' :: 'n' :: 'e' :: _) => 1 :: digits2 (tail xs) 17 | ('t' :: 'w' :: 'o' :: _) => 2 :: digits2 (tail xs) 18 | ('t' :: 'h' :: 'r' :: 'e' :: 'e' :: _) => 3 :: digits2 (tail xs) 19 | ('f' :: 'o' :: 'u' :: 'r' :: _) => 4 :: digits2 (tail xs) 20 | ('f' :: 'i' :: 'v' :: 'e' :: _) => 5 :: digits2 (tail xs) 21 | ('s' :: 'i' :: 'x' :: _) => 6 :: digits2 (tail xs) 22 | ('s' :: 'e' :: 'v' :: 'e' :: 'n' :: _) => 7 :: digits2 (tail xs) 23 | ('e' :: 'i' :: 'g' :: 'h' :: 't' :: _) => 8 :: digits2 (tail xs) 24 | ('n' :: 'i' :: 'n' :: 'e' :: _) => 9 :: digits2 (tail xs) 25 | (c :: cs) => let x = ord c in 26 | case x < 58 of 27 | True => case 48 < x of 28 | True => x - 48 :: digits2 cs 29 | False => digits2 cs 30 | False => digits2 cs 31 | Nil => Nil 32 | 33 | 34 | combine : List Int -> Int 35 | combine Nil = 0 36 | combine (x :: Nil) = x * 10 + x 37 | combine (x :: y :: Nil) = x * 10 + y 38 | combine (x :: y :: xs) = combine (x :: xs) 39 | 40 | part1 : String -> (String -> List Int) -> Int 41 | part1 text digits = 42 | let lines = split (trim text) "\n" in 43 | let nums = map combine $ map digits lines in 44 | foldl _+_ 0 nums 45 | 46 | #check digits1 ∘ unpack : String -> List Int 47 | 48 | runFile : String -> IO Unit 49 | runFile fn = do 50 | text <- readFile fn 51 | putStrLn fn 52 | putStrLn "part1" 53 | putStrLn $ show (part1 text (digits1 ∘ unpack)) 54 | putStrLn "part2" 55 | putStrLn $ show (part1 text (digits2 ∘ unpack)) 56 | putStrLn "" 57 | 58 | 59 | -- Argument is a hack to keep it from running at startup. Need to add IO 60 | main : IO Unit 61 | main = do 62 | runFile "aoc2023/day1/eg.txt" 63 | runFile "aoc2023/day1/eg2.txt" 64 | runFile "aoc2023/day1/input.txt" 65 | -------------------------------------------------------------------------------- /aoc2023/Day2.newt: -------------------------------------------------------------------------------- 1 | module Day2 2 | 3 | import Prelude 4 | import Node 5 | 6 | Draw : U 7 | Draw = Int × Int × Int 8 | 9 | data Game : U where 10 | MkGame : Int -> List Draw -> Game 11 | 12 | -- Original had class and instance... 13 | -- Add, Sub, Mul, Neg 14 | 15 | max : Int -> Int -> Int 16 | max x y = case x < y of 17 | True => y 18 | False => x 19 | 20 | pfunc repr : {a : U} -> a -> String := `(a,o) => ''+o` 21 | pfunc jrepr : {a : U} -> a -> String := `(a,o) => JSON.stringify(o, null, ' ')` 22 | pfunc toInt : String -> Int := `s => Number(s)` 23 | 24 | maxd : Draw -> Draw -> Draw 25 | maxd (a,b,c) (d,e,f) = (max a d, max b e, max c f) 26 | 27 | lte : Draw -> Draw -> Bool 28 | lte (a,b,c) (d,e,f) = a <= d && b <= e && c <= f 29 | 30 | parseColor : String -> Either String Draw 31 | parseColor line = case split line " " of 32 | (n :: "red" :: Nil) => Right (toInt n,0,0) 33 | (n :: "green" :: Nil) => Right (0,toInt n,0) 34 | (n :: "blue" :: Nil) => Right (0,0,toInt n) 35 | x => Left $ "Bad draw" ++ repr x 36 | 37 | -- FIXME implicit isn't being solved in time here. 38 | parseDraw : String -> Either String Draw 39 | parseDraw line = 40 | case mapM {Either String} parseColor $ split line ", " of 41 | Right parts => Right $ foldl maxd (0,0,0) parts 42 | Left err => Left err 43 | 44 | parseGame : String -> Either String Game 45 | parseGame line = 46 | let (a :: b :: Nil) = split line ": " 47 | | _ => Left $ "No colon in " ++ line in 48 | let ("Game" :: ns :: Nil) = split a " " 49 | | _ => Left $ "No Game" in 50 | let (Right parts) = mapM {Either String} parseDraw $ split b "; " 51 | | Left err => Left err in 52 | Right $ MkGame (toInt ns) parts 53 | 54 | part1 : List Game -> Int 55 | part1 Nil = 0 56 | part1 (MkGame n parts :: rest) = 57 | let total = foldl maxd (0,0,0) parts in 58 | if lte total (12,13,14) 59 | then n + part1 rest 60 | else part1 rest 61 | 62 | part2 : List Game -> Int 63 | part2 Nil = 0 64 | part2 (MkGame n parts :: rest) = 65 | let (a,b,c) = foldl maxd (0,0,0) parts 66 | in a * b * c + part2 rest 67 | 68 | run : String -> IO Unit 69 | run fn = do 70 | putStrLn fn 71 | text <- readFile fn 72 | let (Right games) = mapM {Either String} parseGame (split (trim text) "\n") 73 | | Left err => putStrLn $ "fail " ++ err 74 | putStrLn "part1" 75 | printLn (part1 games) 76 | putStrLn "part2" 77 | printLn (part2 games) 78 | 79 | main : IO Unit 80 | main = do 81 | run "aoc2023/day2/eg.txt" 82 | run "aoc2023/day2/input.txt" 83 | -------------------------------------------------------------------------------- /aoc2023/Day3.newt: -------------------------------------------------------------------------------- 1 | module Day3 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | 7 | pfunc repr : {a : U} -> a -> String := `(a,o) => ''+o` 8 | pfunc jrepr : {a : U} -> a -> String := `(a,o) => JSON.stringify(o, null, ' ')` 9 | 10 | 11 | maybe : ∀ a b. b → (a → b) → Maybe a → b 12 | maybe def f Nothing = def 13 | maybe def f (Just a) = f a 14 | 15 | -- was 'structure' I could make a `record` that destructures to this.. 16 | data Number : U where 17 | MkNumber : (start : Nat) -> (stop : Nat) → (value : Int) → Number 18 | 19 | 20 | numbers : List Char -> List Number 21 | numbers arr = go arr Z 22 | where 23 | go : List Char → Nat → List Number 24 | go (c :: cs) start = if isDigit c 25 | then case span isDigit (c :: cs) of 26 | (front,back) => let stop = start + length front 27 | in MkNumber start stop (stringToInt $ pack front) :: go back stop 28 | else go cs (S start) 29 | go Nil start = Nil 30 | 31 | 32 | range : ∀ a. Nat -> Nat -> List a -> List a 33 | range _ _ Nil = Nil 34 | range _ Z _ = Nil 35 | range Z (S k) (x :: xs) = x :: range Z k xs 36 | range (S n) (S m) (x :: xs) = range n m xs 37 | 38 | isPart : List (List Char) -> Nat -> Number -> Bool 39 | isPart rows row (MkNumber start end _) = 40 | checkRow (pred row) || checkRow row || checkRow (S row) 41 | where 42 | isThing : Char -> Bool 43 | isThing c = not (isDigit c || c == '.') 44 | 45 | checkRow : Nat -> Bool 46 | checkRow r = case getAt r rows of 47 | Nothing => False 48 | Just chars => case filter isThing (range (pred start) (S end) chars) of 49 | Nil => False 50 | _ => True 51 | 52 | getValue : Number -> Int 53 | getValue (MkNumber _ _ v) = v 54 | 55 | part1 : List (List Char) -> Int 56 | part1 rows = 57 | foldl (\ acc num => acc + getValue num) 0 $ 58 | join $ map (partNums rows) $ enumerate rows 59 | where 60 | partNums : List (List Char) -> (Nat × List Char) -> List Number 61 | partNums grid (r, cs) = 62 | filter (isPart grid r) $ (numbers cs) 63 | 64 | gears : List (List Char) -> List Char -> Nat -> Int 65 | gears rows row y = 66 | let a = numbers (getAt! (pred y) rows) 67 | b = numbers (getAt! y rows) 68 | c = numbers (getAt! (S y) rows) 69 | all = a ++ b ++ c 70 | cands = map fst $ filter (_==_ '*' ∘ snd) (enumerate row) 71 | in foldl _+_ 0 $ map (check all) cands 72 | where 73 | ratio : List Int → Int 74 | ratio (a :: b :: Nil) = a * b 75 | ratio _ = 0 76 | 77 | match : Nat → Number → Bool 78 | match y (MkNumber start stop value) = pred start <= y && y < S stop 79 | 80 | check : List Number → Nat → Int 81 | check nums y = ratio $ map getValue (filter (match y) nums) 82 | 83 | part2 : List (List Char) -> Int 84 | part2 rows = 85 | foldl go 0 (enumerate rows) 86 | where 87 | go : Int → Nat × List Char → Int 88 | go acc (y, row) = acc + gears rows row y 89 | 90 | -- 4361 / 467835 91 | -- 517021 / 81296995 92 | run : String -> IO Unit 93 | run fn = do 94 | content <- readFile fn 95 | let grid = (splitOn '\n' $ unpack $ trim content) 96 | putStrLn fn 97 | printLn (part1 grid) 98 | printLn (part2 grid) 99 | 100 | main : IO Unit 101 | main = do 102 | run "aoc2023/day3/eg.txt" 103 | run "aoc2023/day3/input.txt" 104 | 105 | -------------------------------------------------------------------------------- /aoc2023/Day4.newt: -------------------------------------------------------------------------------- 1 | module Day4 2 | 3 | import Prelude 4 | import Node 5 | 6 | Round : U 7 | Round = List Int × List Int 8 | 9 | parseRound : String → Maybe Round 10 | parseRound s = 11 | let (a :: b :: Nil) = split s ": " | _ => Nothing in 12 | let (l :: r :: Nil) = split b " | " | _ => Nothing in 13 | Just (nums l, nums r) 14 | where 15 | -- Nat or Int here? 16 | nums : String → List Int 17 | -- catch - split returns empty strings that become zeros 18 | nums s = map stringToInt $ filter (_/=_ "") $ split (trim s) " " 19 | 20 | parse : String -> Maybe (List Round) 21 | parse s = mapM parseRound (split (trim s) "\n") 22 | 23 | pfunc pow : Int → Int → Int := `(x,y) => x ** y` 24 | 25 | part1 : List Round → Int 26 | part1 rounds = foldl _+_ 0 $ map score rounds 27 | where 28 | -- TODO we'll keep the math in Int land until we have magic Nat 29 | score : Round → Int 30 | score (a,b) = let count = natToInt $ length $ filter (\ n => elem n b) a 31 | in if count == 0 then 0 else pow 2 (count - 1) 32 | 33 | part2 : List Round → Int 34 | part2 rounds = go 0 $ map (_,_ 1) rounds 35 | where 36 | mark : Int -> Nat → List (Int × Round) → List (Int × Round) 37 | mark _ _ Nil = Nil 38 | mark v Z rounds = rounds 39 | mark v (S k) ((cnt, round) :: rounds) = (cnt + v, round) :: mark v k rounds 40 | 41 | go : Int → List (Int × Round) → Int 42 | go acc Nil = acc 43 | go acc ((cnt, a, b) :: rounds) = 44 | let n = length $ filter (\ n => elem n b) a 45 | in go (acc + cnt) $ mark cnt n rounds 46 | 47 | run : String -> IO Unit 48 | run fn = do 49 | putStrLn fn 50 | text <- readFile fn 51 | let (Just cards) = parse text 52 | | _ => putStrLn "fail" 53 | putStrLn "part1" 54 | printLn (part1 cards) 55 | putStrLn "part2" 56 | printLn (part2 cards) 57 | 58 | -- 13/30 59 | -- 25004/14427616 60 | main : IO Unit 61 | main = do 62 | run "aoc2023/day4/eg.txt" 63 | run "aoc2023/day4/input.txt" 64 | -------------------------------------------------------------------------------- /aoc2023/Day5.newt: -------------------------------------------------------------------------------- 1 | module Day5 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | 7 | -- AoC lib? 8 | -- nums : String → List Int 9 | -- nums s = map stringToInt $ filter (_/=_ "") $ split (trim s) " " 10 | 11 | data MapEntry : U where 12 | -- dest / src / len 13 | MkEntry : Int → Int → Int → MapEntry 14 | 15 | src : MapEntry -> Int 16 | src (MkEntry d s l) = s 17 | 18 | Map : U 19 | Map = List MapEntry 20 | 21 | data Problem : U where 22 | MkProb : List Int → List Map → Problem 23 | 24 | parseEntry : String → Either String MapEntry 25 | parseEntry part = case nums part of 26 | (dest :: src :: len :: Nil) => Right $ MkEntry dest src len 27 | _ => Left $ "Bad part " ++ part 28 | 29 | parseMap : List String → Either String Map 30 | parseMap (_ :: parts) = mapM parseEntry parts 31 | parseMap x = Left $ "bad map " ++ debugStr x 32 | 33 | parseFile : String → Either String Problem 34 | parseFile content = do 35 | let parts = split (trim content) "\n\n" 36 | -- TODO deconstructing let 37 | let (first :: rest) = parts 38 | | _ => Left "expected some parts" 39 | let (_ :: x :: Nil) = split first ": " 40 | | _ => Left $ "expected ': ' in " ++ first 41 | 42 | let seeds = nums x 43 | maps <- mapA (λ part => parseMap (split part "\n")) rest 44 | Right $ MkProb seeds maps 45 | 46 | applyEntry : Int → MapEntry → Int 47 | applyEntry n (MkEntry dest src len) = 48 | if src <= n && n < src + len then n + dest - src else n 49 | 50 | applyMap : Int → Map → Int 51 | applyMap n Nil = n 52 | applyMap n (MkEntry dest src len :: es) = 53 | if src <= n && n < src + len then n + dest - src else applyMap n es 54 | 55 | min : Int → Int → Int 56 | min x y = if x < y then x else y 57 | 58 | part1 : Problem → IO Unit 59 | part1 (MkProb seeds maps) = do 60 | let loc = map (λ s => foldl applyMap s maps) seeds 61 | let part1 = foldl min 999999999 loc 62 | putStrLn $ "part1 " ++ show part1 63 | 64 | Range : U 65 | Range = Int × Int 66 | 67 | apply' : Range → List MapEntry → List Range 68 | apply' (r1, r2) x = case x of 69 | Nil => (r1, r2) :: Nil 70 | (MkEntry d s l) :: es => 71 | if r2 + r1 <= s then (r1,r2) :: Nil -- map after range 72 | else if s + l <= r1 then apply' (r1, r2) es -- map before range 73 | -- take off any bare range on front 74 | else if r1 < s then 75 | (r1, s - r1) :: apply' (s, r2 + r1 - s) x 76 | else if s + l < r1 + r2 then 77 | let slack = r1 - s in 78 | (r1 + d - s, l - slack) :: apply' (r1 + l - slack, r2 + slack - l) x 79 | else 80 | (r1 + d - s, r2) :: Nil 81 | 82 | 83 | apply : List Range → List MapEntry → List Range 84 | apply ranges entries = 85 | let entries = qsort (\ a b => src a < src b) entries in 86 | join $ map (\ r => apply' r entries) ranges 87 | 88 | mkRanges : List Int → Maybe (List Range) 89 | mkRanges (a :: b :: rs) = do 90 | rs <- mkRanges rs 91 | Just $ (a,b) :: rs 92 | mkRanges Nil = Just Nil 93 | mkRanges _ = Nothing 94 | 95 | part2 : Problem → IO Unit 96 | part2 (MkProb seeds maps) = do 97 | let (Just ranges) = mkRanges seeds 98 | | Nothing => printLn "odd seeds!" 99 | let results = foldl apply ranges maps 100 | -- putStrLn $ debugStr results 101 | let answer = foldl min 99999999 $ map fst results 102 | putStrLn $ "part2 " ++ show answer 103 | 104 | run : String -> IO Unit 105 | run fn = do 106 | putStrLn fn 107 | text <- readFile fn 108 | let (Right prob) = parseFile text 109 | | Left err => putStrLn err 110 | putStrLn $ debugStr prob 111 | part1 prob 112 | part2 prob 113 | 114 | -- 35 / 46 115 | -- 282277027 / 11554135 116 | main : IO Unit 117 | main = do 118 | run "aoc2023/day5/eg.txt" 119 | run "aoc2023/day5/input.txt" 120 | -------------------------------------------------------------------------------- /aoc2023/Day6.newt: -------------------------------------------------------------------------------- 1 | module Day6 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | 7 | Problem : U 8 | Problem = List (Int × Int) 9 | 10 | pNums : String → Either String (List Int) 11 | pNums line = 12 | let (_ :: line :: Nil) = split line ": " 13 | | _ => Left "expected two parts" in 14 | Right $ nums line 15 | 16 | parse : String → Either String Problem 17 | parse content = do 18 | let (a :: b :: Nil) = split (trim content) "\n" 19 | | _ => Left "expected two lines" 20 | times <- pNums a 21 | dists <- pNums b 22 | Right (zip times dists) 23 | 24 | part1 : Problem → Int 25 | part1 prob = go 1 prob 26 | where 27 | run : Int -> Int -> Int → Int → Int 28 | run time dist t count = 29 | let count = if dist < t * (time - t) then count + 1 else count in 30 | if time == t then count 31 | else run time dist (t + 1) count 32 | 33 | go : Int → Problem → Int 34 | go acc Nil = acc 35 | go acc ((time,dist) :: prob) = go (acc * run time dist 0 0) prob 36 | 37 | part2 : Int × Int → IO Unit 38 | part2 (time,dist) = do 39 | let t = intToDouble time 40 | let d = intToDouble dist 41 | let x = sqrtDouble (t * t - intToDouble 4 * d) 42 | let start = (t - x) / intToDouble 2 43 | let stop = (t + x) / intToDouble 2 44 | let s = doubleToInt $ ceilDouble start 45 | let e = doubleToInt $ ceilDouble stop 46 | putStrLn $ "part2 " ++ show (e - s) 47 | 48 | parse2 : String → Either String (Int × Int) 49 | parse2 content = 50 | let (a :: b :: Nil) = split (trim content) "\n" 51 | | _ => Left "too many parts" in 52 | let time = stringToInt $ pack $ filter isDigit $ unpack a 53 | dist = stringToInt $ pack $ filter isDigit $ unpack b 54 | in Right (time, dist) 55 | 56 | run : String -> IO Unit 57 | run fn = do 58 | putStrLn fn 59 | text <- readFile fn 60 | let (Right prob) = parse text | Left err => putStrLn err 61 | putStrLn $ debugStr prob 62 | putStrLn $ "part1 " ++ show (part1 prob) 63 | let (Right prob) = parse2 text | Left err => putStrLn err 64 | part2 prob 65 | -- debugLog prob 66 | -- part2 prob 67 | 68 | -- 288 / 71503 69 | -- 1413720 / 30565288 70 | 71 | main : IO Unit 72 | main = do 73 | run "aoc2023/day6/eg.txt" 74 | run "aoc2023/day6/input.txt" 75 | -------------------------------------------------------------------------------- /aoc2023/Node.newt: -------------------------------------------------------------------------------- 1 | module Node 2 | 3 | import Prelude 4 | 5 | pfunc fs : JSObject := `require('fs')` 6 | pfunc getArgs : List String := `arrayToList(String, process.argv)` 7 | pfunc readFile uses (MkIORes) : (fn : String) -> IO String := `(fn) => (w) => Prelude_MkIORes(null, require('fs').readFileSync(fn, 'utf8'), w)` 8 | -------------------------------------------------------------------------------- /aoc2023/Prelude.newt: -------------------------------------------------------------------------------- 1 | ../newt/Prelude.newt -------------------------------------------------------------------------------- /aoc2023/README.md: -------------------------------------------------------------------------------- 1 | 2 | Attempts to port AOC2023 solutions from Lean4 to see how usable newt is. 3 | -------------------------------------------------------------------------------- /aoc2023/day1/eg.txt: -------------------------------------------------------------------------------- 1 | 1abc2 2 | pqr3stu8vwx 3 | a1b2c3d4e5f 4 | treb7uchet 5 | 6 | -------------------------------------------------------------------------------- /aoc2023/day1/eg2.txt: -------------------------------------------------------------------------------- 1 | two1nine 2 | eightwothree 3 | abcone2threexyz 4 | xtwone3four 5 | 4nineeightseven2 6 | zoneight234 7 | 7pqrstsixteen 8 | -------------------------------------------------------------------------------- /aoc2023/day2/eg.txt: -------------------------------------------------------------------------------- 1 | Game 1: 3 blue, 4 red; 1 red, 2 green, 6 blue; 2 green 2 | Game 2: 1 blue, 2 green; 3 green, 4 blue, 1 red; 1 green, 1 blue 3 | Game 3: 8 green, 6 blue, 20 red; 5 blue, 4 red, 13 green; 5 green, 1 red 4 | Game 4: 1 green, 3 red, 6 blue; 3 green, 6 red; 3 green, 15 blue, 14 red 5 | Game 5: 6 red, 1 blue, 3 green; 2 blue, 1 red, 2 green 6 | -------------------------------------------------------------------------------- /aoc2023/day3/eg.txt: -------------------------------------------------------------------------------- 1 | 467..114.. 2 | ...*...... 3 | ..35..633. 4 | ......#... 5 | 617*...... 6 | .....+.58. 7 | ..592..... 8 | ......755. 9 | ...$.*.... 10 | .664.598.. 11 | -------------------------------------------------------------------------------- /aoc2023/day4/eg.txt: -------------------------------------------------------------------------------- 1 | Card 1: 41 48 83 86 17 | 83 86 6 31 17 9 48 53 2 | Card 2: 13 32 20 16 61 | 61 30 68 82 17 32 24 19 3 | Card 3: 1 21 53 59 44 | 69 82 63 72 16 21 14 1 4 | Card 4: 41 92 73 84 69 | 59 84 76 51 58 5 54 83 5 | Card 5: 87 83 26 28 32 | 88 30 70 12 93 22 82 36 6 | Card 6: 31 18 13 56 72 | 74 77 10 23 35 67 36 11 7 | -------------------------------------------------------------------------------- /aoc2023/day5/eg.txt: -------------------------------------------------------------------------------- 1 | seeds: 79 14 55 13 2 | 3 | seed-to-soil map: 4 | 50 98 2 5 | 52 50 48 6 | 7 | soil-to-fertilizer map: 8 | 0 15 37 9 | 37 52 2 10 | 39 0 15 11 | 12 | fertilizer-to-water map: 13 | 49 53 8 14 | 0 11 42 15 | 42 0 7 16 | 57 7 4 17 | 18 | water-to-light map: 19 | 88 18 7 20 | 18 25 70 21 | 22 | light-to-temperature map: 23 | 45 77 23 24 | 81 45 19 25 | 68 64 13 26 | 27 | temperature-to-humidity map: 28 | 0 69 1 29 | 1 0 69 30 | 31 | humidity-to-location map: 32 | 60 56 37 33 | 56 93 4 34 | -------------------------------------------------------------------------------- /aoc2023/day6/eg.txt: -------------------------------------------------------------------------------- 1 | Time: 7 15 30 2 | Distance: 9 40 200 3 | -------------------------------------------------------------------------------- /aoc2024/Day1.newt: -------------------------------------------------------------------------------- 1 | module Day1 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | 7 | pairUp : List Int -> List (Int × Int) 8 | pairUp (a :: b :: rest) = (a,b) :: pairUp rest 9 | pairUp (a :: rest) = trace "fail" Nil 10 | pairUp Nil = Nil 11 | 12 | dist : (Int × Int) → Int 13 | dist (a,b) = if a < b then b - a else a - b 14 | 15 | part1 : String -> Int 16 | part1 text = 17 | let pairs = pairUp $ join $ map nums $ split text "\n" 18 | left = qsort _<_ $ map fst pairs 19 | right = qsort _<_ $ map snd pairs 20 | dists = map dist $ zip left right 21 | in foldl _+_ 0 dists 22 | 23 | 24 | lookup : ∀ a b. {{Eq a}} → a → List (a × b) → Maybe b 25 | lookup key Nil = Nothing 26 | lookup key ((k,v) :: rest) = if k == key then Just v else lookup key rest 27 | 28 | 29 | coalesce : List Int → Int -> List (Int × Int) 30 | coalesce (a :: b :: rest) cnt = 31 | if a == b then coalesce (b :: rest) (cnt + 1) else (a,cnt) :: coalesce (b :: rest) 1 32 | coalesce (a :: Nil) cnt = (a,cnt) :: Nil 33 | coalesce Nil cnt = Nil 34 | 35 | cross : List (Int × Int) → List (Int × Int) → Int → Int 36 | cross xs ys acc = 37 | let ((a,cnt) :: xs') = xs | Nil => acc in 38 | let ((b,cnt') :: ys') = ys | Nil => acc in 39 | if a == b then cross xs' ys' (acc + a * cnt * cnt') 40 | else if a < b then cross xs' ys acc 41 | else cross xs ys' acc 42 | 43 | part2 : String → Int 44 | part2 text = 45 | let pairs = pairUp $ join $ map nums $ split text "\n" 46 | left = coalesce (qsort _<_ $ map fst pairs) 1 47 | right = coalesce (qsort _<_ $ map snd pairs) 1 48 | in cross left right 0 49 | 50 | run : String -> IO Unit 51 | run fn = do 52 | putStrLn fn 53 | text <- readFile fn 54 | putStrLn $ "part1 " ++ show (part1 text) 55 | putStrLn $ "part2 " ++ show (part2 text) 56 | 57 | main : IO Unit 58 | main = do 59 | run "aoc2024/day1/eg.txt" 60 | run "aoc2024/day1/input.txt" 61 | -------------------------------------------------------------------------------- /aoc2024/Day1.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day1/eg.txt 2 | part1 11 3 | part2 31 4 | aoc2024/day1/input.txt 5 | part1 1197984 6 | part2 23387399 7 | -------------------------------------------------------------------------------- /aoc2024/Day10.newt: -------------------------------------------------------------------------------- 1 | module Day10 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | import SortedMap 7 | 8 | -- move to lib 9 | 10 | gridPoints : String → List (Char × Int × Int) 11 | gridPoints text = go 0 0 (unpack text) Nil 12 | where 13 | -- might as well be tail recursive 14 | go : Int → Int → List Char → List (Char × Int × Int) → List (Char × Int × Int) 15 | go row col Nil points = points 16 | go row col ('\n' :: cs) points = go (row + 1) 0 cs points 17 | go row col (c :: cs) points = go row (col + 1) cs ((c,row,col) :: points) 18 | 19 | -- TODO add parameter a and pass Char -> a into getGrid 20 | Grid : U 21 | Grid = SortedMap Point Int 22 | 23 | digitToInt : Char → Int 24 | digitToInt c = ord c - 48 25 | 26 | getGrid : String → Grid 27 | 28 | getGrid text = foldl update EmptyMap $ gridPoints text 29 | where 30 | update : Grid → Char × Point → Grid 31 | update grid (c,pt) = updateMap pt (digitToInt c) grid 32 | 33 | peers : Point → List Point 34 | peers pt = map (_+_ pt) ((0, 0 - 1) :: (0,1) :: (0 - 1,0) :: (1,0) :: Nil) 35 | 36 | 37 | paths : Grid → List Point → Int → Int 38 | paths grid pts ht = 39 | if ht == 9 then cast $ length pts else 40 | -- Maybe I should nub with a sortedMap 41 | let cands = ordNub $ map fst $ filter (_==_ (ht + 1) ∘ snd) $ join $ map getCands pts 42 | in paths grid cands (ht + 1) 43 | where 44 | getCands : Point → List (Point × Int) 45 | getCands pt = mapMaybe (\ p => lookupMap p grid) (peers pt) 46 | 47 | paths2 : Grid → List (Point × Int) → Int → Int 48 | paths2 grid pts ht = 49 | if ht == 9 then foldl _+_ 0 $ map snd $ pts else 50 | let cands = join $ map getCands pts 51 | pts' = toList $ foldMap _+_ EmptyMap cands 52 | in paths2 grid pts' (ht + 1) 53 | where 54 | getCands : Point × Int → List (Point × Int) 55 | getCands (pt,cnt) = 56 | map (\ x => fst x , cnt) 57 | $ filter (_==_ (ht + 1) ∘ snd) 58 | $ mapMaybe (\ p => lookupMap p grid) (peers pt) 59 | 60 | run : String -> IO Unit 61 | run fn = do 62 | putStrLn fn 63 | text <- readFile fn 64 | let grid = getGrid text 65 | let starts = filter (_==_ 0 ∘ snd) $ toList grid 66 | let all = map (\ pt => paths grid (fst pt :: Nil) 0) starts 67 | let part1 = foldl _+_ 0 all 68 | putStrLn $ "part1 " ++ show part1 69 | 70 | let all = map (\ pt => paths2 grid ((fst pt, 1) :: Nil) 0) starts 71 | let part2 = foldl _+_ 0 all 72 | putStrLn $ "part2 " ++ show part2 73 | 74 | main : IO Unit 75 | main = do 76 | run "aoc2024/day10/eg.txt" 77 | run "aoc2024/day10/eg2.txt" 78 | run "aoc2024/day10/eg3.txt" 79 | run "aoc2024/day10/eg4.txt" 80 | run "aoc2024/day10/eg5.txt" 81 | run "aoc2024/day10/input.txt" 82 | -------------------------------------------------------------------------------- /aoc2024/Day10.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day10/eg.txt 2 | part1 1 3 | part2 16 4 | aoc2024/day10/eg2.txt 5 | part1 2 6 | part2 2 7 | aoc2024/day10/eg3.txt 8 | part1 4 9 | part2 13 10 | aoc2024/day10/eg4.txt 11 | part1 3 12 | part2 3 13 | aoc2024/day10/eg5.txt 14 | part1 36 15 | part2 81 16 | aoc2024/day10/input.txt 17 | part1 510 18 | part2 1058 19 | -------------------------------------------------------------------------------- /aoc2024/Day11.newt: -------------------------------------------------------------------------------- 1 | module Day11 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | import SortedMap 7 | 8 | infixl 7 _%_ 9 | pfunc _%_ : Int → Int → Int := `(x,y) => x % y` 10 | 11 | -- should have a few more foreign functions and do this in newt 12 | pfunc divide uses (_,_) : String → String × String := `(s) => { 13 | let l = s.length/2|0 14 | return Prelude__$2C_(undefined, undefined, s.slice(0,l), s.slice(l)) 15 | }` 16 | 17 | step : List (Int × Int) → List (Int × Int) 18 | step = go Nil 19 | where 20 | go : List (Int × Int) → List (Int × Int) → List (Int × Int) 21 | go acc Nil = acc 22 | go acc ((0,c) :: xs) = go ((1,c) :: acc) xs 23 | go acc ((x,c) :: xs) = 24 | let str = show x in 25 | if slen str % 2 == 0 26 | then let (a,b) = divide str in go ((stringToInt a,c) :: (stringToInt b,c) :: acc) xs 27 | else go ((2024 * x,c) :: acc) xs 28 | 29 | iter : Int → SortedMap Int Int → Int 30 | iter count parts = let x = go count parts in foldl _+_ 0 $ map snd $ toList x 31 | where 32 | go : Int → SortedMap Int Int → SortedMap Int Int 33 | go 0 stuff = stuff 34 | go x stuff = go (x - 1) $ foldMap _+_ EmptyMap $ step $ toList stuff 35 | 36 | run : String -> IO Unit 37 | run fn = do 38 | putStrLn fn 39 | text <- readFile fn 40 | let stuff = foldMap _+_ EmptyMap $ map (\ x => (stringToInt x, 1)) $ split (trim text) " " 41 | let p1 = iter 25 stuff 42 | putStrLn $ "part1 " ++ show p1 43 | let p2 = iter 75 stuff 44 | putStrLn $ "part2 " ++ show p2 45 | 46 | main : IO Unit 47 | main = do 48 | run "aoc2024/day11/eg.txt" 49 | run "aoc2024/day11/input.txt" 50 | -------------------------------------------------------------------------------- /aoc2024/Day11.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day11/eg.txt 2 | part1 55312 3 | part2 65601038650482 4 | aoc2024/day11/input.txt 5 | part1 186175 6 | part2 220566831337810 7 | -------------------------------------------------------------------------------- /aoc2024/Day11b.newt: -------------------------------------------------------------------------------- 1 | module Day11b 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | import SortedMap 7 | 8 | -- Alternate version that doesn't use string 9 | 10 | infixl 7 _%_ 11 | pfunc _%_ : Int → Int → Int := `(x,y) => x % y` 12 | 13 | -- 32 bit ints are too small 14 | pfunc div53 : Int → Int → Int := `(x,y) => Math.floor(x / y)` 15 | 16 | stone : Int → Either Int (Int × Int) 17 | stone num = if num == 0 then Left 1 else go num num 1 18 | where 19 | go : Int → Int → Int → Either Int (Int × Int) 20 | go a b mod = 21 | if b == 0 then Right (a, num % mod) 22 | else if b < 10 then Left (2024 * num) 23 | else go (div53 a 10) (div53 b 100) (mod * 10) 24 | 25 | step : List (Int × Int) → List (Int × Int) 26 | step xs = go Nil xs 27 | where 28 | go : List (Int × Int) → List (Int × Int) → List (Int × Int) 29 | go acc Nil = acc 30 | go acc ((x,c) :: xs) = case stone x of 31 | Left a => go ((a,c) :: acc) xs 32 | Right (a,b) => go ((a,c) :: (b,c) :: acc) xs 33 | 34 | iter : Int → SortedMap Int Int → Int 35 | iter count parts = let x = go count parts in foldl _+_ 0 $ map snd $ toList x 36 | where 37 | go : Int → SortedMap Int Int → SortedMap Int Int 38 | go 0 stuff = stuff 39 | go x stuff = go (x - 1) $ foldMap _+_ EmptyMap $ step $ toList stuff 40 | 41 | run : String -> IO Unit 42 | run fn = do 43 | putStrLn fn 44 | text <- readFile fn 45 | let stuff = foldMap _+_ EmptyMap $ map (\ x => (stringToInt x, 1)) $ split (trim text) " " 46 | let p1 = iter 25 stuff 47 | putStrLn $ "part1 " ++ show p1 48 | let p2 = iter 75 stuff 49 | putStrLn $ "part2 " ++ show p2 50 | 51 | main : IO Unit 52 | main = do 53 | run "aoc2024/day11/eg.txt" 54 | run "aoc2024/day11/input.txt" 55 | -------------------------------------------------------------------------------- /aoc2024/Day11b.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day11/eg.txt 2 | part1 55312 3 | part2 65601038650482 4 | aoc2024/day11/input.txt 5 | part1 186175 6 | part2 220566831337810 7 | -------------------------------------------------------------------------------- /aoc2024/Day12.newt: -------------------------------------------------------------------------------- 1 | module Day12 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | import SortedMap 7 | 8 | -- move to lib 9 | 10 | gridPoints : String → List (Char × Int × Int) 11 | gridPoints text = go 0 0 (unpack text) Nil 12 | where 13 | -- might as well be tail recursive 14 | go : Int → Int → List Char → List (Char × Int × Int) → List (Char × Int × Int) 15 | go row col Nil points = points 16 | go row col ('\n' :: cs) points = go (row + 1) 0 cs points 17 | go row col (c :: cs) points = go row (col + 1) cs ((c,row,col) :: points) 18 | 19 | -- TODO add parameter a and pass Char -> a into getGrid 20 | Grid : U 21 | Grid = SortedMap Point Int 22 | 23 | digitToInt : Char → Int 24 | digitToInt c = ord c 25 | 26 | getGrid : String → Grid 27 | 28 | getGrid text = foldl update EmptyMap $ gridPoints text 29 | where 30 | update : Grid → Char × Point → Grid 31 | update grid (c,pt) = updateMap pt (digitToInt c) grid 32 | 33 | north east south west : Point 34 | north = (0, 0 - 1) 35 | south = (0, 1) 36 | east = (1, 0) 37 | west = (0 - 1, 0) 38 | 39 | 40 | neighbors : Point → List Point 41 | neighbors pt = map (_+_ pt) ((0, 0 - 1) :: (0,1) :: (0 - 1,0) :: (1,0) :: Nil) 42 | 43 | 44 | perim2 : Grid → Point → Int → Int 45 | perim2 grid pt color = 46 | let top = different (north + pt) && (different (west + pt) || same (west + north + pt)) 47 | bottom = different (south + pt) && (different (west + pt) || same (west + south + pt)) 48 | left = different (west + pt) && (different (north + pt) || same (north + west + pt)) 49 | right = different (east + pt) && (different (north + pt) || same (north + east + pt)) 50 | in (ite top 1 0) + (ite bottom 1 0) + ite left 1 0 + ite right 1 0 51 | where 52 | same : Point → Bool 53 | same pt = case lookupMap pt grid of 54 | Just (_, c) => c == color 55 | Nothing => False 56 | different : Point → Bool 57 | different pt = not $ same pt 58 | 59 | -- use negative numbers for the regions we've filled 60 | flood : Grid → Point → Int → Maybe (Int × Int × Grid) 61 | flood orig start id = 62 | let (Just (pt,color)) = lookupMap start orig | Nothing => Nothing in 63 | if 0 < color then Just $ go orig color (start :: Nil) 0 0 0 else Nothing 64 | where 65 | go : Grid → Int → List Point → Int → Int → Int → Int × Int × Grid 66 | go grid' color Nil area perim p2 = ((area * perim), (area * p2), grid') 67 | go grid' color (pt :: pts) area perim p2 = 68 | let (Just (_,c2)) = lookupMap pt grid' | Nothing => go grid' color pts area perim p2 in 69 | if c2 /= color then go grid' color pts area perim p2 else 70 | let next = map fst $ filter (_==_ color ∘ snd) $ mapMaybe (flip lookupMap orig) $ neighbors pt 71 | perim = perim + 4 - cast (length next) 72 | p2 = p2 + perim2 orig pt color 73 | grid = updateMap pt id grid' 74 | in go grid color (next ++ pts) (area + 1) perim p2 75 | 76 | 77 | part1 : Grid → Int × Int 78 | part1 grid = go grid (0 - 1) (map fst $ toList grid) 0 0 79 | where 80 | go : Grid → Int → List Point → Int → Int → Int × Int 81 | go grid id Nil acc acc2 = (acc, acc2) 82 | go grid id (pt :: pts) acc acc2 = 83 | case flood grid pt id of 84 | Nothing => go grid id pts acc acc2 85 | Just (cost, cost2, grid) => go grid (id - 1) pts (acc + cost) (acc2 + cost2) 86 | 87 | run : String -> IO Unit 88 | run fn = do 89 | putStrLn fn 90 | text <- readFile fn 91 | let grid = getGrid text 92 | let (p1, p2) = part1 grid 93 | putStrLn $ "part1 " ++ show p1 94 | putStrLn $ "part2 " ++ show p2 95 | 96 | main : IO Unit 97 | main = do 98 | run "aoc2024/day12/eg.txt" 99 | run "aoc2024/day12/eg2.txt" 100 | run "aoc2024/day12/input.txt" 101 | -------------------------------------------------------------------------------- /aoc2024/Day12.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day12/eg.txt 2 | part1 140 3 | part2 80 4 | aoc2024/day12/eg2.txt 5 | part1 772 6 | part2 436 7 | aoc2024/day12/input.txt 8 | part1 1450816 9 | part2 865662 10 | -------------------------------------------------------------------------------- /aoc2024/Day13.newt: -------------------------------------------------------------------------------- 1 | module Day13 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | import Parser 7 | 8 | data Machine : U where 9 | MkMachine : Point → Point → Point → Machine 10 | 11 | -- need Either parser.. 12 | parseButton : Parser Point 13 | parseButton = do 14 | token "Button" 15 | any 16 | token ":" 17 | token "X+" 18 | x <- number 19 | token "," 20 | token "Y+" 21 | y <- number 22 | match '\n' 23 | pure (x,y) 24 | 25 | parsePrize : Parser Point 26 | parsePrize = do 27 | token "Prize:" 28 | token "X=" 29 | x <- number 30 | token "," 31 | token "Y=" 32 | y <- number 33 | match '\n' 34 | pure (x,y) 35 | 36 | pMachine : Parser Machine 37 | pMachine = MkMachine <$> parseButton <*> parseButton <*> parsePrize <* many (match '\n') 38 | 39 | -- TODO should be a proper primitive, so we can have literals (also need Double) 40 | ptype BigInt 41 | pfunc itobi : Int → BigInt := `(x) => BigInt(x)` 42 | pfunc addbi : BigInt → BigInt → BigInt := `(a,b) => a + b` 43 | pfunc subbi : BigInt → BigInt → BigInt := `(a,b) => a - b` 44 | pfunc mulbi : BigInt → BigInt → BigInt := `(a,b) => a * b` 45 | pfunc divbi : BigInt → BigInt → BigInt := `(a,b) => a / b` 46 | 47 | instance Mul BigInt where a * b = mulbi a b 48 | instance Div BigInt where a / b = divbi a b 49 | instance Add BigInt where a + b = addbi a b 50 | instance Sub BigInt where a - b = subbi a b 51 | instance Cast Int BigInt where cast x = itobi x 52 | instance Eq BigInt where a == b = jsEq a b 53 | instance Show BigInt where show = jsShow 54 | instance Ord BigInt where compare a b = jsCompare a b 55 | 56 | calcCost : BigInt → Machine → Maybe BigInt 57 | calcCost extra (MkMachine (ax, ay) (bx, by) (px, py)) = 58 | let px = itobi px + extra 59 | py = itobi py + extra 60 | b = (px * itobi ay - py * itobi ax) / (itobi ay * itobi bx - itobi by * itobi ax) 61 | a = (px - itobi bx * b) / itobi ax 62 | in if a * itobi ax + b * itobi bx == px && a * itobi ay + b * itobi by == py 63 | then Just (a * itobi 3 + b) else Nothing 64 | 65 | run : String -> IO Unit 66 | run fn = do 67 | putStrLn fn 68 | text <- readFile fn 69 | let (Right (machines,_)) = some pMachine $ unpack text | _ => putStrLn "Parse Error" 70 | 71 | let extra = itobi 0 72 | let p1 = foldl _+_ (itobi 0) $ mapMaybe (calcCost extra) machines 73 | putStrLn $ "part1 " ++ show p1 74 | let extra = itobi 10000000 * itobi 1000000 75 | let p2 = foldl _+_ (itobi 0) $ mapMaybe (calcCost extra) machines 76 | putStrLn $ "part2 " ++ show p2 77 | 78 | main : IO Unit 79 | main = do 80 | run "aoc2024/day13/eg.txt" 81 | run "aoc2024/day13/input.txt" 82 | -------------------------------------------------------------------------------- /aoc2024/Day13.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day13/eg.txt 2 | part1 480 3 | part2 875318608908 4 | aoc2024/day13/input.txt 5 | part1 28059 6 | part2 102255878088512 7 | -------------------------------------------------------------------------------- /aoc2024/Day15.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day15/eg.txt 2 | part1 10092 3 | part2 9021 4 | aoc2024/day15/input.txt 5 | part1 1406628 6 | part2 1432781 7 | -------------------------------------------------------------------------------- /aoc2024/Day16.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day16/eg.txt 2 | part1 7036 3 | part2 45 4 | aoc2024/day16/eg2.txt 5 | part1 11048 6 | part2 64 7 | aoc2024/day16/input.txt 8 | part1 90460 9 | part2 575 10 | -------------------------------------------------------------------------------- /aoc2024/Day17.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day17/eg.txt 2 | part1 4,6,3,5,6,3,5,2,1,0 3 | fail 4 | aoc2024/day17/eg2.txt 5 | part1 5,7,3,0 6 | part2 117440 7 | 8 | aoc2024/day17/input.txt 9 | part1 5,0,3,5,7,6,1,5,4 10 | part2 164516454365621 11 | 12 | -------------------------------------------------------------------------------- /aoc2024/Day18.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day18/eg.txt 2 | 12 3 | part1 22 4 | best 20 5 | part2 6,1 6 | aoc2024/day18/input.txt 7 | 1024 8 | part1 260 9 | best 2881 10 | part2 24,48 11 | -------------------------------------------------------------------------------- /aoc2024/Day19.newt: -------------------------------------------------------------------------------- 1 | module Day19 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | 7 | Rules : U 8 | Rules = List (List Char) 9 | 10 | data Problem : U where 11 | MkP : Rules → Rules → Problem 12 | 13 | parseFile : String -> Either String Problem 14 | parseFile text = 15 | let (a :: b :: Nil) = split (trim text) "\n\n" | xs => Left $ (show $ length xs) ++ " parts" 16 | in Right (MkP (map unpack $ split a ", ") (map unpack $ lines b)) 17 | 18 | State : U 19 | State = List (Int × List Char) 20 | 21 | matches : Rules -> List Char -> Int 22 | matches rules text = go (map (_,_ 1) rules) text 23 | where 24 | step : State -> Char -> State -> State 25 | step acc c Nil = acc 26 | step acc c ((n, Nil) :: rs) = step acc c rs 27 | step acc c ((n, (x :: xs)) :: rs) = if x == c 28 | then step ((n, xs) :: acc) c rs 29 | else step acc c rs 30 | 31 | nils : Int -> State -> Int 32 | nils acc Nil = acc 33 | nils acc ((n, Nil) :: xs) = nils (acc + n) xs 34 | nils acc (x :: xs) = nils acc xs 35 | 36 | go : State -> List Char -> Int 37 | go st Nil = nils 0 st 38 | go st (c :: cs) = case nils 0 st of 39 | 0 => go (step Nil c st) cs 40 | n => let st = map (_,_ n) rules ++ st 41 | in go (step Nil c st) cs 42 | 43 | part1 : Problem -> IO Unit 44 | part1 (MkP rules msgs) = do 45 | let (r :: rs) = rules | _ => putStrLn "no rules" 46 | let out = map (matches rules) msgs 47 | let p1 = length $ filter (_/=_ 0) out 48 | putStrLn $ "part1 " ++ show p1 49 | let p2 = foldl _+_ 0 out 50 | putStrLn $ "part2 " ++ show p2 51 | 52 | run : String -> IO Unit 53 | run fn = do 54 | putStrLn fn 55 | text <- readFile fn 56 | let (Right prob) = parseFile text | Left err => putStrLn err 57 | part1 prob 58 | 59 | 60 | main : IO Unit 61 | main = do 62 | run "aoc2024/day19/eg.txt" 63 | run "aoc2024/day19/input.txt" 64 | -------------------------------------------------------------------------------- /aoc2024/Day19.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day19/eg.txt 2 | part1 6 3 | part2 16 4 | aoc2024/day19/input.txt 5 | part1 371 6 | part2 650354687260341 7 | -------------------------------------------------------------------------------- /aoc2024/Day2.newt: -------------------------------------------------------------------------------- 1 | module Day2 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | 7 | decr : List Int → Bool 8 | decr (x :: y :: _) = y < x 9 | decr _ = False 10 | 11 | diff : Int → Int → Int 12 | diff x y = if x < y then y - x else x - y 13 | 14 | isSafe : Bool → List Int → Bool 15 | isSafe decr (x :: y :: rest) = 16 | let d = diff x y 17 | good = 0 < d && d < 4 18 | safe = if x < y then not decr && good else decr && good in 19 | if safe then isSafe decr (y :: rest) else False 20 | isSafe _ _ = True 21 | 22 | check : List Int → Bool 23 | check x = isSafe (decr x) x 24 | 25 | any : ∀ a. (a → Bool) → List a → Bool 26 | any f xs = foldl (_||_) False $ map f xs 27 | 28 | alts : List Int → List (List Int) 29 | alts Nil = Nil 30 | alts (x :: xs) = xs :: map (_::_ x) (alts xs) 31 | 32 | -- I want lean's #eval here 33 | 34 | parse : String → List (List Int) 35 | parse text = map nums $ split (trim text) "\n" 36 | 37 | run : String -> IO Unit 38 | run fn = do 39 | putStrLn fn 40 | text <- readFile fn 41 | let stuff = parse text 42 | let good = filter check stuff 43 | putStrLn $ "part1 " ++ show (length good) 44 | let good = filter (any check ∘ alts) stuff 45 | putStrLn $ "part2 " ++ show (length good) 46 | 47 | main : IO Unit 48 | main = do 49 | run "aoc2024/day2/eg.txt" 50 | run "aoc2024/day2/input.txt" 51 | 52 | -------------------------------------------------------------------------------- /aoc2024/Day2.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day2/eg.txt 2 | part1 2 3 | part2 4 4 | aoc2024/day2/input.txt 5 | part1 524 6 | part2 569 7 | -------------------------------------------------------------------------------- /aoc2024/Day20.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day20/eg.txt 2 | base 84 3 | part1 1 4 | part2 285 5 | aoc2024/day20/input.txt 6 | base 9440 7 | part1 1332 8 | part2 987695 9 | -------------------------------------------------------------------------------- /aoc2024/Day21.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day21/eg.txt 2 | [("0", 3, 1), ("1", 2, 0), ("2", 2, 1), ("3", 2, 2), ("4", 1, 0), ("5", 1, 1), ("6", 1, 2), ("7", 0, 0), ("8", 0, 1), ("9", 0, 2), ("A", 3, 2)] 3 | part1 126384 4 | part2 154115708116294 5 | aoc2024/day21/input.txt 6 | [("0", 3, 1), ("1", 2, 0), ("2", 2, 1), ("3", 2, 2), ("4", 1, 0), ("5", 1, 1), ("6", 1, 2), ("7", 0, 0), ("8", 0, 1), ("9", 0, 2), ("A", 3, 2)] 7 | part1 248108 8 | part2 303836969158972 9 | -------------------------------------------------------------------------------- /aoc2024/Day21monad.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day21/eg.txt 2 | [("0", 3, 1), ("1", 2, 0), ("2", 2, 1), ("3", 2, 2), ("4", 1, 0), ("5", 1, 1), ("6", 1, 2), ("7", 0, 0), ("8", 0, 1), ("9", 0, 2), ("A", 3, 2)] 3 | part1 126384 4 | part2 154115708116294 5 | aoc2024/day21/input.txt 6 | [("0", 3, 1), ("1", 2, 0), ("2", 2, 1), ("3", 2, 2), ("4", 1, 0), ("5", 1, 1), ("6", 1, 2), ("7", 0, 0), ("8", 0, 1), ("9", 0, 2), ("A", 3, 2)] 7 | part1 248108 8 | part2 303836969158972 9 | -------------------------------------------------------------------------------- /aoc2024/Day22.newt: -------------------------------------------------------------------------------- 1 | module Day22 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | import SortedMap 7 | 8 | 9 | ptype BigInt 10 | pfunc itobi : Int → BigInt := `(x) => BigInt(x)` 11 | pfunc bitoi : BigInt → Int := `(x) => Number(x)` 12 | pfunc addbi : BigInt → BigInt → BigInt := `(a,b) => a + b` 13 | pfunc subbi : BigInt → BigInt → BigInt := `(a,b) => a - b` 14 | pfunc mulbi : BigInt → BigInt → BigInt := `(a,b) => a * b` 15 | pfunc divbi : BigInt → BigInt → BigInt := `(a,b) => a / b` 16 | pfunc shlbi : BigInt → BigInt → BigInt := `(a,b) => a << b` 17 | pfunc shrbi : BigInt → BigInt → BigInt := `(x,y) => x >> y` 18 | 19 | instance Mul BigInt where a * b = mulbi a b 20 | instance Div BigInt where a / b = divbi a b 21 | instance Add BigInt where a + b = addbi a b 22 | instance Sub BigInt where a - b = subbi a b 23 | instance Cast Int BigInt where cast x = itobi x 24 | instance Eq BigInt where a == b = jsEq a b 25 | instance Show BigInt where show = jsShow 26 | instance Ord BigInt where compare a b = jsCompare a b 27 | 28 | infixl 7 _%_ 29 | pfunc _%_ : BigInt → BigInt → BigInt := `(x,y) => x % y` 30 | pfunc bxor : BigInt → BigInt → BigInt := `(x,y) => x ^ y` 31 | 32 | modulus : BigInt 33 | modulus = itobi 16777216 34 | 35 | b5 b6 b10 b11 : BigInt 36 | b10 = itobi 10 37 | b5 = itobi 5 38 | b6 = itobi 6 39 | b11 = itobi 11 40 | 41 | step : BigInt → BigInt 42 | step s = 43 | let s = bxor (shlbi s b6) s % modulus in 44 | let s = bxor (shrbi s b5) s % modulus in 45 | let s = bxor (shlbi s b11) s % modulus in 46 | s 47 | 48 | -- for part1 49 | stepN : Int → BigInt → BigInt 50 | stepN 0 s = s 51 | stepN n s = stepN (n - 1) (step s) 52 | 53 | Key KeyMap : U 54 | Key = (Int × Int × Int × Int) 55 | KeyMap = SortedMap Key Int 56 | 57 | bananas : Int → BigInt → SnocList Int → List Int 58 | bananas 0 s acc = acc <>> Nil 59 | bananas n s acc = 60 | let s' = step s 61 | b = bitoi (s' % b10) 62 | in bananas (n - 1) s' (acc :< b) 63 | 64 | build : List Int → List (Key × Int) 65 | build (a :: rest@(b :: c :: d :: e :: _)) = ((b - a, c - b, d - c, e - d), e) :: build rest 66 | build _ = Nil 67 | 68 | makeMap : BigInt -> KeyMap 69 | makeMap s = foldMap const EmptyMap $ build $ bananas 2000 s Lin 70 | 71 | max : Int → Int → Int 72 | max a b = if a < b then b else a 73 | 74 | run : String -> IO Unit 75 | run fn = do 76 | putStrLn fn 77 | text <- readFile fn 78 | let numbers = map (itobi ∘ stringToInt) $ split (trim text) "\n" 79 | let p1 = foldl _+_ (itobi 0) $ map (stepN 2000) numbers 80 | putStrLn $ "part1 " ++ show p1 81 | 82 | let final = foldMap _+_ EmptyMap $ join $ map toList $ map makeMap numbers 83 | let p2 = foldl max 0 $ map snd $ toList final 84 | putStrLn $ "part2 " ++ show p2 85 | 86 | main : IO Unit 87 | main = do 88 | -- run "aoc2024/day22/eg.txt" 89 | run "aoc2024/day22/eg2.txt" 90 | run "aoc2024/day22/input.txt" 91 | -------------------------------------------------------------------------------- /aoc2024/Day22.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day22/eg2.txt 2 | part1 37990510 3 | part2 23 4 | aoc2024/day22/input.txt 5 | part1 13429191512 6 | part2 1582 7 | -------------------------------------------------------------------------------- /aoc2024/Day22b.newt: -------------------------------------------------------------------------------- 1 | module Day22b 2 | 3 | -- Changed to use an Int rather than Int × Int × Int × Int 4 | -- as the key to the map, went from 30 to 7 seconds. 5 | 6 | import Prelude 7 | import Node 8 | import Aoc 9 | import SortedMap 10 | 11 | 12 | ptype BigInt 13 | pfunc itobi : Int → BigInt := `(x) => BigInt(x)` 14 | pfunc bitoi : BigInt → Int := `(x) => Number(x)` 15 | pfunc addbi : BigInt → BigInt → BigInt := `(a,b) => a + b` 16 | pfunc subbi : BigInt → BigInt → BigInt := `(a,b) => a - b` 17 | pfunc mulbi : BigInt → BigInt → BigInt := `(a,b) => a * b` 18 | pfunc divbi : BigInt → BigInt → BigInt := `(a,b) => a / b` 19 | pfunc shlbi : BigInt → BigInt → BigInt := `(a,b) => a << b` 20 | pfunc shrbi : BigInt → BigInt → BigInt := `(x,y) => x >> y` 21 | 22 | instance Mul BigInt where a * b = mulbi a b 23 | instance Div BigInt where a / b = divbi a b 24 | instance Add BigInt where a + b = addbi a b 25 | instance Sub BigInt where a - b = subbi a b 26 | instance Cast Int BigInt where cast x = itobi x 27 | instance Eq BigInt where a == b = jsEq a b 28 | instance Show BigInt where show = jsShow 29 | instance Ord BigInt where compare a b = jsCompare a b 30 | 31 | -- base: 30s 32 | -- switching from tuple to int: 8 s 33 | 34 | infixl 7 _%_ 35 | pfunc _%_ : BigInt → BigInt → BigInt := `(x,y) => x % y` 36 | pfunc bxor : BigInt → BigInt → BigInt := `(x,y) => x ^ y` 37 | 38 | modulus : BigInt 39 | modulus = itobi 16777216 40 | 41 | b5 b6 b10 b11 : BigInt 42 | b10 = itobi 10 43 | b5 = itobi 5 44 | b6 = itobi 6 45 | b11 = itobi 11 46 | 47 | hash : Int → Int → Int → Int → Int 48 | hash a b c d = (a + 10) + (b + 10) * 20 + (c + 10) * 400 + (d + 10) * 8000 49 | 50 | step : BigInt → BigInt 51 | step s = 52 | let s = bxor (shlbi s b6) s % modulus in 53 | let s = bxor (shrbi s b5) s % modulus in 54 | let s = bxor (shlbi s b11) s % modulus in 55 | s 56 | 57 | -- for part1 58 | stepN : Int → BigInt → BigInt 59 | stepN 0 s = s 60 | stepN n s = stepN (n - 1) (step s) 61 | 62 | Key KeyMap : U 63 | Key = Int 64 | KeyMap = SortedMap Key Int 65 | 66 | bananas : Int → BigInt → SnocList Int → List Int 67 | bananas 0 s acc = acc <>> Nil 68 | bananas n s acc = 69 | let s' = step s 70 | b = bitoi (s' % b10) 71 | in bananas (n - 1) s' (acc :< b) 72 | 73 | build : List Int → List (Key × Int) 74 | build (a :: rest@(b :: c :: d :: e :: _)) = ((hash (b - a) (c - b) (d - c) (e - d)), e) :: build rest 75 | build _ = Nil 76 | 77 | makeMap : BigInt -> KeyMap 78 | makeMap s = foldMap const EmptyMap $ build $ bananas 2000 s Lin 79 | 80 | max : Int → Int → Int 81 | max a b = if a < b then b else a 82 | 83 | run : String -> IO Unit 84 | run fn = do 85 | putStrLn fn 86 | text <- readFile fn 87 | let numbers = map (itobi ∘ stringToInt) $ split (trim text) "\n" 88 | let p1 = foldl _+_ (itobi 0) $ map (stepN 2000) numbers 89 | putStrLn $ "part1 " ++ show p1 90 | 91 | let final = foldMap _+_ EmptyMap $ join $ map toList $ map makeMap numbers 92 | let p2 = foldl max 0 $ map snd $ toList final 93 | putStrLn $ "part2 " ++ show p2 94 | 95 | main : IO Unit 96 | main = do 97 | -- run "aoc2024/day22/eg.txt" 98 | run "aoc2024/day22/eg2.txt" 99 | run "aoc2024/day22/input.txt" 100 | -------------------------------------------------------------------------------- /aoc2024/Day22b.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day22/eg2.txt 2 | part1 37990510 3 | part2 23 4 | aoc2024/day22/input.txt 5 | part1 13429191512 6 | part2 1582 7 | -------------------------------------------------------------------------------- /aoc2024/Day23.newt: -------------------------------------------------------------------------------- 1 | module Day23 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | import SortedMap 7 | 8 | Graph Edge EdgeSet VSet : U 9 | Graph = SortedMap String (List String) 10 | Edge = String × String 11 | EdgeSet = SortedMap Edge Unit 12 | VSet = SortedMap String Unit 13 | 14 | addEdge : Graph -> String × String -> Graph 15 | addEdge g (a,b) = updateMap a (b :: fromMaybe Nil (snd <$> lookupMap a g)) g 16 | 17 | ppair : String → Maybe Edge 18 | ppair s = case split s "-" of 19 | (a :: b :: Nil) => Just (a, b) 20 | _ => Nothing 21 | 22 | pfile : String → Maybe (List Edge) 23 | pfile text = traverse ppair $ split (trim text) "\n" 24 | 25 | startT : String → Bool 26 | startT s = case unpack s of 27 | ('t' :: _) => True 28 | _ => False 29 | 30 | isJust : ∀ a. Maybe a → Bool 31 | isJust (Just x) = True 32 | isJust _ = False 33 | 34 | checkK3 : Graph → EdgeSet → Edge → Int 35 | checkK3 g es (a,b) = 36 | let cand = fromMaybe Nil $ snd <$> lookupMap b g 37 | cand = if startT a || startT b then cand else filter startT cand 38 | in cast $ length $ filter (\c => isJust $ lookupMap (c,a) es) cand 39 | 40 | isect : List String → List String → List String 41 | isect as bs = filter (flip elem bs) as 42 | 43 | remove : String → List String → List String 44 | remove s Nil = Nil 45 | remove s (x :: xs) = if x == s then xs else x :: remove s xs 46 | 47 | bronKerbosch : Graph → List String → List String → List String → Maybe (List String) 48 | bronKerbosch g rs Nil Nil = Just rs 49 | bronKerbosch g rs Nil xs = Nothing 50 | bronKerbosch g rs (p :: ps) xs = 51 | let np = neighbors p 52 | ps' = p :: filter (\x => not (elem x np)) ps in 53 | foldl best Nothing $ map check ps' 54 | where 55 | neighbors : String → List String 56 | neighbors p = fromMaybe Nil $ snd <$> lookupMap p g 57 | 58 | check : String → Maybe (List String) 59 | check p = let nv = neighbors p in 60 | bronKerbosch g (p :: rs) (isect ps nv) (isect xs nv) 61 | 62 | best : Maybe (List String) → Maybe (List String) → Maybe (List String) 63 | best Nothing Nothing = Nothing 64 | best Nothing a = a 65 | best a Nothing = a 66 | best (Just a) (Just b) = if length a < length b then Just b else Just a 67 | 68 | run : String -> IO Unit 69 | run fn = do 70 | putStrLn fn 71 | text <- readFile fn 72 | let (Just pairs) = pfile text | _ => putStrLn "parse error" 73 | let dpairs = pairs ++ map swap pairs 74 | let g = foldl addEdge EmptyMap dpairs 75 | let es = foldl (\g e => updateMap e MkUnit g) EmptyMap dpairs 76 | putStrLn $ show (length pairs) ++ " pairs" 77 | putStrLn $ show (length dpairs) ++ " dpairs" 78 | 79 | -- one direction, counting each K3 3 times 80 | let p1 = (foldl _+_ 0 $ map (checkK3 g es) pairs) / 3 81 | putStrLn $ "part1 " ++ show p1 82 | let verts = map fst $ toList g 83 | let (Just result) = bronKerbosch g Nil verts Nil | _ => putStrLn "fail" 84 | let p2 = joinBy "," $ qsort _<_ result 85 | 86 | putStrLn $ "part2 " ++ p2 87 | 88 | main : IO Unit 89 | main = do 90 | run "aoc2024/day23/eg.txt" 91 | run "aoc2024/day23/input.txt" 92 | -------------------------------------------------------------------------------- /aoc2024/Day23.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day23/eg.txt 2 | 32 pairs 3 | 64 dpairs 4 | part1 7 5 | part2 co,de,ka,ta 6 | aoc2024/day23/input.txt 7 | 3380 pairs 8 | 6760 dpairs 9 | part1 1170 10 | part2 bo,dd,eq,ik,lo,lu,ph,ro,rr,rw,uo,wx,yg 11 | -------------------------------------------------------------------------------- /aoc2024/Day24.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day24/input.txt 2 | part1 51745744348272 3 | SWAP z18 and hmt 4 | SWAP bfq and z27 5 | SWAP z31 and hkh 6 | SWAP fjp and bng 7 | part2 bfq,bng,fjp,hkh,hmt,z18,z27,z31 8 | 9 | -------------------------------------------------------------------------------- /aoc2024/Day25.newt: -------------------------------------------------------------------------------- 1 | module Day25 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | 7 | data Chunk : U where 8 | Key : List Int → Chunk 9 | Lock : List Int → Chunk 10 | 11 | -- cribbed from the idris library, it's late and I don't want to work thisout 12 | transpose : ∀ a. List (List a) → List (List a) 13 | transpose Nil = Nil 14 | transpose {a} (heads :: tails) = spreadHeads heads (transpose tails) 15 | where 16 | spreadHeads : List a → List (List a) → List (List a) 17 | spreadHeads Nil tails = tails 18 | spreadHeads (head :: heads) Nil = (head :: Nil) :: spreadHeads heads Nil 19 | spreadHeads (head :: heads) (tail :: tails) = (head :: tail) :: spreadHeads heads tails 20 | 21 | count : List Char → Int 22 | count cs = go cs 0 23 | where 24 | go : List Char → Int → Int 25 | go ('#' :: cs) acc = go cs (1 + acc) 26 | go _ acc = acc 27 | 28 | toChunk : List (List Char) → Chunk 29 | 30 | parseChunk : String → Chunk 31 | parseChunk text = 32 | let stuff = transpose $ map unpack $ split text "\n" in 33 | -- TODO - sort this out 34 | case map {List} count stuff of 35 | 0 :: xs => Key $ map (count ∘ reverse) stuff 36 | xs => Lock xs 37 | 38 | 39 | parseFile : String → List Chunk 40 | parseFile text = do 41 | let parts = split (trim text) "\n\n" 42 | map parseChunk parts 43 | 44 | splitKeys : List Chunk → List (List Int) → List (List Int) → List (List Int) × List (List Int) 45 | splitKeys (Lock xs :: rest) locks keys = splitKeys rest (xs :: locks) keys 46 | splitKeys (Key xs :: rest) locks keys = splitKeys rest locks (xs :: keys) 47 | splitKeys Nil locks keys = (locks, keys) 48 | 49 | check : List Int → List Int → Int 50 | check Nil Nil = 1 51 | check (a :: as) (b :: bs) = if a + b <= 7 then check as bs else 0 52 | check _ _ = 0 53 | 54 | run : String -> IO Unit 55 | run fn = do 56 | putStrLn fn 57 | text <- readFile fn 58 | let chunks = parseFile text 59 | let (locks,keys) = splitKeys chunks Nil Nil 60 | debugLog (length locks, length keys) 61 | let p1 = foldl _+_ 0 $ map (\ l => foldl _+_ 0 $ map (check l) keys) locks 62 | putStrLn $ "part1 " ++ show p1 63 | 64 | main : IO Unit 65 | main = do 66 | run "aoc2024/day25/eg.txt" 67 | run "aoc2024/day25/input.txt" 68 | -------------------------------------------------------------------------------- /aoc2024/Day25.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day25/eg.txt 2 | (2, 3) 3 | part1 3 4 | aoc2024/day25/input.txt 5 | (250, 250) 6 | part1 3397 7 | -------------------------------------------------------------------------------- /aoc2024/Day3.newt: -------------------------------------------------------------------------------- 1 | module Day3 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | 7 | Parser : U → U 8 | Parser a = List Char → Maybe (a × List Char) 9 | 10 | instance Monad Parser where 11 | pure a = \ cs => Just (a, cs) 12 | bind ma mab = \ cs => ma cs >>= uncurry mab 13 | 14 | instance Alternative Parser where 15 | pa <|> pb = \ cs => case pa cs of 16 | Nothing => pb cs 17 | res => res 18 | 19 | fail : ∀ a. Parser a 20 | fail = \ cs => Nothing 21 | 22 | satisfy : (Char → Bool) → Parser Char 23 | satisfy pred = λ cs => case cs of 24 | Nil => Nothing 25 | (c :: cs) => if pred c then Just (c, cs) else Nothing 26 | 27 | match : Char → Parser Char 28 | match d = satisfy (_==_ d) 29 | 30 | any : Parser Char 31 | any = satisfy (λ _ => True) 32 | 33 | some many : ∀ a. Parser a → Parser (List a) 34 | many p = some p <|> pure Nil 35 | some p = do 36 | v <- p 37 | vs <- many p 38 | pure (v :: vs) 39 | 40 | pnum : Parser Int 41 | pnum = do 42 | chars <- many (satisfy isDigit) 43 | if S (S (S Z)) < length chars then fail 44 | else pure $ stringToInt $ pack chars 45 | 46 | data Inst : U where 47 | Mult : Int → Int → Inst 48 | Do : Inst 49 | Dont : Inst 50 | 51 | mul : Parser Inst 52 | mul = do 53 | match 'm' 54 | match 'u' 55 | match 'l' 56 | match '(' 57 | x <- pnum 58 | match ',' 59 | y <- pnum 60 | match ')' 61 | pure $ Mult x y 62 | 63 | pdo : Parser Inst 64 | pdo = do 65 | match 'd' 66 | match 'o' 67 | match '(' 68 | match ')' 69 | pure Do 70 | 71 | pdont : Parser Inst 72 | pdont = do 73 | match 'd' 74 | match 'o' 75 | match 'n' 76 | match '\'' 77 | match 't' 78 | match '(' 79 | match ')' 80 | pure Dont 81 | 82 | some' many' : ∀ a. Parser a → Parser (List a) 83 | many' p = do 84 | pure MkUnit 85 | some' p <|> (any >> many' p) <|> pure Nil 86 | 87 | some' p = do 88 | v <- p 89 | vs <- many' p 90 | pure (v :: vs) 91 | 92 | inst : Parser Inst 93 | inst = mul <|> pdo <|> pdont 94 | 95 | pfile : Parser (List Inst) 96 | pfile = many' inst 97 | 98 | value : Inst → Int 99 | value (Mult x y) = x * y 100 | value _ = 0 101 | 102 | part2 : List Inst → Bool → Int → Int 103 | part2 Nil _ acc = acc 104 | part2 (Do :: insts) _ acc = part2 insts True acc 105 | part2 (Dont :: insts) _ acc = part2 insts False acc 106 | part2 (_ :: insts) False acc = part2 insts False acc 107 | part2 (Mult x y :: insts) True acc = part2 insts True (acc + x * y) 108 | 109 | run : String → IO Unit 110 | run fn = do 111 | putStrLn fn 112 | text <- trim <$> readFile fn 113 | let (Just (insts, Nil)) = pfile (unpack text) | _ => putStrLn "parse failed" 114 | let part1 = foldl _+_ 0 $ map value insts 115 | putStrLn $ "part1 " ++ show part1 116 | putStrLn $ "part2 " ++ show (part2 insts True 0) 117 | 118 | main : IO Unit 119 | main = do 120 | run "aoc2024/day3/eg.txt" 121 | run "aoc2024/day3/input.txt" 122 | -------------------------------------------------------------------------------- /aoc2024/Day3.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day3/eg.txt 2 | part1 161 3 | part2 161 4 | aoc2024/day3/input.txt 5 | part1 164730528 6 | part2 70478672 7 | -------------------------------------------------------------------------------- /aoc2024/Day4.newt: -------------------------------------------------------------------------------- 1 | module Day4 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | 7 | data Problem : U where 8 | P : Int → String → Problem 9 | 10 | get : Problem → Int → Int → Char 11 | get (P size text) r c = 12 | if r < 0 || size <= r then '.' 13 | else if c < 0 || size <= c then '.' 14 | else sindex text (r * (size + 1) + c) 15 | 16 | check : Problem → Int → Int → Int × Int → Int 17 | check prob r c (dr,dc) = 18 | if (get prob r c) /= 'X' then 0 19 | else if (get prob (r + dr) (c + dc)) /= 'M' then 0 20 | else if (get prob (r + 2 * dr) (c + 2 * dc)) /= 'A' then 0 21 | else if (get prob (r + 3 * dr) (c + 3 * dc)) /= 'S' then 0 22 | else 1 23 | 24 | dirs : List (Int × Int) 25 | dirs = tail $ _,_ <$> 0 :: 0 - 1 :: 1 :: Nil <*> 0 :: 0 - 1 :: 1 :: Nil 26 | 27 | part1 : Problem → Int 28 | part1 (P size text) = go 0 0 0 29 | where 30 | go : Int → Int → Int → Int 31 | go acc r c = 32 | if r == size then acc else 33 | if c == size then go acc (r + 1) 0 else 34 | let acc = foldl _+_ acc $ map (check (P size text) r c) dirs in 35 | go acc r (c + 1) 36 | 37 | pats : List (Char × Char × Char × Char) 38 | pats = ('M', 'M', 'S', 'S') :: 39 | ('S', 'M', 'M', 'S') :: 40 | ('S', 'S', 'M', 'M') :: 41 | ('M', 'S', 'S', 'M') :: 42 | Nil 43 | 44 | check2 : Problem → Int → Int → (Char × Char × Char × Char) → Int 45 | check2 prob r c (w,x,y,z) = 46 | if (get prob r c) /= 'A' then 0 47 | else if (get prob (r - 1) (c - 1)) /= w then 0 48 | else if (get prob (r - 1) (c + 1)) /= x then 0 49 | else if (get prob (r + 1) (c + 1)) /= y then 0 50 | else if (get prob (r + 1) (c - 1)) /= z then 0 51 | else 1 52 | 53 | part2 : Problem → Int 54 | part2 (P size text) = go 0 0 0 55 | where 56 | go : Int → Int → Int → Int 57 | go acc r c = 58 | if r == size then acc else 59 | if c == size then go acc (r + 1) 0 else 60 | let acc = foldl _+_ acc $ map (check2 (P size text) r c) pats in 61 | go acc r (c + 1) 62 | 63 | run : String -> IO Unit 64 | run fn = do 65 | putStrLn fn 66 | text <- readFile fn 67 | let lines = split (trim text) "\n" 68 | -- I'm going to assume it's square for convenience 69 | let size = length lines 70 | printLn $ "part1 " ++ show (part1 $ P (cast size) text) 71 | printLn $ "part2 " ++ show (part2 $ P (cast size) text) 72 | 73 | main : IO Unit 74 | main = do 75 | run "aoc2024/day4/eg.txt" 76 | run "aoc2024/day4/input.txt" 77 | -------------------------------------------------------------------------------- /aoc2024/Day4.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day4/eg.txt 2 | part1 18 3 | part2 9 4 | aoc2024/day4/input.txt 5 | part1 2591 6 | part2 1880 7 | -------------------------------------------------------------------------------- /aoc2024/Day5.newt: -------------------------------------------------------------------------------- 1 | module Day5 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | import SortedMap 7 | 8 | data Prob : U where 9 | MkProb : List (Int × Int) -> List (List Int) → Prob 10 | 11 | parseRule : String → Maybe (Int × Int) 12 | parseRule txt = 13 | let (a :: b :: Nil) = nums' "|" txt | _ => Nothing 14 | in Just (a,b) 15 | 16 | parse : String → Maybe Prob 17 | parse text = do 18 | let (a :: b :: Nil) = split (trim text) "\n\n" | pts => Nothing 19 | rules <- traverse parseRule $ split a "\n" 20 | let updates = map (nums' ",") $ split b "\n" 21 | Just $ MkProb rules updates 22 | 23 | RuleMap : U 24 | RuleMap = SortedMap Int (List Int) 25 | 26 | getDisallowed : Int → RuleMap → List Int 27 | getDisallowed key rmap = fromMaybe Nil (map snd $ lookupMap key rmap) 28 | 29 | mkRuleMap : List (Int × Int) -> RuleMap 30 | mkRuleMap rules = foldl go EmptyMap rules 31 | where 32 | go : RuleMap → Int × Int → RuleMap 33 | go rmap (b,a) = updateMap a (b :: getDisallowed a rmap) rmap 34 | 35 | scan : RuleMap → List Int -> List Int -> Bool 36 | scan rmap interdit Nil = True 37 | scan rmap interdit (x :: xs) = 38 | if elem x interdit then False 39 | else scan rmap (getDisallowed x rmap ++ interdit) xs 40 | 41 | fix : RuleMap → List Int → List Int 42 | fix rmap Nil = Nil 43 | fix rmap (x :: xs) = 44 | let interdit = getDisallowed x rmap in 45 | let (prefix,rest) = partition (flip elem interdit) xs 46 | in case prefix of 47 | Nil => x :: fix rmap rest 48 | ys => fix rmap (ys ++ x :: rest) 49 | 50 | middle : List Int -> Int 51 | middle xs = go xs xs 52 | where 53 | go : List Int → List Int → Int 54 | go (x :: xs) (_ :: _ :: ys) = go xs ys 55 | go (x :: xs) (_ :: ys) = x 56 | go _ _ = 0 57 | 58 | run : String -> IO Unit 59 | run fn = do 60 | putStrLn fn 61 | text <- readFile fn 62 | let (Just prob) = parse text | _ => putStrLn "Parse Error" 63 | let (MkProb rules things) = prob 64 | let rmap = mkRuleMap rules 65 | let good = filter (scan rmap Nil) things 66 | let part1 = foldl _+_ 0 $ map middle good 67 | let bad = filter (not ∘ scan rmap Nil) things 68 | putStrLn $ "part1 " ++ show part1 69 | let fixed = map (fix rmap) bad 70 | printLn $ length bad 71 | let part2 = foldl _+_ 0 $ map middle fixed 72 | putStrLn $ "part2 " ++ show part2 73 | 74 | main : IO Unit 75 | main = do 76 | run "aoc2024/day5/eg.txt" 77 | run "aoc2024/day5/input.txt" 78 | -------------------------------------------------------------------------------- /aoc2024/Day5.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day5/eg.txt 2 | part1 143 3 | 3 4 | part2 123 5 | aoc2024/day5/input.txt 6 | part1 5268 7 | 107 8 | part2 5799 9 | -------------------------------------------------------------------------------- /aoc2024/Day6.newt: -------------------------------------------------------------------------------- 1 | module Day6 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | import SortedMap 7 | 8 | Grid : U 9 | Grid = SortedMap Point Char 10 | 11 | loadData : String → Grid 12 | loadData text = go (unpack text) 0 0 EmptyMap 13 | where 14 | go : List Char → Int → Int → SortedMap Point Char → SortedMap Point Char 15 | go Nil r c map = map 16 | go ('\n' :: cs) r c map = go cs (r + 1) 0 map 17 | go (x :: xs) r c map = go xs r (c + 1) $ updateMap (r,c) x map 18 | 19 | data Dir : U where North East South West : Dir 20 | 21 | instance Show Dir where 22 | show North = "N" 23 | show East = "E" 24 | show South = "S" 25 | show West = "W" 26 | 27 | instance Eq Dir where 28 | a == b = show a == show b 29 | 30 | instance Ord Dir where 31 | compare a b = compare (show a) (show b) 32 | 33 | Done : U 34 | Done = SortedMap (Point × Dir) Unit 35 | 36 | turn : Dir → Dir 37 | turn North = East 38 | turn East = South 39 | turn South = West 40 | turn West = North 41 | 42 | instance Cast Dir Char where 43 | cast North = '^' 44 | cast East = '>' 45 | cast South = 'v' 46 | cast West = '<' 47 | 48 | step : Dir → Point → Point 49 | step North (r, c) = (r - 1, c) 50 | step East (r, c) = (r, c + 1) 51 | step South (r, c) = (r + 1, c) 52 | step West (r, c) = (r, c - 1) 53 | 54 | bad : Point → Bool 55 | bad (x,y) = x < 0 || y < 0 56 | 57 | -- third is 58 | walk : Dir → Point → Grid → Grid 59 | walk dir pos grid = 60 | let grid = updateMap pos 'X' grid in 61 | let pos' = step dir pos in 62 | case lookupMap pos' grid of 63 | Just (_, '#') => walk (turn dir) pos grid 64 | Nothing => grid 65 | _ => walk dir pos' grid 66 | 67 | checkLoop : Grid → Done → Dir → Point → Bool 68 | checkLoop grid done dir pos = 69 | let (Nothing) = lookupMap (pos,dir) done | _ => True in 70 | let done = updateMap (pos, dir) MkUnit done 71 | pos' = step dir pos 72 | in case lookupMap pos' grid of 73 | Nothing => False 74 | Just (_, '#') => checkLoop grid done (turn dir) pos 75 | Just _ => checkLoop grid done dir pos' 76 | 77 | part2 : Dir → Point → Grid → Done → List Point → List Point 78 | part2 dir pos grid done sol = 79 | let done = updateMap (pos, dir) MkUnit done 80 | grid = updateMap pos 'X' grid 81 | turnDir = turn dir 82 | turnPos = step turnDir pos 83 | pos' = step dir pos in 84 | case lookupMap pos' grid of 85 | Nothing => sol 86 | Just (_, '#') => part2 (turn dir) pos grid done sol 87 | Just (_, 'X') => part2 dir pos' grid done sol 88 | Just (_, '.') => if checkLoop (updateMap pos' '#' grid) done turnDir pos 89 | then part2 dir pos' grid done (pos' :: sol) 90 | else part2 dir pos' grid done sol 91 | Just x => part2 (trace ("WAT " ++ debugStr x) dir) pos' grid done sol 92 | 93 | lookupV : ∀ a. Char → List (a × Char) → Maybe a 94 | lookupV _ Nil = Nothing 95 | lookupV needle ((k,v) :: rest) = 96 | if v == needle then Just k else lookupV needle rest 97 | 98 | run : String -> IO Unit 99 | run fn = do 100 | putStrLn fn 101 | text <- readFile fn 102 | let grid = loadData text 103 | let (Just pos) = lookupV '^' (toList grid) | _ => putStrLn "no guard" 104 | let grid' = walk North pos grid 105 | let xs = filter (\ x => 'X' == snd x) $ toList grid' 106 | let part1 = length xs 107 | putStrLn $ "part1 " ++ show part1 108 | 109 | let cands = part2 North pos grid EmptyMap Nil 110 | -- debugLog $ length cands -- turns out nub isn't needed for these cases, but we'll leave it in 111 | putStrLn $ "part2 " ++ show (length $ ordNub cands) 112 | printLn $ length $ toList grid 113 | 114 | main : IO Unit 115 | main = do 116 | run "aoc2024/day6/eg.txt" 117 | run "aoc2024/day6/input.txt" 118 | -------------------------------------------------------------------------------- /aoc2024/Day6.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day6/eg.txt 2 | part1 41 3 | part2 6 4 | 100 5 | aoc2024/day6/input.txt 6 | part1 5331 7 | part2 1812 8 | 16900 9 | -------------------------------------------------------------------------------- /aoc2024/Day7.newt: -------------------------------------------------------------------------------- 1 | module Day7 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | 7 | Prob : U 8 | Prob = Int × List Int 9 | 10 | cases : Int → Int → List Int → Bool 11 | cases goal acc Nil = goal == acc 12 | cases goal acc (x :: xs) = 13 | if goal < acc then False 14 | else if cases goal (x + acc) xs then True 15 | else cases goal (x * acc) xs 16 | 17 | part1 : Prob → Bool 18 | part1 (goal, x :: xs) = cases goal x xs 19 | part1 _ = False 20 | 21 | cat : Int → Int → Int 22 | cat x y = stringToInt $ show x ++ show y 23 | 24 | cases2 : Int → Int → List Int → Bool 25 | cases2 goal acc Nil = goal == acc 26 | cases2 goal acc (x :: xs) = 27 | if goal < acc then False 28 | else if cases2 goal (x + acc) xs then True 29 | else if cases2 goal (x * acc) xs then True 30 | else cases2 goal (cat acc x) xs 31 | 32 | part2 : Prob → Bool 33 | part2 (goal, x :: xs) = cases2 goal x xs 34 | part2 _ = False 35 | 36 | parse : String -> Maybe (List Prob) 37 | parse text = do 38 | traverse parseLine $ split (trim text) "\n" 39 | where 40 | parseLine : String → Maybe Prob 41 | parseLine line = do 42 | let (a :: b :: Nil) = split line ": " | _ => Nothing 43 | Just (stringToInt a , nums b) 44 | 45 | run : String -> IO Unit 46 | run fn = do 47 | putStrLn fn 48 | text <- readFile fn 49 | let (Just probs) = parse text | _ => putStrLn "parse error" 50 | let p1 = foldl _+_ 0 $ map fst $ filter part1 probs 51 | putStrLn $ "part1 " ++ show p1 52 | let p2 = foldl _+_ 0 $ map fst $ filter part2 probs 53 | putStrLn $ "part2 " ++ show p2 54 | 55 | main : IO Unit 56 | main = do 57 | run "aoc2024/day7/eg.txt" 58 | run "aoc2024/day7/input.txt" 59 | -------------------------------------------------------------------------------- /aoc2024/Day7.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day7/eg.txt 2 | part1 3749 3 | part2 11387 4 | aoc2024/day7/input.txt 5 | part1 21572148763543 6 | part2 581941094529163 7 | -------------------------------------------------------------------------------- /aoc2024/Day8.newt: -------------------------------------------------------------------------------- 1 | module Day8 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | import SortedMap 7 | 8 | Ant : U 9 | Ant = Char × Int × Int 10 | 11 | -- This should be a utility... 12 | parse : String → List Ant 13 | parse text = go 0 0 (unpack text) Nil 14 | where 15 | -- might as well be tail recursive 16 | go : Int → Int → List Char → List Ant → List Ant 17 | go row col Nil ants = ants 18 | go row col ('\n' :: cs) ants = go (row + 1) 0 cs ants 19 | go row col (c :: cs) ants = go row (col + 1) cs ((c,row,col) :: ants) 20 | 21 | doPair : Point → Point → List Point 22 | doPair x y = let d = y - x in y + d :: x - d :: Nil 23 | 24 | doGroup : List Ant -> List Point 25 | doGroup (x :: xs) = join $ doGroup xs :: map (doPair (snd x) ∘ snd) xs 26 | doGroup Nil = Nil 27 | 28 | group : List Ant → (List Ant) → List (List Ant) 29 | group (a :: as) Nil = group as (a :: Nil) 30 | group (a :: as) (b :: bs) = 31 | if fst a == fst b 32 | then group as (a :: b :: bs) 33 | else (b :: bs) :: group as (a :: Nil) 34 | group Nil bs = bs :: Nil 35 | 36 | max : Int → Int → Int 37 | max a b = if a < b then b else a 38 | 39 | check : Int → Point → Bool 40 | check mr (r,c) = 0 <= r && 0 <= c && r <= mr && c <= mr 41 | 42 | 43 | doPair2 : Int -> Point → Point → List Point 44 | doPair2 m x y = go x (y - x) ++ go y (x - y) 45 | where 46 | go : Point -> Point -> List Point 47 | go pt d = if check m pt then pt :: go (pt + d) d else Nil 48 | 49 | doGroup2 : Int -> List Ant -> List Point 50 | doGroup2 m (x :: xs) = join $ doGroup2 m xs :: map (doPair2 m (snd x) ∘ snd) xs 51 | doGroup2 m Nil = Nil 52 | 53 | run : String -> IO Unit 54 | run fn = do 55 | putStrLn fn 56 | text <- readFile fn 57 | let points = parse text 58 | let maxrow = trace "maxrow" $ foldl max 0 $ map (fst ∘ snd) points 59 | let maxcol = trace "maxcol" $ foldl max 0 $ map (snd ∘ snd) points 60 | let ants = filter (\ pt => fst pt /= '.') points 61 | let ants = qsort (\ x y => fst x < fst y) ants 62 | let groups = group ants Nil 63 | let stuff = join $ map doGroup groups 64 | let nodes = filter (check maxrow) stuff 65 | 66 | let part1 = length $ ordNub nodes 67 | putStrLn $ "part1 " ++ show part1 68 | 69 | let stuff2 = join $ map (doGroup2 maxrow) groups 70 | let part2 = length $ ordNub stuff2 71 | putStrLn $ "part2 " ++ show part2 72 | 73 | 74 | 75 | 76 | 77 | main : IO Unit 78 | main = do 79 | run "aoc2024/day8/eg.txt" 80 | run "aoc2024/day8/input.txt" 81 | -------------------------------------------------------------------------------- /aoc2024/Day8.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day8/eg.txt 2 | maxrow 11 3 | maxcol 11 4 | part1 14 5 | part2 34 6 | aoc2024/day8/input.txt 7 | maxrow 49 8 | maxcol 49 9 | part1 364 10 | part2 1231 11 | -------------------------------------------------------------------------------- /aoc2024/Day9.newt.golden: -------------------------------------------------------------------------------- 1 | aoc2024/day9/eg.txt 2 | 10 files 3 | part1 1928 4 | part2 2858 5 | aoc2024/day9/input.txt 6 | 10000 files 7 | part1 6283404590840 8 | part2 6304576012713 9 | -------------------------------------------------------------------------------- /aoc2024/DayXX.newt: -------------------------------------------------------------------------------- 1 | module DayXX 2 | 3 | import Prelude 4 | import Node 5 | import Aoc 6 | 7 | 8 | run : String -> IO Unit 9 | run fn = do 10 | putStrLn fn 11 | text <- readFile fn 12 | putStrLn text 13 | 14 | main : IO Unit 15 | main = do 16 | run "aoc2024/dayXX/eg.txt" 17 | run "aoc2024/dayXX/input.txt" 18 | -------------------------------------------------------------------------------- /aoc2024/Node.newt: -------------------------------------------------------------------------------- 1 | ../aoc2023/Node.newt -------------------------------------------------------------------------------- /aoc2024/Parser.newt: -------------------------------------------------------------------------------- 1 | module Parser 2 | 3 | import Prelude 4 | import Aoc 5 | 6 | Parser : U → U 7 | Parser a = List Char → Either String (a × List Char) 8 | 9 | instance Monad Parser where 10 | pure a = \ cs => Right (a, cs) 11 | bind ma mab = \ cs => ma cs >>= uncurry mab 12 | 13 | instance Alternative Parser where 14 | pa <|> pb = \ cs => case pa cs of 15 | Left msg => pb cs 16 | res => res 17 | 18 | instance Functor Parser where 19 | map f pa = \ cs => case pa cs of 20 | Left msg => Left msg 21 | Right (a, cs) => Right (f a, cs) 22 | 23 | instance Applicative Parser where 24 | return a = pure a 25 | pa <*> pb = pa >>= (\ f => map f pb) 26 | 27 | 28 | fail : ∀ a. String -> Parser a 29 | fail msg = \ cs => Left msg 30 | 31 | -- TODO, case builder isn't expanding Parser Unit to count lambdas 32 | eof : Parser Unit 33 | eof = \case 34 | Nil => Right (MkUnit, Nil) 35 | _ => Left "expected eof" 36 | 37 | satisfy : (Char → Bool) → Parser Char 38 | satisfy pred = \case 39 | Nil => Left "unexpected EOF" 40 | (c :: cs) => if pred c then Right (c, cs) else Left ("did not expect " ++ show c) 41 | 42 | match : Char → Parser Char 43 | match d = satisfy (_==_ d) 44 | 45 | any : Parser Char 46 | any = satisfy (λ _ => True) 47 | 48 | some many : ∀ a. Parser a → Parser (List a) 49 | many p = some p <|> pure Nil 50 | some p = do 51 | v <- p 52 | vs <- many p 53 | pure (v :: vs) 54 | 55 | string : String → Parser Unit 56 | string str = go (unpack str) 57 | where 58 | go : List Char → Parser Unit 59 | go Nil = pure MkUnit 60 | go (c :: cs) = match c >> go cs 61 | 62 | number : Parser Int 63 | number = stringToInt ∘ pack <$> some (satisfy isDigit) 64 | -- do 65 | -- digs <- some (satisfy isDigit) 66 | -- pure $ stringToInt $ pack digs 67 | 68 | optional : ∀ a. Parser a → Parser (Maybe a) 69 | optional pa = Just <$> pa <|> pure Nothing 70 | 71 | ws : Parser Unit 72 | ws = many (match ' ') >> pure MkUnit 73 | 74 | token : String → Parser Unit 75 | token str = string str >> ws 76 | -------------------------------------------------------------------------------- /aoc2024/Prelude.newt: -------------------------------------------------------------------------------- 1 | ../newt/Prelude.newt -------------------------------------------------------------------------------- /aoc2024/SortedMap.newt: -------------------------------------------------------------------------------- 1 | ../newt/SortedMap.newt -------------------------------------------------------------------------------- /aoc2024/day1/eg.txt: -------------------------------------------------------------------------------- 1 | 3 4 2 | 4 3 3 | 2 5 4 | 1 3 5 | 3 9 6 | 3 3 -------------------------------------------------------------------------------- /aoc2024/day10/eg.txt: -------------------------------------------------------------------------------- 1 | 0123 2 | 1234 3 | 8765 4 | 9876 5 | -------------------------------------------------------------------------------- /aoc2024/day10/eg2.txt: -------------------------------------------------------------------------------- 1 | ...0... 2 | ...1... 3 | ...2... 4 | 6543456 5 | 7.....7 6 | 8.....8 7 | 9.....9 8 | -------------------------------------------------------------------------------- /aoc2024/day10/eg3.txt: -------------------------------------------------------------------------------- 1 | ..90..9 2 | ...1.98 3 | ...2..7 4 | 6543456 5 | 765.987 6 | 876.... 7 | 987.... 8 | -------------------------------------------------------------------------------- /aoc2024/day10/eg4.txt: -------------------------------------------------------------------------------- 1 | 10..9.. 2 | 2...8.. 3 | 3...7.. 4 | 4567654 5 | ...8..3 6 | ...9..2 7 | .....01 8 | -------------------------------------------------------------------------------- /aoc2024/day10/eg5.txt: -------------------------------------------------------------------------------- 1 | 89010123 2 | 78121874 3 | 87430965 4 | 96549874 5 | 45678903 6 | 32019012 7 | 01329801 8 | 10456732 9 | -------------------------------------------------------------------------------- /aoc2024/day11/eg.txt: -------------------------------------------------------------------------------- 1 | 125 17 2 | -------------------------------------------------------------------------------- /aoc2024/day12/eg.txt: -------------------------------------------------------------------------------- 1 | AAAA 2 | BBCD 3 | BBCC 4 | EEEC 5 | -------------------------------------------------------------------------------- /aoc2024/day12/eg2.txt: -------------------------------------------------------------------------------- 1 | OOOOO 2 | OXOXO 3 | OOOOO 4 | OXOXO 5 | OOOOO -------------------------------------------------------------------------------- /aoc2024/day12/eg3.txt: -------------------------------------------------------------------------------- 1 | RRRRIICCFF 2 | RRRRIICCCF 3 | VVRRRCCFFF 4 | VVRCCCJFFF 5 | VVVVCJJCFE 6 | VVIVCCJJEE 7 | VVIIICJJEE 8 | MIIIIIJJEE 9 | MIIISIJEEE 10 | MMMISSJEEE -------------------------------------------------------------------------------- /aoc2024/day13/eg.txt: -------------------------------------------------------------------------------- 1 | Button A: X+94, Y+34 2 | Button B: X+22, Y+67 3 | Prize: X=8400, Y=5400 4 | 5 | Button A: X+26, Y+66 6 | Button B: X+67, Y+21 7 | Prize: X=12748, Y=12176 8 | 9 | Button A: X+17, Y+86 10 | Button B: X+84, Y+37 11 | Prize: X=7870, Y=6450 12 | 13 | Button A: X+69, Y+23 14 | Button B: X+27, Y+71 15 | Prize: X=18641, Y=10279 16 | -------------------------------------------------------------------------------- /aoc2024/day14/eg.txt: -------------------------------------------------------------------------------- 1 | p=0,4 v=3,-3 2 | p=6,3 v=-1,-3 3 | p=10,3 v=-1,2 4 | p=2,0 v=2,-1 5 | p=0,0 v=1,3 6 | p=3,0 v=-2,-2 7 | p=7,6 v=-1,-3 8 | p=3,0 v=-1,-2 9 | p=9,3 v=2,3 10 | p=7,3 v=-1,2 11 | p=2,4 v=2,-3 12 | p=9,5 v=-3,-3 -------------------------------------------------------------------------------- /aoc2024/day15/eg.txt: -------------------------------------------------------------------------------- 1 | ########## 2 | #..O..O.O# 3 | #......O.# 4 | #.OO..O.O# 5 | #..O@..O.# 6 | #O#..O...# 7 | #O..O..O.# 8 | #.OO.O.OO# 9 | #....O...# 10 | ########## 11 | 12 | ^v>^vv^v>v<>v^v<<><>>v^v^>^<<<><^ 13 | vvv<<^>^v^^><<>>><>^<<><^vv^^<>vvv<>><^^v>^>vv<>v<<<^<^^>>>^<>vv>v^v^<>><>>>><^^>vv>v<^^^>>v^v^<^^>v^^>v^<^v>v<>>v^v^v^^<^^vv< 15 | <>^^^^>>>v^<>vvv^>^^^vv^^>v<^^^^v<>^>vvvv><>>v^<<^^^^^ 16 | ^><^><>>><>^^<<^^v>>><^^>v>>>^v><>^v><<<>vvvv>^<><<>^>< 17 | ^>><>^v<><^vvv<^^<><^v<<<><<<^^<^>>^<<<^>>^v^>>^v>vv>^<<^v<>><<><<>v<^vv<<<>^^v^>^^>>><<^v>>v^v><^^>>^<>vv^ 19 | <><^^>^^^<>^vv<<^><<><<><<<^^<<<^<<>><<><^^^>^^<>^>v<> 20 | ^^>vv<^v^v^<>^^^>>>^^vvv^>vvv<>>>^<^>>>>>^<<^v>^vvv<>^<>< 21 | v^^>>><<^^<>>^v^v^<<>^<^v^v><^<<<><<^vv>>v>v^<<^ -------------------------------------------------------------------------------- /aoc2024/day16/eg.txt: -------------------------------------------------------------------------------- 1 | ############### 2 | #.......#....E# 3 | #.#.###.#.###.# 4 | #.....#.#...#.# 5 | #.###.#####.#.# 6 | #.#.#.......#.# 7 | #.#.#####.###.# 8 | #...........#.# 9 | ###.#.#####.#.# 10 | #...#.....#.#.# 11 | #.#.#.###.#.#.# 12 | #.....#...#.#.# 13 | #.###.#.#.#.#.# 14 | #S..#.....#...# 15 | ############### -------------------------------------------------------------------------------- /aoc2024/day16/eg2.txt: -------------------------------------------------------------------------------- 1 | ################# 2 | #...#...#...#..E# 3 | #.#.#.#.#.#.#.#.# 4 | #.#.#.#...#...#.# 5 | #.#.#.#.###.#.#.# 6 | #...#.#.#.....#.# 7 | #.#.#.#.#.#####.# 8 | #.#...#.#.#.....# 9 | #.#.#####.#.###.# 10 | #.#.#.......#...# 11 | #.#.###.#####.### 12 | #.#.#...#.....#.# 13 | #.#.#.#####.###.# 14 | #.#.#.........#.# 15 | #.#.#.#########.# 16 | #S#.............# 17 | ################# 18 | -------------------------------------------------------------------------------- /aoc2024/day17/eg.txt: -------------------------------------------------------------------------------- 1 | Register A: 729 2 | Register B: 0 3 | Register C: 0 4 | 5 | Program: 0,1,5,4,3,0 6 | -------------------------------------------------------------------------------- /aoc2024/day17/eg2.txt: -------------------------------------------------------------------------------- 1 | Register A: 2024 2 | Register B: 0 3 | Register C: 0 4 | 5 | Program: 0,3,5,4,3,0 6 | -------------------------------------------------------------------------------- /aoc2024/day18/eg.txt: -------------------------------------------------------------------------------- 1 | 5,4 2 | 4,2 3 | 4,5 4 | 3,0 5 | 2,1 6 | 6,3 7 | 2,4 8 | 1,5 9 | 0,6 10 | 3,3 11 | 2,6 12 | 5,1 13 | 1,2 14 | 5,5 15 | 2,5 16 | 6,5 17 | 1,4 18 | 0,4 19 | 6,4 20 | 1,1 21 | 6,1 22 | 1,0 23 | 0,5 24 | 1,6 25 | 2,0 26 | -------------------------------------------------------------------------------- /aoc2024/day19/eg.txt: -------------------------------------------------------------------------------- 1 | r, wr, b, g, bwu, rb, gb, br 2 | 3 | brwrr 4 | bggr 5 | gbbr 6 | rrbgbr 7 | ubwu 8 | bwurrg 9 | brgr 10 | bbrgwb 11 | -------------------------------------------------------------------------------- /aoc2024/day2/eg.txt: -------------------------------------------------------------------------------- 1 | 7 6 4 2 1 2 | 1 2 7 8 9 3 | 9 7 6 2 1 4 | 1 3 2 4 5 5 | 8 6 4 4 1 6 | 1 3 6 7 9 7 | -------------------------------------------------------------------------------- /aoc2024/day20/eg.txt: -------------------------------------------------------------------------------- 1 | ############### 2 | #...#...#.....# 3 | #.#.#.#.#.###.# 4 | #S#...#.#.#...# 5 | #######.#.#.### 6 | #######.#.#...# 7 | #######.#.###.# 8 | ###..E#...#...# 9 | ###.#######.### 10 | #...###...#...# 11 | #.#####.#.###.# 12 | #.#...#.#.#...# 13 | #.#.#.#.#.#.### 14 | #...#...#...### 15 | ############### 16 | -------------------------------------------------------------------------------- /aoc2024/day21/eg.txt: -------------------------------------------------------------------------------- 1 | 029A 2 | 980A 3 | 179A 4 | 456A 5 | 379A 6 | -------------------------------------------------------------------------------- /aoc2024/day22/eg.txt: -------------------------------------------------------------------------------- 1 | 1 2 | 10 3 | 100 4 | 2024 -------------------------------------------------------------------------------- /aoc2024/day22/eg2.txt: -------------------------------------------------------------------------------- 1 | 1 2 | 2 3 | 3 4 | 2024 5 | -------------------------------------------------------------------------------- /aoc2024/day23/eg.txt: -------------------------------------------------------------------------------- 1 | kh-tc 2 | qp-kh 3 | de-cg 4 | ka-co 5 | yn-aq 6 | qp-ub 7 | cg-tb 8 | vc-aq 9 | tb-ka 10 | wh-tc 11 | yn-cg 12 | kh-ub 13 | ta-co 14 | de-co 15 | tc-td 16 | tb-wq 17 | wh-td 18 | ta-ka 19 | td-qp 20 | aq-cg 21 | wq-ub 22 | ub-vc 23 | de-ta 24 | wq-aq 25 | wq-vc 26 | wh-yn 27 | ka-de 28 | kh-ta 29 | co-tc 30 | wh-qp 31 | tb-vc 32 | td-yn 33 | -------------------------------------------------------------------------------- /aoc2024/day24/eg.txt: -------------------------------------------------------------------------------- 1 | x00: 1 2 | x01: 1 3 | x02: 1 4 | y00: 0 5 | y01: 1 6 | y02: 0 7 | 8 | x00 AND y00 -> z00 9 | x01 XOR y01 -> z01 10 | x02 OR y02 -> z02 11 | -------------------------------------------------------------------------------- /aoc2024/day24/eg2.txt: -------------------------------------------------------------------------------- 1 | x00: 1 2 | x01: 0 3 | x02: 1 4 | x03: 1 5 | x04: 0 6 | y00: 1 7 | y01: 1 8 | y02: 1 9 | y03: 1 10 | y04: 1 11 | 12 | ntg XOR fgs -> mjb 13 | y02 OR x01 -> tnw 14 | kwq OR kpj -> z05 15 | x00 OR x03 -> fst 16 | tgd XOR rvg -> z01 17 | vdt OR tnw -> bfw 18 | bfw AND frj -> z10 19 | ffh OR nrd -> bqk 20 | y00 AND y03 -> djm 21 | y03 OR y00 -> psh 22 | bqk OR frj -> z08 23 | tnw OR fst -> frj 24 | gnj AND tgd -> z11 25 | bfw XOR mjb -> z00 26 | x03 OR x00 -> vdt 27 | gnj AND wpb -> z02 28 | x04 AND y00 -> kjc 29 | djm OR pbm -> qhw 30 | nrd AND vdt -> hwm 31 | kjc AND fst -> rvg 32 | y04 OR y02 -> fgs 33 | y01 AND x02 -> pbm 34 | ntg OR kjc -> kwq 35 | psh XOR fgs -> tgd 36 | qhw XOR tgd -> z09 37 | pbm OR djm -> kpj 38 | x03 XOR y03 -> ffh 39 | x00 XOR y04 -> ntg 40 | bfw OR bqk -> z06 41 | nrd XOR fgs -> wpb 42 | frj XOR qhw -> z04 43 | bqk OR frj -> z07 44 | y03 OR x01 -> nrd 45 | hwm AND bqk -> z03 46 | tgd XOR rvg -> z12 47 | tnw OR pbm -> gnj 48 | -------------------------------------------------------------------------------- /aoc2024/day24/eg3.txt: -------------------------------------------------------------------------------- 1 | x00: 0 2 | x01: 1 3 | x02: 0 4 | x03: 1 5 | x04: 0 6 | x05: 1 7 | y00: 0 8 | y01: 0 9 | y02: 1 10 | y03: 1 11 | y04: 0 12 | y05: 1 13 | 14 | x00 AND y00 -> z05 15 | x01 AND y01 -> z02 16 | x02 AND y02 -> z01 17 | x03 AND y03 -> z03 18 | x04 AND y04 -> z04 19 | x05 AND y05 -> z00 -------------------------------------------------------------------------------- /aoc2024/day25/eg.txt: -------------------------------------------------------------------------------- 1 | ##### 2 | .#### 3 | .#### 4 | .#### 5 | .#.#. 6 | .#... 7 | ..... 8 | 9 | ##### 10 | ##.## 11 | .#.## 12 | ...## 13 | ...#. 14 | ...#. 15 | ..... 16 | 17 | ..... 18 | #.... 19 | #.... 20 | #...# 21 | #.#.# 22 | #.### 23 | ##### 24 | 25 | ..... 26 | ..... 27 | #.#.. 28 | ###.. 29 | ###.# 30 | ###.# 31 | ##### 32 | 33 | ..... 34 | ..... 35 | ..... 36 | #.... 37 | #.#.. 38 | #.#.# 39 | ##### 40 | -------------------------------------------------------------------------------- /aoc2024/day3/eg.txt: -------------------------------------------------------------------------------- 1 | xmul(2,4)%&mul[3,7]!@^do_not_mul(5,5)+mul(32,64]then(mul(11,8)mul(8,5)) 2 | -------------------------------------------------------------------------------- /aoc2024/day4/eg.txt: -------------------------------------------------------------------------------- 1 | MMMSXXMASM 2 | MSAMXMSMSA 3 | AMXSXMAAMM 4 | MSAMASMSMX 5 | XMASAMXAMM 6 | XXAMMXXAMA 7 | SMSMSASXSS 8 | SAXAMASAAA 9 | MAMMMXMMMM 10 | MXMXAXMASX 11 | 12 | -------------------------------------------------------------------------------- /aoc2024/day5/eg.txt: -------------------------------------------------------------------------------- 1 | 47|53 2 | 97|13 3 | 97|61 4 | 97|47 5 | 75|29 6 | 61|13 7 | 75|53 8 | 29|13 9 | 97|29 10 | 53|29 11 | 61|53 12 | 97|53 13 | 61|29 14 | 47|13 15 | 75|47 16 | 97|75 17 | 47|61 18 | 75|61 19 | 47|29 20 | 75|13 21 | 53|13 22 | 23 | 75,47,61,53,29 24 | 97,61,53,29,13 25 | 75,29,13 26 | 75,97,47,61,53 27 | 61,13,29 28 | 97,13,75,29,47 29 | -------------------------------------------------------------------------------- /aoc2024/day6/eg.txt: -------------------------------------------------------------------------------- 1 | ....#..... 2 | .........# 3 | .......... 4 | ..#....... 5 | .......#.. 6 | .......... 7 | .#..^..... 8 | ........#. 9 | #......... 10 | ......#... 11 | 12 | -------------------------------------------------------------------------------- /aoc2024/day7/eg.txt: -------------------------------------------------------------------------------- 1 | 190: 10 19 2 | 3267: 81 40 27 3 | 83: 17 5 4 | 156: 15 6 5 | 7290: 6 8 6 15 6 | 161011: 16 10 13 7 | 192: 17 8 14 8 | 21037: 9 7 18 13 9 | 292: 11 6 16 20 10 | -------------------------------------------------------------------------------- /aoc2024/day8/eg.txt: -------------------------------------------------------------------------------- 1 | ............ 2 | ........0... 3 | .....0...... 4 | .......0.... 5 | ....0....... 6 | ......A..... 7 | ............ 8 | ............ 9 | ........A... 10 | .........A.. 11 | ............ 12 | ............ 13 | -------------------------------------------------------------------------------- /aoc2024/day9/eg.txt: -------------------------------------------------------------------------------- 1 | 2333133121414131402 2 | -------------------------------------------------------------------------------- /aoc2024/mkday: -------------------------------------------------------------------------------- 1 | #!/bin/zsh -e 2 | day=$1 3 | if [ ! -d day${day} -a ! -z "$1" ]; then 4 | echo Make Day ${day} 5 | mkdir day${day} 6 | sed "s/XX/$day/g" DayXX.newt > Day$day.newt 7 | fi 8 | -------------------------------------------------------------------------------- /newt-vscode/.eslintrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "root": true, 3 | "parser": "@typescript-eslint/parser", 4 | "parserOptions": { 5 | "ecmaVersion": 6, 6 | "sourceType": "module" 7 | }, 8 | "plugins": [ 9 | "@typescript-eslint" 10 | ], 11 | "rules": { 12 | "@typescript-eslint/naming-convention": [ 13 | "warn", 14 | { 15 | "selector": "import", 16 | "format": [ "camelCase", "PascalCase" ] 17 | } 18 | ], 19 | "@typescript-eslint/semi": "warn", 20 | "curly": "off", 21 | "eqeqeq": "warn", 22 | "no-throw-literal": "warn", 23 | "semi": "off" 24 | }, 25 | "ignorePatterns": [ 26 | "out", 27 | "dist", 28 | "**/*.d.ts" 29 | ] 30 | } 31 | -------------------------------------------------------------------------------- /newt-vscode/.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | node_modules 3 | *.vsix 4 | 5 | -------------------------------------------------------------------------------- /newt-vscode/.vscodeignore: -------------------------------------------------------------------------------- 1 | .vscode/** 2 | .vscode-test/** 3 | .gitignore 4 | vsc-extension-quickstart.md 5 | -------------------------------------------------------------------------------- /newt-vscode/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | 3 | All notable changes to the "newt-vscode" extension will be documented in this file. 4 | 5 | Check [Keep a Changelog](http://keepachangelog.com/) for recommendations on how to structure this file. 6 | 7 | ## [Unreleased] 8 | 9 | - Initial release -------------------------------------------------------------------------------- /newt-vscode/LICENSE: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | 3 | Anyone is free to copy, modify, publish, use, compile, sell, or 4 | distribute this software, either in source code form or as a compiled 5 | binary, for any purpose, commercial or non-commercial, and by any 6 | means. 7 | 8 | In jurisdictions that recognize copyright laws, the author or authors 9 | of this software dedicate any and all copyright interest in the 10 | software to the public domain. We make this dedication for the benefit 11 | of the public at large and to the detriment of our heirs and 12 | successors. We intend this dedication to be an overt act of 13 | relinquishment in perpetuity of all present and future rights to this 14 | software under copyright law. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | For more information, please refer to 25 | -------------------------------------------------------------------------------- /newt-vscode/README.md: -------------------------------------------------------------------------------- 1 | # newt-vscode README 2 | 3 | newt extension for vscode 4 | -------------------------------------------------------------------------------- /newt-vscode/esbuild.js: -------------------------------------------------------------------------------- 1 | const esbuild = require("esbuild"); 2 | 3 | const production = process.argv.includes('--production'); 4 | const watch = process.argv.includes('--watch'); 5 | 6 | /** 7 | * @type {import('esbuild').Plugin} 8 | */ 9 | const esbuildProblemMatcherPlugin = { 10 | name: 'esbuild-problem-matcher', 11 | 12 | setup(build) { 13 | build.onStart(() => { 14 | console.log('[watch] build started'); 15 | }); 16 | build.onEnd((result) => { 17 | result.errors.forEach(({ text, location }) => { 18 | console.error(`✘ [ERROR] ${text}`); 19 | console.error(` ${location.file}:${location.line}:${location.column}:`); 20 | }); 21 | console.log('[watch] build finished'); 22 | }); 23 | }, 24 | }; 25 | 26 | async function main() { 27 | const ctx = await esbuild.context({ 28 | entryPoints: [ 29 | 'src/extension.ts' 30 | ], 31 | bundle: true, 32 | format: 'cjs', 33 | minify: production, 34 | sourcemap: !production, 35 | sourcesContent: false, 36 | platform: 'node', 37 | outfile: 'dist/extension.js', 38 | external: ['vscode'], 39 | logLevel: 'silent', 40 | plugins: [ 41 | /* add to the end of plugins array */ 42 | esbuildProblemMatcherPlugin, 43 | ], 44 | }); 45 | if (watch) { 46 | await ctx.watch(); 47 | } else { 48 | await ctx.rebuild(); 49 | await ctx.dispose(); 50 | } 51 | } 52 | 53 | main().catch(e => { 54 | console.error(e); 55 | process.exit(1); 56 | }); 57 | -------------------------------------------------------------------------------- /newt-vscode/language-configuration.json: -------------------------------------------------------------------------------- 1 | { 2 | // see singleton in Tokenizer.idr 3 | "wordPattern": "[^()\\{}\\[\\],.@\\s]+", 4 | "comments": { 5 | // symbol used for single line comment. Remove this entry if your language does not support line comments 6 | "lineComment": "--", 7 | // symbols used for start and end a block comment. Remove this entry if your language does not support block comments 8 | "blockComment": ["/-", "-/"] 9 | }, 10 | // symbols used as brackets 11 | "brackets": [ 12 | ["{", "}"], 13 | ["{{", "}}"], 14 | ["[", "]"], 15 | ["(", ")"] 16 | ], 17 | // symbols that are auto closed when typing 18 | "autoClosingPairs": [ 19 | ["{", "}"], 20 | ["[", "]"], 21 | ["(", ")"], 22 | ["\"", "\""], 23 | // ["'", "'"], causes problems with foo'' 24 | ["/-", "-/"] 25 | ], 26 | // symbols that can be used to surround a selection 27 | "surroundingPairs": [ 28 | ["{", "}"], 29 | ["[", "]"], 30 | ["(", ")"], 31 | ["\"", "\""], 32 | ["'", "'"] 33 | ], 34 | "onEnterRules": [ 35 | { 36 | "beforeText": "\\b(where|of|case)$", 37 | "action": { "indent": "indent" } 38 | }, 39 | { 40 | "beforeText": "/-", 41 | "afterText": "-/", 42 | "action": { 43 | "indent": "indentOutdent" 44 | } 45 | }, 46 | { 47 | "beforeText": "^\\s+$", 48 | "action": { 49 | "indent": "outdent" 50 | } 51 | } 52 | ] 53 | } 54 | -------------------------------------------------------------------------------- /newt-vscode/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "newt-vscode", 3 | "publisher": "dunhamsteve", 4 | "displayName": "newt-vscode", 5 | "description": "newt language support", 6 | "version": "0.0.1", 7 | "license": "MIT", 8 | "repository": { 9 | "type": "git", 10 | "url": "https://github.com/dunhamsteve/newt" 11 | }, 12 | "engines": { 13 | "vscode": "^1.91.0" 14 | }, 15 | "categories": [ 16 | "Programming Languages" 17 | ], 18 | "activationEvents": [ 19 | "onLanguage:newt" 20 | ], 21 | "main": "./dist/extension.js", 22 | "contributes": { 23 | "languages": [ 24 | { 25 | "id": "newt", 26 | "aliases": [ 27 | "newt" 28 | ], 29 | "extensions": [ 30 | "newt" 31 | ], 32 | "configuration": "./language-configuration.json" 33 | } 34 | ], 35 | "grammars": [ 36 | { 37 | "language": "newt", 38 | "scopeName": "source.newt", 39 | "path": "./syntaxes/newt.tmLanguage.json" 40 | }, 41 | { 42 | "path": "./syntaxes/inject.json", 43 | "scopeName": "newt.injection", 44 | "injectTo": [ 45 | "text.html.markdown" 46 | ], 47 | "embeddedLanguages": { 48 | "meta.embedded.block.idris": "newt" 49 | } 50 | } 51 | ], 52 | "commands": [ 53 | { 54 | "command": "newt-vscode.check", 55 | "title": "Check newt file" 56 | } 57 | ], 58 | "configuration": { 59 | "type": "object", 60 | "title": "Newt Configuration", 61 | "properties": { 62 | "newt.path": { 63 | "type": "string", 64 | "default": "build/exec/newt", 65 | "description": "Path to the newt executable" 66 | } 67 | } 68 | } 69 | }, 70 | "scripts": { 71 | "vscode:prepublish": "npm run package", 72 | "compile": "npm run check-types && npm run lint && node esbuild.js", 73 | "watch": "npm-run-all -p watch:*", 74 | "watch:esbuild": "node esbuild.js --watch", 75 | "package": "npm run check-types && npm run lint && node esbuild.js --production", 76 | "compile-tests": "tsc -p . --outDir out", 77 | "watch-tests": "tsc -p . -w --outDir out", 78 | "pretest": "npm run compile-tests && npm run compile && npm run lint", 79 | "check-types": "tsc --noEmit", 80 | "lint": "eslint src --ext ts", 81 | "test": "vscode-test" 82 | }, 83 | "devDependencies": { 84 | "@types/mocha": "^10.0.7", 85 | "@types/node": "20.x", 86 | "@types/vscode": "^1.90.0", 87 | "@typescript-eslint/eslint-plugin": "^7.14.1", 88 | "@typescript-eslint/parser": "^7.11.0", 89 | "@vscode/test-cli": "^0.0.9", 90 | "@vscode/test-electron": "^2.4.0", 91 | "esbuild": "^0.25.0", 92 | "eslint": "^8.57.0", 93 | "npm-run-all": "^4.1.5", 94 | "typescript": "^5.4.5" 95 | } 96 | } 97 | -------------------------------------------------------------------------------- /newt-vscode/src/abbrev.ts: -------------------------------------------------------------------------------- 1 | export const ABBREV: Record = { 2 | "\\x": "×", 3 | "\\r": "→", 4 | "\\all": "∀", 5 | "\\\\": "\\", 6 | "\\==": "≡", 7 | "\\circ": "∘", 8 | "\\1": "₁", 9 | "\\2": "₂", 10 | }; 11 | -------------------------------------------------------------------------------- /newt-vscode/syntaxes/inject.json: -------------------------------------------------------------------------------- 1 | { 2 | "scopeName": "newt.injection", 3 | "injectionSelector": "L:text.html.markdown", 4 | "patterns": [ 5 | { 6 | "include": "#fenced_code_block_newt" 7 | } 8 | ], 9 | "repository": { 10 | "fenced_code_block_newt": { 11 | "begin": "(^|\\G)(\\s*)(`{3,}|~{3,})\\s*(?i:(newt)((\\s+|:|,|\\{|\\?)[^`]*)?$)", 12 | "name": "markup.fenced_code.block.markdown", 13 | "end": "(^|\\G)(\\2|\\s{0,3})(\\3)\\s*$", 14 | "beginCaptures": { 15 | "3": { 16 | "name": "punctuation.definition.markdown" 17 | }, 18 | "4": { 19 | "name": "fenced_code.block.language.markdown" 20 | }, 21 | "5": { 22 | "name": "fenced_code.block.language.attributes.markdown" 23 | } 24 | }, 25 | "endCaptures": { 26 | "3": { 27 | "name": "punctuation.definition.markdown" 28 | } 29 | }, 30 | "patterns": [ 31 | { 32 | "begin": "(^|\\G)(\\s*)(.*)", 33 | "while": "(^|\\G)(?!\\s*([`~]{3,})\\s*$)", 34 | "contentName": "meta.embedded.block.newt", 35 | "patterns": [ 36 | { 37 | "include": "source.newt" 38 | } 39 | ] 40 | } 41 | ] 42 | } 43 | } 44 | } 45 | -------------------------------------------------------------------------------- /newt-vscode/syntaxes/newt.tmLanguage.json: -------------------------------------------------------------------------------- 1 | { 2 | "$schema": "https://raw.githubusercontent.com/martinring/tmlanguage/master/tmlanguage.json", 3 | "name": "newt", 4 | "scopeName": "source.newt", 5 | "patterns": [ 6 | { 7 | "name": "comment.block.newt", 8 | "begin": "/-", 9 | "end": "-/", 10 | "contentName": "comment.block.newt" 11 | }, 12 | { 13 | "name": "comment.line.newt", 14 | "begin": "--", 15 | "end": "\\n" 16 | }, 17 | { 18 | "name": "keyword.newt", 19 | "match": "\\b(λ|=>|<-|->|→|:=|\\$|data|record|constructor|where|do|class|uses|instance|case|of|let|if|then|else|forall|∀|in|U|module|import|ptype|pfunc|infix|infixl|infixr)\\b" 20 | }, 21 | { 22 | "name": "string.js", 23 | "begin": "`", 24 | "end": "`", 25 | "patterns": [{ "include": "source.js" }] 26 | }, 27 | { 28 | "name": "character", 29 | "match": "'\\\\?.'" 30 | }, 31 | { 32 | "name": "string.double.newt", 33 | "begin": "\"", 34 | "end": "\"", 35 | "patterns": [ 36 | { 37 | "name": "constant.character.escape.newt", 38 | "match": "\\\\[^{]" 39 | } 40 | ] 41 | } 42 | ] 43 | } 44 | -------------------------------------------------------------------------------- /newt-vscode/tsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "compilerOptions": { 3 | "module": "Node16", 4 | "target": "ES2022", 5 | "lib": [ 6 | "ES2022" 7 | ], 8 | "sourceMap": true, 9 | "rootDir": "src", 10 | "strict": true /* enable all strict type-checking options */ 11 | /* Additional Checks */ 12 | // "noImplicitReturns": true, /* Report error when not all code paths in function return a value. */ 13 | // "noFallthroughCasesInSwitch": true, /* Report errors for fallthrough cases in switch statement. */ 14 | // "noUnusedParameters": true, /* Report errors on unused parameters. */ 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /newt.ipkg: -------------------------------------------------------------------------------- 1 | package newt 2 | version = 0.1.0 3 | authors = "Steve Dunham" 4 | -- maintainers = 5 | -- license = 6 | -- brief = 7 | -- readme = 8 | -- homepage = 9 | -- sourceloc = 10 | -- bugtracker = 11 | 12 | -- the Idris2 version required (e.g. langversion >= 0.5.1) 13 | -- langversion 14 | 15 | -- packages to add to search path 16 | depends = contrib, base 17 | 18 | -- modules to install 19 | modules = 20 | Lib.Elab, 21 | Lib.Parser, 22 | Lib.Parser.Impl, 23 | Lib.Prettier, 24 | Lib.ProcessDecl, 25 | Lib.Syntax, 26 | Lib.Common, 27 | Lib.Eval, 28 | Lib.Token, 29 | Lib.TopContext, 30 | Lib.Types, 31 | Lib.Util 32 | 33 | -- main file (i.e. file to load at REPL) 34 | main = Main 35 | 36 | -- name of executable 37 | executable = "newt" 38 | -- opts = 39 | sourcedir = "orig" 40 | -- builddir = 41 | -- outputdir = 42 | 43 | -- script to run before building 44 | -- prebuild = 45 | 46 | -- script to run after building 47 | -- postbuild = 48 | 49 | -- script to run after building, before installing 50 | -- preinstall = 51 | 52 | -- script to run after installing 53 | -- postinstall = 54 | 55 | -- script to run before cleaning 56 | -- preclean = 57 | 58 | -- script to run after cleaning 59 | -- postclean = 60 | -------------------------------------------------------------------------------- /newt/Debug.newt: -------------------------------------------------------------------------------- 1 | module Debug 2 | 3 | data Unit : U where 4 | MkUnit : Unit 5 | 6 | infixr 7 _::_ 7 | data List : U -> U where 8 | Nil : {A : U} -> List A 9 | _::_ : {A : U} -> A -> List A -> List A 10 | 11 | -- prj/menagerie/papers/combinatory 12 | 13 | infixr 6 _~>_ 14 | data Type : U where 15 | ι : Type 16 | _~>_ : Type -> Type -> Type 17 | 18 | A : U 19 | A = Unit 20 | 21 | Val : Type -> U 22 | Val ι = A 23 | Val (x ~> y) = Val x -> Val y 24 | 25 | -- can't get Val to expand here. 26 | #check (\ x => \ y => \ z => (Val (x ~> y ~> z))) : Type -> Type -> Type -> U 27 | 28 | foo : {σ τ ξ : Type} → Val (σ ~> (τ ~> σ)) 29 | foo {σ} {τ} {σ} = \ x => \ y => x 30 | 31 | -------------------------------------------------------------------------------- /newt/Equality.newt: -------------------------------------------------------------------------------- 1 | module Equality 2 | 3 | data Eq : {A : U} -> A -> A -> U where 4 | Refl : {A : U} {a : A} -> Eq a a 5 | 6 | -- Some magic is not happening here. 7 | 8 | sym : {A : U} {x y : A} -> Eq x y -> Eq y x 9 | sym Refl = Refl 10 | 11 | trans : {A : U} {x y z : A} -> Eq x y -> Eq y z -> Eq x z 12 | trans Refl Refl = Refl 13 | 14 | coerce : {A B : U} -> Eq A B -> A -> B 15 | coerce Refl a = a 16 | 17 | J : {A : U} -> 18 | {C : (x y : A) -> Eq x y -> U} -> 19 | (c : (x : _) -> C x x Refl) -> 20 | (x y : A) -> 21 | (p : Eq x y) -> 22 | C x y p 23 | -- this was failing until I constrained scrutinee to the constructor + args 24 | J c x y Refl = c x 25 | -------------------------------------------------------------------------------- /newt/Equality1.newt: -------------------------------------------------------------------------------- 1 | module Equality1 2 | 3 | -- Leibniz equality 4 | Eq : {A : U} -> A -> A -> U 5 | Eq = \ x y => (P : A -> U) -> P x -> P y 6 | 7 | refl : {A : U} {x : A} -> Eq x x 8 | refl = \ P Px => Px 9 | 10 | trans : {A : U} {x y z : A} -> Eq x y -> Eq y z -> Eq x z 11 | trans = \ Exy Eyz => Eyz (\ w => Eq x w) Exy 12 | 13 | sym : {A : U} {x y : A} -> Eq x y -> Eq y x 14 | sym = \ Exy => Exy (\ z => Eq z x) refl 15 | 16 | id : {A} -> A -> A 17 | id = \ x => x 18 | 19 | coerce : {A B : U} -> Eq A B -> A -> B 20 | coerce = \ EqAB a => EqAB id a 21 | 22 | -- pi-forall's formulation 23 | -- J : {A : U} -> 24 | -- (x y : A) -> 25 | -- (p : Eq x y) -> 26 | -- {C : (z : A) -> Eq z y -> U} -> 27 | -- (b : C y refl) -> 28 | -- C x p 29 | -- -- doesn't really work because we have refl and some Eq y y 30 | -- J = \ x y eq {C} b => eq (\z => (q : Eq z y) -> C z q) (\ _ => b) 31 | 32 | -- I don't think this is going to happen, maybe with funext? 33 | -- anyway, could be useful case to improve error messages. 34 | -- (add names) 35 | 36 | J : {A : U} -> 37 | {C : (x y : A) -> Eq x y -> U} -> 38 | (c : (x : _) -> C x x refl) -> 39 | (x y : A) -> 40 | (p : Eq x y) -> 41 | C x y p 42 | J = \ c x y eq => eq (\ z => (q : Eq x z) -> C x z q) (\ _ => c x) eq 43 | -------------------------------------------------------------------------------- /newt/Fix.newt: -------------------------------------------------------------------------------- 1 | module Fix 2 | 3 | -- from piforall Fix.pi 4 | Type: U 5 | Type = U 6 | 7 | -- TODO piforall makes the A in scope for the constructors 8 | -- and has it on the let of the : 9 | -- I think we want that for parameters? 10 | data D : (A : Type) -> Type where 11 | F : {A : Type} -> (D A -> D A) -> D A 12 | V : {A : Type} -> A -> D A 13 | 14 | 15 | -- Here we have two A in play, so y is type of the 16 | -- A in V and the expected return value is the other. 17 | -- We do need to sort this out 18 | 19 | unV : { A : U} -> D A -> A 20 | unV (V y) = y 21 | unV (F f) = ? -- was TRUSTME 22 | 23 | 24 | 25 | -- And here we have D A:4 and D A:1 26 | unF : {A : Type} -> D A -> D A -> D A 27 | unF = \ {A} v x => 28 | case v of 29 | F f => f x 30 | V y => ? -- was TRUSTME 31 | 32 | -- fix : {A : U} -> (A -> A) -> A 33 | -- fix = \ {A} g => 34 | -- -- RLet is not yet implemented... 35 | -- let omega = -- : D A -> D A = 36 | -- (\ x => V (g (unv {A} (unF {A} x x)))) 37 | -- in unV {A} (omega (F omega)) 38 | 39 | -- data Nat : Type where 40 | -- Zero : Nat 41 | -- Succ : Nat -> Nat 42 | 43 | -- fix_add : Nat -> Nat -> Nat 44 | -- fix_add = fix [Nat -> Nat -> Nat] 45 | -- \radd. \x. \y. 46 | -- case x of 47 | -- Zero -> y 48 | -- Succ n -> Succ (radd n y) 49 | 50 | -- test : fix_add 5 2 = 7 51 | -- test = Refl 52 | -------------------------------------------------------------------------------- /newt/Foo.newt: -------------------------------------------------------------------------------- 1 | -- foo 2 | module Foo 3 | 4 | id : (a : U) -> a -> a 5 | id = \ a => \ x => x 6 | 7 | -- if I put foo here, it fails with 'extra toks' at "module" 8 | -- errors aren't cutting to the top 9 | -- I think we need the errors to be fatal if anything is consumed (since the nearest alt) 10 | 11 | List : U -> U 12 | List = \ A => (L : U) -> L -> (A -> L -> L) -> L 13 | 14 | nil : (A : U) -> List A 15 | nil = \ A L n f => n 16 | 17 | Bool : U 18 | 19 | -------------------------------------------------------------------------------- /newt/JSLib.newt: -------------------------------------------------------------------------------- 1 | module JSLib 2 | 3 | 4 | 5 | 6 | infixl 4 _+_ 7 | infixl 5 _*_ 8 | 9 | pfunc _+_ : Int -> Int -> Int := `(x,y) => x + y` 10 | pfunc _*_ : Int -> Int -> Int := `(x,y) => x * y` 11 | 12 | ptype JVoid 13 | 14 | -- REVIEW - maybe we only have body, use names from the pi-type and generate 15 | -- the arrow (or inline?) ourselves 16 | pfunc log : String -> JVoid := `x => console.log(x)` 17 | pfunc debug : {a : U} -> String -> a -> JVoid := `(_,x,a) => console.log(x,a)` 18 | -------------------------------------------------------------------------------- /newt/Order.newt: -------------------------------------------------------------------------------- 1 | module Order 2 | 3 | data Nat : U where 4 | Z : Nat 5 | S : Nat -> Nat 6 | 7 | plus : Nat -> Nat -> Nat 8 | plus Z y = y 9 | plus (S x) y = S (plus x y) 10 | 11 | data Pair : U -> U -> U where 12 | _,_ : {A B : U} -> A -> B -> Pair A B 13 | 14 | infix 1 _,_ 15 | 16 | foo : Pair Nat Nat 17 | -- vscode plugin issue: Without the space the info is rendered on Z... 18 | foo = (Z , S Z) 19 | 20 | -- So I was going to force a (a + b, a) =?= (3,0) unification problem 21 | -- as an example of needing _dynamic_ pattern unification 22 | data Eq : {A : U} -> A -> A -> U where 23 | Refl : {A : U} -> {x : A} -> Eq x x 24 | 25 | -- but hold up here. This doesn't solve either. 26 | -- Oh, because I can't reduce case. 27 | -- And the FC is useless. 28 | -- these go into caseeval.newt test 29 | two : Eq (plus Z (S (S Z))) (S (S Z)) 30 | two = Refl 31 | 32 | two' : Eq (plus (S Z) (S Z)) (S (S Z)) 33 | two' = Refl {Nat} {S (S Z)} 34 | 35 | three : Eq (plus (S Z) (S (S Z))) (plus (S (S Z)) (S Z)) 36 | three = Refl {Nat} {S (S (S Z))} 37 | -------------------------------------------------------------------------------- /newt/TypeClass.newt: -------------------------------------------------------------------------------- 1 | module TypeClass 2 | 3 | data Monad : (U -> U) -> U where 4 | MkMonad : { M : U -> U } -> 5 | (bind : {A B : U} -> (M A) -> (A -> M B) -> M B) -> 6 | (pure : {A : U} -> A -> M A) -> 7 | Monad M 8 | 9 | infixl 1 _>>=_ _>>_ 10 | _>>=_ : {a b : U} -> {m : U -> U} -> {{x : Monad m}} -> (m a) -> (a -> m b) -> m b 11 | _>>=_ {a} {b} {m} {{MkMonad bind' _}} ma amb = bind' {a} {b} ma amb 12 | 13 | _>>_ : {a b : U} -> {m : U -> U} -> {{x : Monad m}} -> m a -> m b -> m b 14 | ma >> mb = mb 15 | 16 | pure : {a : U} {m : U -> U} {{_ : Monad m}} -> a -> m a 17 | pure {_} {_} {{MkMonad _ pure'}} a = pure' a 18 | 19 | data Either : U -> U -> U where 20 | Left : {A B : U} -> A -> Either A B 21 | Right : {A B : U} -> B -> Either A B 22 | 23 | bindEither : {A B C : U} -> (Either A B) -> (B -> Either A C) -> Either A C 24 | bindEither (Left a) amb = Left a 25 | bindEither (Right b) amb = amb b 26 | 27 | EitherMonad : {A : U} -> Monad (Either A) 28 | EitherMonad = MkMonad {Either A} bindEither Right 29 | 30 | data Maybe : U -> U where 31 | Just : {A : U} -> A -> Maybe A 32 | Nothing : {A : U} -> Maybe A 33 | 34 | bindMaybe : {A B : U} -> Maybe A -> (A -> Maybe B) -> Maybe B 35 | bindMaybe Nothing amb = Nothing 36 | bindMaybe (Just a) amb = amb a 37 | 38 | MaybeMonad : Monad Maybe 39 | MaybeMonad = MkMonad bindMaybe Just 40 | 41 | infixr 7 _::_ 42 | data List : U -> U where 43 | Nil : {A : U} -> List A 44 | _::_ : {A : U} -> A -> List A -> List A 45 | 46 | infixl 7 _++_ 47 | _++_ : {A : U} -> List A -> List A -> List A 48 | Nil ++ ys = ys 49 | (x :: xs) ++ ys = x :: (xs ++ ys) 50 | 51 | bindList : {A B : U} -> List A -> (A -> List B) -> List B 52 | bindList Nil f = Nil 53 | bindList (x :: xs) f = f x ++ bindList xs f 54 | 55 | singleton : {A : U} -> A -> List A 56 | singleton a = a :: Nil 57 | 58 | -- TODO need better error when the monad is not defined 59 | ListMonad : Monad List 60 | ListMonad = MkMonad bindList singleton 61 | 62 | infixr 1 _,_ 63 | data Pair : U -> U -> U where 64 | _,_ : {A B : U} -> A -> B -> Pair A B 65 | 66 | 67 | 68 | test : Maybe Int 69 | test = pure 10 70 | 71 | foo : Int -> Maybe Int 72 | foo x = Just 42 >> Just x >>= (\ x => pure {_} {Maybe} 10) 73 | 74 | bar : Int -> Maybe Int 75 | bar x = do 76 | let y = x 77 | z <- Just x 78 | pure z 79 | 80 | baz : {A B : U} -> List A -> List B -> List (Pair A B) 81 | baz xs ys = do 82 | x <- xs 83 | y <- ys 84 | pure (x , y) 85 | -------------------------------------------------------------------------------- /newt/tutorial.newt: -------------------------------------------------------------------------------- 1 | -- Files begin with a module declaration, modules not implemented yet 2 | module Tutorial 3 | 4 | 5 | -- import Prelude not implemented yet 6 | 7 | -- declare a primitive type 8 | 9 | 10 | -- declare a more complex primitive type 11 | ptype Array : U -> U 12 | 13 | -- declare a primitive function 14 | pfunc alength : {a : U} -> Array a -> Int := `(x) => x.length` 15 | 16 | -------------------------------------------------------------------------------- /orig/Lib/Token.idr: -------------------------------------------------------------------------------- 1 | module Lib.Token 2 | 3 | public export 4 | record Bounds where 5 | constructor MkBounds 6 | startLine : Int 7 | startCol : Int 8 | endLine : Int 9 | endCol : Int 10 | 11 | export 12 | Eq Bounds where 13 | (MkBounds sl sc el ec) == (MkBounds sl' sc' el' ec') = 14 | sl == sl' 15 | && sc == sc' 16 | && el == el' 17 | && ec == ec' 18 | 19 | public export 20 | record WithBounds ty where 21 | constructor MkBounded 22 | val : ty 23 | bounds : Bounds 24 | 25 | public export 26 | data Kind 27 | = Ident 28 | | UIdent 29 | | Keyword 30 | | MixFix 31 | | Number 32 | | Character 33 | | StringKind 34 | | JSLit 35 | | Symbol 36 | | Space 37 | | Comment 38 | | Pragma 39 | | Projection 40 | -- not doing Layout.idr 41 | | LBrace 42 | | Semi 43 | | RBrace 44 | | EOI 45 | | StartQuote 46 | | EndQuote 47 | | StartInterp 48 | | EndInterp 49 | 50 | export 51 | Show Kind where 52 | show Ident = "Ident" 53 | show UIdent = "UIdent" 54 | show Keyword = "Keyword" 55 | show MixFix = "MixFix" 56 | show Number = "Number" 57 | show Character = "Character" 58 | show Symbol = "Symbol" 59 | show Space = "Space" 60 | show LBrace = "LBrace" 61 | show Semi = "Semi" 62 | show RBrace = "RBrace" 63 | show Comment = "Comment" 64 | show EOI = "EOI" 65 | show Pragma = "Pragma" 66 | show StringKind = "String" 67 | show JSLit = "JSLit" 68 | show Projection = "Projection" 69 | show StartQuote = "StartQuote" 70 | show EndQuote = "EndQuote" 71 | show StartInterp = "StartInterp" 72 | show EndInterp = "EndInterp" 73 | 74 | export 75 | Eq Kind where 76 | a == b = show a == show b 77 | 78 | public export 79 | record Token where 80 | constructor Tok 81 | kind : Kind 82 | text : String 83 | 84 | 85 | export 86 | Show Token where 87 | show (Tok k v) = "<\{show k}:\{show v}>" 88 | 89 | public export 90 | BTok : Type 91 | BTok = WithBounds Token 92 | 93 | export 94 | value : BTok -> String 95 | value (MkBounded (Tok _ s) _) = s 96 | 97 | export 98 | kind : BTok -> Kind 99 | kind (MkBounded (Tok k s) _) = k 100 | 101 | export 102 | getStart : BTok -> (Int, Int) 103 | getStart (MkBounded _ (MkBounds l c _ _)) = (l,c) 104 | -------------------------------------------------------------------------------- /orig/Lib/TopContext.idr: -------------------------------------------------------------------------------- 1 | module Lib.TopContext 2 | 3 | import Data.IORef 4 | import Data.SortedMap 5 | import Data.String 6 | import Lib.Types 7 | 8 | -- I want unique ids, to be able to lookup, update, and a Ref so 9 | -- I don't need good Context discipline. (I seem to have made mistakes already.) 10 | 11 | export 12 | lookup : QName -> TopContext -> Maybe TopEntry 13 | lookup nm top = lookup nm top.defs 14 | 15 | -- TODO - look at imported namespaces, and either have a map of imported names or search imported namespaces.. 16 | export 17 | lookupRaw : String -> TopContext -> Maybe TopEntry 18 | lookupRaw raw top = go $ toList top.defs 19 | where 20 | go : List (QName, TopEntry) -> Maybe TopEntry 21 | go Nil = Nothing 22 | go (((QN ns nm), entry) :: rest) = if nm == raw then Just entry else go rest 23 | 24 | -- Maybe pretty print? 25 | export 26 | covering 27 | Show TopContext where 28 | show (MkTop defs metas _ _ _ _) = "\nContext:\n [\{ joinBy "\n" $ map (show . snd) $ toList defs}]" 29 | 30 | public export 31 | empty : HasIO m => m TopContext 32 | empty = pure $ MkTop empty !(newIORef (MC [] 0 CheckAll)) False !(newIORef []) [] empty 33 | 34 | public export 35 | setDef : QName -> FC -> Tm -> Def -> M () 36 | setDef name fc ty def = do 37 | top <- get 38 | let Nothing = lookup name top.defs 39 | | Just (MkEntry fc' nm' ty' def') => error fc "\{name} is already defined at \{show fc'}" 40 | put $ { defs $= (insert name (MkEntry fc name ty def)) } top 41 | 42 | public export 43 | updateDef : QName -> FC -> Tm -> Def -> M () 44 | updateDef name fc ty def = do 45 | top <- get 46 | let Just (MkEntry fc' nm' ty' def') = lookup name top.defs 47 | | Nothing => error fc "\{name} not declared" 48 | put $ { defs $= (insert name (MkEntry fc' name ty def)) } top 49 | 50 | public export 51 | addError : Error -> M () 52 | addError err = do 53 | top <- get 54 | modifyIORef top.errors (err ::) 55 | -------------------------------------------------------------------------------- /orig/Lib/Util.idr: -------------------------------------------------------------------------------- 1 | module Lib.Util 2 | 3 | import Lib.Types 4 | 5 | export 6 | funArgs : Tm -> (Tm, List Tm) 7 | funArgs tm = go tm [] 8 | where 9 | go : Tm -> List Tm -> (Tm, List Tm) 10 | go (App _ t u) args = go t (u :: args) 11 | go t args = (t, args) 12 | 13 | public export 14 | data Binder : Type where 15 | MkBinder : FC -> String -> Icit -> Quant -> Tm -> Binder 16 | 17 | -- I don't have a show for terms without a name list 18 | export 19 | Show Binder where 20 | show (MkBinder _ nm icit quant t) = "[\{show quant}\{nm} \{show icit} : ...]" 21 | 22 | export 23 | splitTele : Tm -> (Tm, List Binder) 24 | splitTele = go [] 25 | where 26 | go : List Binder -> Tm -> (Tm, List Binder) 27 | go ts (Pi fc nm icit quant t u) = go (MkBinder fc nm icit quant t :: ts) u 28 | go ts tm = (tm, reverse ts) 29 | -------------------------------------------------------------------------------- /pack.toml: -------------------------------------------------------------------------------- 1 | [custom.all.newt] 2 | type = "local" 3 | path = "." 4 | ipkg = "newt.ipkg" 5 | test = "test/test.ipkg" 6 | 7 | [custom.all.newt-test] 8 | type = "local" 9 | path = "test" 10 | ipkg = "test.ipkg" -------------------------------------------------------------------------------- /papers/elaborating-dependent-copattern-matching.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dunhamsteve/newt/8dae8880f9bf3bf0363378b56c9d67e2529c0fb0/papers/elaborating-dependent-copattern-matching.pdf -------------------------------------------------------------------------------- /papers/prettier.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dunhamsteve/newt/8dae8880f9bf3bf0363378b56c9d67e2529c0fb0/papers/prettier.pdf -------------------------------------------------------------------------------- /papers/unifiers-as-equivalences.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dunhamsteve/newt/8dae8880f9bf3bf0363378b56c9d67e2529c0fb0/papers/unifiers-as-equivalences.pdf -------------------------------------------------------------------------------- /playground/.gitignore: -------------------------------------------------------------------------------- 1 | public 2 | dist 3 | .vite 4 | node_modules 5 | -------------------------------------------------------------------------------- /playground/README.md: -------------------------------------------------------------------------------- 1 | - Run `make` in newt directory 2 | - Run `./build` 3 | - Run `vite` 4 | - Click on url 5 | 6 | -------------------------------------------------------------------------------- /playground/TODO.md: -------------------------------------------------------------------------------- 1 | 2 | ## Todo items for the playground 3 | 4 | - [x] sample files 5 | - [ ] make sample files available for import 6 | - workaround is to visit the file first 7 | - [x] move newt to a worker (shim + newt + listener) 8 | - [x] tabs for source, compiler output 9 | - [x] Show errors in editor 10 | - [x] show tabs on rhs 11 | - [ ] make editor a tab on mobile 12 | - (or possibly put the tab bar under the keyboard) 13 | - [x] publish / host on github 14 | - [ ] multiple persistent files 15 | - [x] kill return for autocomplete 16 | -------------------------------------------------------------------------------- /playground/build: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | mkdir -p public 3 | echo build monaco worker 4 | esbuild --bundle node_modules/monaco-editor/esm/vs/editor/editor.worker.js > public/workerMain.js 5 | echo build newt worker 6 | esbuild src/worker.ts --bundle --format=esm > public/worker.js 7 | esbuild src/frame.ts --bundle --format=esm > public/frame.js 8 | echo copy newt 9 | cp ../newt.js public 10 | cp -r static/* public 11 | (cd samples && zip -r ../public/files.zip .) 12 | -------------------------------------------------------------------------------- /playground/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | Newt Playground 8 | 9 | 10 |
11 |
12 |
13 |
14 |
15 |
16 | 17 | 18 | 19 | -------------------------------------------------------------------------------- /playground/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "playground", 3 | "private": true, 4 | "version": "0.0.0", 5 | "type": "module", 6 | "scripts": { 7 | "dev": "vite", 8 | "build": "tsc && vite build", 9 | "preview": "vite preview" 10 | }, 11 | "devDependencies": { 12 | "esbuild": "^0.25.0", 13 | "typescript": "~5.6.2", 14 | "vite": "^6.1.0" 15 | }, 16 | "dependencies": { 17 | "@preact/signals": "^1.3.0", 18 | "monaco-editor": "^0.52.0", 19 | "preact": "^10.24.3" 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /playground/samples/DSL.newt: -------------------------------------------------------------------------------- 1 | module DSL 2 | 3 | -- https://www.youtube.com/watch?v=sFyy9sssK50 4 | 5 | data ℕ : U where 6 | Z : ℕ 7 | S : ℕ → ℕ 8 | 9 | infixl 7 _+_ 10 | infixl 8 _*_ 11 | 12 | _+_ : ℕ → ℕ → ℕ 13 | Z + m = m 14 | (S k) + m = S (k + m) 15 | 16 | _*_ : ℕ → ℕ → ℕ 17 | Z * m = Z 18 | (S k) * m = m + k * m 19 | 20 | infixr 4 _::_ 21 | data Vec : U → ℕ → U where 22 | Nil : {a} → Vec a Z 23 | _::_ : {a k} → a → Vec a k → Vec a (S k) 24 | 25 | infixl 5 _++_ 26 | _++_ : {a n m} → Vec a n → Vec a m → Vec a (n + m) 27 | Nil ++ ys = ys 28 | (x :: xs) ++ ys = x :: (xs ++ ys) 29 | 30 | map : {a b n} → (a → b) → Vec a n → Vec b n 31 | map f Nil = Nil 32 | map f (x :: xs) = f x :: map f xs 33 | 34 | data E : U where 35 | Zero : E 36 | One : E 37 | Add : E → E → E 38 | Mul : E → E → E 39 | 40 | two : E 41 | two = Add One One 42 | 43 | four : E 44 | four = Mul two two 45 | 46 | card : E → ℕ 47 | card Zero = Z 48 | card One = S Z 49 | card (Add x y) = card x + card y 50 | card (Mul x y) = card x * card y 51 | 52 | data Empty : U where 53 | 54 | data Unit : U where 55 | -- unit accepted but case building thinks its a var 56 | unit : Unit 57 | 58 | data Either : U -> U -> U where 59 | Left : {A B} → A → Either A B 60 | Right : {A B} → B → Either A B 61 | 62 | infixr 4 _,_ 63 | data Both : U → U → U where 64 | _,_ : {A B} → A → B → Both A B 65 | 66 | typ : E → U 67 | typ Zero = Empty 68 | typ One = Unit 69 | typ (Add x y) = Either (typ x) (typ y) 70 | typ (Mul x y) = Both (typ x) (typ y) 71 | 72 | Bool : U 73 | Bool = typ two 74 | 75 | false : Bool 76 | false = Left unit 77 | 78 | true : Bool 79 | true = Right unit 80 | 81 | BothBoolBool : U 82 | BothBoolBool = typ four 83 | 84 | ex1 : BothBoolBool 85 | ex1 = (false, true) 86 | 87 | enumAdd : {a b m n} → Vec a m → Vec b n → Vec (Either a b) (m + n) 88 | enumAdd xs ys = map Left xs ++ map Right ys 89 | 90 | -- for this I followed the shape of _*_, the lecture was slightly different 91 | enumMul : {a b m n} → Vec a m → Vec b n → Vec (Both a b) (m * n) 92 | enumMul Nil ys = Nil 93 | enumMul (x :: xs) ys = map (_,_ x) ys ++ enumMul xs ys 94 | 95 | enumerate : (t : E) → Vec (typ t) (card t) 96 | enumerate Zero = Nil 97 | enumerate One = unit :: Nil 98 | enumerate (Add x y) = enumAdd (enumerate x) (enumerate y) 99 | enumerate (Mul x y) = enumMul (enumerate x) (enumerate y) 100 | 101 | test2 : Vec (typ two) (card two) 102 | test2 = enumerate two 103 | 104 | test4 : Vec (typ four) (card four) 105 | test4 = enumerate four 106 | 107 | -- TODO I need to add #eval, like Lean 108 | -- #eval enumerate two 109 | 110 | -- for now, I'll define ≡ to check 111 | 112 | infixl 2 _≡_ 113 | data _≡_ : {A} → A → A → U where 114 | Refl : {A} {a : A} → a ≡ a 115 | 116 | test2' : test2 ≡ false :: true :: Nil 117 | test2' = Refl 118 | 119 | test4' : test4 ≡ (false, false) :: (false, true) :: (true, false) :: (true, true) :: Nil 120 | test4' = Refl 121 | -------------------------------------------------------------------------------- /playground/samples/Hello.newt: -------------------------------------------------------------------------------- 1 | module Hello 2 | 3 | import Prelude 4 | 5 | main : IO Unit 6 | main = do 7 | putStrLn "hello, world" 8 | -------------------------------------------------------------------------------- /playground/samples/Prelude.newt: -------------------------------------------------------------------------------- 1 | ../../newt/Prelude.newt -------------------------------------------------------------------------------- /playground/samples/Tree.newt: -------------------------------------------------------------------------------- 1 | module Tree 2 | 3 | -- adapted from Conor McBride's 2-3 tree example 4 | -- youtube video: https://youtu.be/v2yXrOkzt5w?t=3013 5 | 6 | 7 | data Nat : U where 8 | Z : Nat 9 | S : Nat -> Nat 10 | 11 | data Unit : U where 12 | MkUnit : Unit 13 | 14 | data Void : U where 15 | 16 | infixl 4 _+_ 17 | 18 | data _+_ : U -> U -> U where 19 | inl : {A B} -> A -> A + B 20 | inr : {A B} -> B -> A + B 21 | 22 | infix 4 _<=_ 23 | 24 | _<=_ : Nat -> Nat -> U 25 | Z <= y = Unit 26 | S x <= Z = Void 27 | S x <= S y = x <= y 28 | 29 | cmp : (x y : Nat) -> (x <= y) + (y <= x) 30 | cmp Z y = inl MkUnit 31 | cmp (S z) Z = inr MkUnit 32 | cmp (S x) (S y) = cmp x y 33 | 34 | -- 53:21 35 | 36 | data Bnd : U where 37 | Bot : Bnd 38 | N : Nat -> Bnd 39 | Top : Bnd 40 | 41 | infix 4 _<<=_ 42 | 43 | _<<=_ : Bnd -> Bnd -> U 44 | Bot <<= _ = Unit 45 | N x <<= N y = x <= y 46 | _ <<= Top = Unit 47 | _ <<= _ = Void 48 | 49 | data Intv : Bnd -> Bnd -> U where 50 | intv : {l u} (x : Nat) (lx : l <<= N x) (xu : N x <<= u) -> Intv l u 51 | 52 | data T23 : Bnd -> Bnd -> Nat -> U where 53 | leaf : {l u} (lu : l <<= u) -> T23 l u Z 54 | node2 : {l u h} (x : _) 55 | (tlx : T23 l (N x) h) (txu : T23 (N x) u h) -> 56 | T23 l u (S h) 57 | node3 : {l u h} (x y : _) 58 | (tlx : T23 l (N x) h) (txy : T23 (N x) (N y) h) (tyu : T23 (N y) u h) -> 59 | T23 l u (S h) 60 | 61 | -- 56: 62 | 63 | infixl 5 _*_ 64 | infixr 1 _,_ 65 | data Sg : (A : U) -> (A -> U) -> U where 66 | _,_ : {A : U} {B : A -> U} -> (a : A) -> B a -> Sg A B 67 | 68 | _*_ : U -> U -> U 69 | A * B = Sg A (\ _ => B) 70 | 71 | TooBig : Bnd -> Bnd -> Nat -> U 72 | TooBig l u h = Sg Nat (\ x => T23 l (N x) h * T23 (N x) u h) 73 | 74 | insert : {l u h} -> Intv l u -> T23 l u h -> TooBig l u h + T23 l u h 75 | insert (intv x lx xu) (leaf lu) = inl (x , (leaf lx , leaf xu)) 76 | insert (intv x lx xu) (node2 y tly tyu) = case cmp x y of 77 | -- u := N y is not solved at this time 78 | inl xy => case insert (intv {_} {N y} x lx xy) tly of 79 | inl (z , (tlz , tzy)) => inr (node3 z y tlz tzy tyu) 80 | inr tly' => inr (node2 y tly' tyu) 81 | inr yx => case insert (intv {N y} x yx xu) tyu of 82 | inl (z , (tyz , tzu)) => inr (node3 y z tly tyz tzu) 83 | inr tyu' => inr (node2 y tly tyu') 84 | insert (intv x lx xu) (node3 y z tly tyz tzu) = case cmp x y of 85 | inl xy => case insert (intv {_} {N y} x lx xy) tly of 86 | inl (v , (tlv , tvy)) => inl (y , (node2 v tlv tvy , node2 z tyz tzu)) 87 | inr tly' => inr (node3 y z tly' tyz tzu) 88 | inr yx => case cmp x z of 89 | inl xz => case insert (intv {N y} {N z} x yx xz) tyz of 90 | inl (w , (tyw , twz)) => inl (w , (node2 y tly tyw , node2 z twz tzu)) 91 | inr tyz' => inr (node3 y z tly tyz' tzu) 92 | inr zx => case insert (intv {N z} x zx xu) tzu of 93 | inl (w , (tzw , twu)) => inl (z , (node2 y tly tyz , node2 w tzw twu)) 94 | inr tzu' => inr (node3 y z tly tyz tzu') 95 | -------------------------------------------------------------------------------- /playground/samples/TypeClass.newt: -------------------------------------------------------------------------------- 1 | module TypeClass 2 | 3 | class Monad (m : U → U) where 4 | bind : ∀ a b. m a → (a → m b) → m b 5 | pure : ∀ a. a → m a 6 | 7 | infixl 1 _>>=_ _>>_ 8 | _>>=_ : {0 m} {{Monad m}} {0 a b} -> (m a) -> (a -> m b) -> m b 9 | ma >>= amb = bind ma amb 10 | 11 | _>>_ : ∀ m a b. {{Monad m}} -> m a -> m b -> m b 12 | ma >> mb = mb 13 | 14 | data Either : U -> U -> U where 15 | Left : ∀ A B. A -> Either A B 16 | Right : ∀ A B. B -> Either A B 17 | 18 | instance {a} -> Monad (Either a) where 19 | bind (Left a) amb = Left a 20 | bind (Right b) amb = amb b 21 | 22 | pure a = Right a 23 | 24 | data Maybe : U -> U where 25 | Just : ∀ A. A -> Maybe A 26 | Nothing : ∀ A. Maybe A 27 | 28 | instance Monad Maybe where 29 | bind Nothing amb = Nothing 30 | bind (Just a) amb = amb a 31 | 32 | pure a = Just a 33 | 34 | infixr 7 _::_ 35 | data List : U -> U where 36 | Nil : ∀ A. List A 37 | _::_ : ∀ A. A -> List A -> List A 38 | 39 | infixl 7 _++_ 40 | _++_ : ∀ A. List A -> List A -> List A 41 | Nil ++ ys = ys 42 | (x :: xs) ++ ys = x :: (xs ++ ys) 43 | 44 | instance Monad List where 45 | bind Nil f = Nil 46 | bind (x :: xs) f = f x ++ bind xs f 47 | 48 | pure x = x :: Nil 49 | 50 | infixr 1 _,_ 51 | data Pair : U -> U -> U where 52 | _,_ : ∀ A B. A -> B -> Pair A B 53 | 54 | 55 | 56 | test : Maybe Int 57 | test = pure 10 58 | 59 | foo : Int -> Maybe Int 60 | foo x = Just 42 >> Just x >>= (\ x => pure 10) 61 | 62 | bar : Int -> Maybe Int 63 | bar x = do 64 | let y = x 65 | z <- Just x 66 | pure z 67 | 68 | baz : ∀ A B. List A -> List B -> List (Pair A B) 69 | baz xs ys = do 70 | x <- xs 71 | y <- ys 72 | pure (x , y) 73 | -------------------------------------------------------------------------------- /playground/samples/aoc2024/Aoc.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2023/Aoc.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day1.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day1.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day10.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day10.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day11.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day11.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day11b.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day11b.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day12.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day12.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day13.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day13.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day14.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day14.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day15.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day15.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day16.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day16.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day17.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day17.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day18.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day18.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day19.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day19.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day2.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day2.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day20.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day20.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day21.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day21.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day22.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day22.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day23.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day23.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day24.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day24.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day25.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day25.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day3.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day3.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day4.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day4.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day5.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day5.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day6.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day6.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day7.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day7.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day8.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day8.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Day9.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Day9.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/DayXX.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/DayXX.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Node.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Node.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Parser.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Parser.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/Prelude.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/Prelude.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/SortedMap.newt: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/SortedMap.newt -------------------------------------------------------------------------------- /playground/samples/aoc2024/day1: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day1 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day10: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day10 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day11: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day11 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day12: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day12 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day13: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day13 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day14: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day14 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day15: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day15 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day16: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day16 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day17: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day17 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day18: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day18 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day19: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day19 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day2: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day2 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day20: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day20 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day21: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day21 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day22: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day22 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day23: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day23 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day24: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day24 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day25: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day25 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day3: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day3 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day4: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day4 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day5: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day5 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day6: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day6 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day7: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day7 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day8: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day8 -------------------------------------------------------------------------------- /playground/samples/aoc2024/day9: -------------------------------------------------------------------------------- 1 | ../../../aoc2024/day9 -------------------------------------------------------------------------------- /playground/samples/newt: -------------------------------------------------------------------------------- 1 | ../../src -------------------------------------------------------------------------------- /playground/src/abbrev.ts: -------------------------------------------------------------------------------- 1 | ../../newt-vscode/src/abbrev.ts -------------------------------------------------------------------------------- /playground/src/emul.ts: -------------------------------------------------------------------------------- 1 | import { ZipFile } from "./zipfile"; 2 | 3 | export interface Handle { 4 | name: string; 5 | mode: string; 6 | pos: number; 7 | buf: Uint8Array; 8 | } 9 | 10 | interface Process { 11 | argv: string[]; 12 | exit(_: number): void; 13 | } 14 | export interface NodeShim { 15 | stdout: string; 16 | archive?: ZipFile; 17 | process: Process; 18 | files: Record; 19 | fs: any; 20 | } 21 | export let shim: NodeShim = { 22 | // these three and process are poked at externally 23 | archive: undefined, 24 | stdout: "", 25 | files: {}, 26 | fs: { 27 | readFileSync(name: string, encoding: string, enc?: string) { 28 | if (name.startsWith("./")) name = name.slice(2); 29 | let data: Uint8Array | undefined = shim.files[name] 30 | if (!data && shim.archive?.entries[name]) { 31 | // keep a copy of the uncompressed version for speed 32 | data = shim.files[name] = shim.archive.getData(name)!; 33 | } 34 | if (data) { 35 | return new TextDecoder().decode(data); 36 | } else { 37 | throw new Error(`${name} not found`); 38 | } 39 | }, 40 | writeFileSync(name: string, data: string, enc?: string) { 41 | shim.files[name] = new TextEncoder().encode(data) 42 | }, 43 | }, 44 | process: { 45 | argv: ["", ""], 46 | exit(v: number) { 47 | throw new Error(`exit ${v}`) 48 | }, 49 | } 50 | }; 51 | 52 | // we intercept require to return our fake node modules 53 | declare global { 54 | interface Window { 55 | require: (x: string) => any; 56 | process: Process; 57 | } 58 | } 59 | const requireStub: any = (x: string) => (shim as any)[x]; 60 | self.require = requireStub; 61 | self.process = shim.process; 62 | -------------------------------------------------------------------------------- /playground/src/frame.ts: -------------------------------------------------------------------------------- 1 | import { archive } from "./preload"; 2 | import { Message } from "./types"; 3 | 4 | // fs emulation for frame 5 | const shim = { 6 | stdout: "", 7 | fs: { 8 | // made just for Node.newt... 9 | readFileSync(fn: string, encoding: string) { 10 | let data = archive?.getData(fn); 11 | if (data) { 12 | return new TextDecoder().decode(data); 13 | } else { 14 | throw new Error(`${fn} not found`); 15 | } 16 | }, 17 | }, 18 | }; 19 | // we intercept require to return our fake node modules 20 | declare global { 21 | interface Window { 22 | require: (x: string) => any; 23 | } 24 | } 25 | const requireStub: any = (x: string) => (shim as any)[x]; 26 | self.require = requireStub; 27 | self.process = { 28 | platform: "linux", 29 | argv: ["", ""], 30 | stdout: { 31 | // We'll want to replace this one 32 | write(s) { 33 | console.log("*", s); 34 | shim.stdout += s; 35 | }, 36 | }, 37 | exit(v: number) { 38 | console.log("exit", v); 39 | }, 40 | cwd() { 41 | return ""; 42 | }, 43 | env: { 44 | NO_COLOR: "true", 45 | IDRIS2_CG: "javascript", 46 | IDRIS2_PREFIX: "", 47 | }, 48 | __lasterr: { 49 | errno: 0, 50 | }, 51 | // stdin: { fd: 0 }, 52 | }; 53 | let realLog = console.log; 54 | console.log = (...args) => { 55 | sendMessage({ type: "pushConsole", message: args.join(" ") }); 56 | realLog(...args); 57 | }; 58 | 59 | window.addEventListener("message", (ev: MessageEvent) => { 60 | realLog("got", ev.data); 61 | if (ev.data.type === "exec") { 62 | let { src } = ev.data; 63 | try { 64 | sendMessage({ type: "setConsole", messages: [] }); 65 | eval(src); 66 | } catch (e) { 67 | console.log(e); 68 | } 69 | } 70 | }); 71 | const sendMessage = (msg: Message) => window.parent.postMessage(msg, "*"); 72 | 73 | realLog("IFRAME INITIALIZED"); 74 | if (shim) { 75 | realLog("shim imported for effect"); 76 | } 77 | -------------------------------------------------------------------------------- /playground/src/global.d.ts: -------------------------------------------------------------------------------- 1 | declare module "*.css"; 2 | export {}; 3 | declare global { 4 | // typescript doesn't know worker.ts is a worker 5 | function importScripts(...scripts: string[]): void; 6 | 7 | // let files: Record; 8 | // let process: Process; 9 | let Main_main: () => unknown; 10 | } 11 | -------------------------------------------------------------------------------- /playground/src/preload.ts: -------------------------------------------------------------------------------- 1 | import {ZipFile} from './zipfile' 2 | export let archive: ZipFile | undefined; 3 | export let preload = (async function () { 4 | // We pull down an archive of .ttc and support shim.files 5 | try { 6 | let res = await self.fetch("files.zip"); 7 | if (res.status === 200) { 8 | let data = await res.arrayBuffer(); 9 | archive = new ZipFile(new Uint8Array(data)); 10 | let entries = archive.entries; 11 | } else { 12 | console.error( 13 | `fetch of files.zip got status ${res.status}: ${res.statusText}` 14 | ); 15 | } 16 | } catch (e) { 17 | console.error("preload failed", e); 18 | } 19 | })(); 20 | -------------------------------------------------------------------------------- /playground/src/types.ts: -------------------------------------------------------------------------------- 1 | export interface CompileReq { 2 | type: "compileRequest"; 3 | fileName: string; 4 | src: string; 5 | } 6 | 7 | export interface CompileRes { 8 | type: "compileResult"; 9 | output: string; 10 | javascript: string; 11 | duration: number; 12 | } 13 | 14 | export interface ConsoleList { 15 | type: 'setConsole' 16 | messages: string[]; 17 | } 18 | export interface ConsoleItem { 19 | type: 'pushConsole' 20 | message: string; 21 | } 22 | 23 | export interface ExecCode { 24 | type: 'exec' 25 | src: string 26 | } 27 | 28 | export type Message = CompileReq | CompileRes | ConsoleList | ConsoleItem | ExecCode 29 | -------------------------------------------------------------------------------- /playground/src/worker.ts: -------------------------------------------------------------------------------- 1 | import { shim } from "./emul"; 2 | import { archive, preload } from "./preload"; 3 | import { CompileReq, CompileRes } from "./types"; 4 | 5 | console.log = (m) => { 6 | shim.stdout += '\n' + m 7 | } 8 | 9 | const handleMessage = async function (ev: { data: CompileReq }) { 10 | console.log("message", ev.data); 11 | await preload; 12 | shim.archive = archive; 13 | let { src, fileName } = ev.data; 14 | const outfile = "out.js"; 15 | shim.process.argv = ["browser", "newt", fileName, "-o", outfile, "--top"]; 16 | shim.files[fileName] = new TextEncoder().encode(src); 17 | shim.files[outfile] = new TextEncoder().encode("No JS output"); 18 | shim.stdout = ""; 19 | const start = +new Date(); 20 | try { 21 | Main_main(); 22 | } catch (e) { 23 | // make it clickable in console 24 | console.error(e); 25 | // make it visable on page 26 | shim.stdout += "\n" + String(e); 27 | } 28 | let duration = +new Date() - start; 29 | console.log(`process ${fileName} in ${duration} ms`); 30 | let javascript = new TextDecoder().decode(shim.files[outfile]); 31 | let output = shim.stdout; 32 | sendResponse({ type: 'compileResult', javascript, output, duration }); 33 | }; 34 | 35 | // hooks for worker.html to override 36 | let sendResponse: (_: CompileRes) => void = postMessage; 37 | onmessage = handleMessage; 38 | importScripts("newt.js"); 39 | -------------------------------------------------------------------------------- /playground/static/frame.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | -------------------------------------------------------------------------------- /playground/static/worker.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | -------------------------------------------------------------------------------- /playground/style.css: -------------------------------------------------------------------------------- 1 | 2 | svg.icon path { 3 | stroke: black; 4 | fill: none; 5 | } 6 | 7 | @media (prefers-color-scheme: dark) { 8 | body { 9 | color: white; 10 | background-color: black; 11 | } 12 | svg.icon path { 13 | stroke: white; 14 | fill: none; 15 | } 16 | } 17 | 18 | #app { 19 | top: 0; 20 | bottom: 0; 21 | left: 0; 22 | right: 0; 23 | position: absolute; 24 | } 25 | #editor { 26 | height: 100%; 27 | } 28 | .wrapper.horizontal { 29 | display: flex; 30 | flex-direction: row; 31 | height: 100%; 32 | } 33 | .wrapper.horizontal > div { 34 | flex: 1 1; 35 | /* allow smaller than natural */ 36 | width: 100px; 37 | } 38 | .wrapper.vertical { 39 | display: flex; 40 | flex-direction: column; 41 | height: 100%; 42 | } 43 | .wrapper.vertical .tabPanel.left { 44 | /* designed to go down to the keyboard on my phone */ 45 | flex: .65 .65; 46 | height: 100px; 47 | } 48 | .wrapper.vertical .tabPanel.right { 49 | flex: .35 .35; 50 | height: 100px; 51 | } 52 | .tabBar button { 53 | border: none; 54 | padding: none; 55 | background: inherit; 56 | } 57 | .tabPanel { 58 | display: flex; 59 | flex-direction: column; 60 | } 61 | .tabBar { 62 | display:flex; 63 | flex-direction: row; 64 | gap: 10px; 65 | margin: 10px 0 0 0; 66 | border-bottom: solid 1px black; 67 | height: 30px; 68 | } 69 | .tabBar>select { 70 | margin: 0 5px 5px; 71 | } 72 | .tab { 73 | padding: 4px; 74 | border: solid 1px transparent; 75 | } 76 | .tab.selected { 77 | border: solid 1px black; 78 | border-bottom: 0px 79 | } 80 | .tabBody { 81 | overflow: auto; 82 | flex: 1 1; 83 | } 84 | #result, #javascript { 85 | font-family: 'Comic Code', monospace; 86 | font-size: 12px; 87 | white-space: pre; 88 | padding: 5px; 89 | } 90 | -------------------------------------------------------------------------------- /playground/tsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "compilerOptions": { 3 | "target": "ES2020", 4 | "useDefineForClassFields": true, 5 | "module": "ESNext", 6 | "lib": ["ES2020", "DOM", "DOM.Iterable"], 7 | "skipLibCheck": true, 8 | 9 | 10 | "outDir": "out", 11 | "sourceMap": true, 12 | 13 | 14 | /* Bundler mode */ 15 | "moduleResolution": "Bundler", 16 | "allowImportingTsExtensions": true, 17 | "isolatedModules": true, 18 | "moduleDetection": "force", 19 | "noEmit": true, 20 | 21 | /* Linting */ 22 | "strict": true, 23 | "noUnusedLocals": false, 24 | "noUnusedParameters": false, 25 | "noFallthroughCasesInSwitch": true, 26 | "noUncheckedSideEffectImports": true 27 | }, 28 | "include": ["src"] 29 | } 30 | -------------------------------------------------------------------------------- /scripts/aoc: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | mkdir -p tmp 3 | echo "Test AoC 2024 solutions" 4 | NCC="bun run newt.js" 5 | total=0 6 | failed=0 7 | for fn in aoc2024/Day*.newt; do 8 | total=$((total + 1)) 9 | echo Test $fn 10 | bn=$(basename $fn) 11 | $NCC $fn -o out.js > tmp/${bn}.compile 12 | if [ $? != "0" ]; then 13 | echo Compile failed for $fn 14 | failed=$((failed + 1)) 15 | continue 16 | fi 17 | # if there is a golden file, run the code and compare output 18 | if [ -f ${fn}.golden ]; then 19 | bun run out.js > tmp/${bn}.out 20 | if [ $? != "0" ]; then 21 | echo Run failed for $fn 22 | failed=$((failed + 1)) 23 | continue 24 | fi 25 | if ! diff -q tmp/${bn}.out ${fn}.golden; then 26 | echo "Output mismatch for $fn" 27 | failed=$((failed + 1)) 28 | fi 29 | fi 30 | done 31 | 32 | echo "Total tests: $total" 33 | echo "Failed tests: $failed" 34 | 35 | 36 | -------------------------------------------------------------------------------- /scripts/orig_aoc: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | mkdir -p tmp 3 | echo "Test AoC 2024 solutions" 4 | total=0 5 | failed=0 6 | for fn in aoc2024/Day*.newt; do 7 | total=$((total + 1)) 8 | echo Test $fn 9 | bn=$(basename $fn) 10 | ./build/exec/newt $fn -o out.js > tmp/${bn}.compile 11 | if [ $? != "0" ]; then 12 | echo Compile failed for $fn 13 | failed=$((failed + 1)) 14 | continue 15 | fi 16 | # if there is a golden file, run the code and compare output 17 | if [ -f ${fn}.golden ]; then 18 | bun run out.js > tmp/${bn}.out 19 | if [ $? != "0" ]; then 20 | echo Run failed for $fn 21 | failed=$((failed + 1)) 22 | continue 23 | fi 24 | if ! diff -q tmp/${bn}.out ${fn}.golden; then 25 | echo "Output mismatch for $fn" 26 | failed=$((failed + 1)) 27 | fi 28 | fi 29 | done 30 | 31 | echo "Total tests: $total" 32 | echo "Failed tests: $failed" 33 | 34 | 35 | -------------------------------------------------------------------------------- /scripts/orig_test: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | SAMPLES=$(find playground/samples -name "*.newt") 3 | total=0 4 | failed=0 5 | for fn in tests/*.newt ; do 6 | total=$((total + 1)) 7 | echo Test $fn 8 | bn=$(basename $fn) 9 | ./build/exec/newt $fn -o out.js > tmp/${bn}.compile 10 | if [ $? != "0" ]; then 11 | echo Compile failed for $fn 12 | failed=$((failed + 1)) 13 | continue 14 | fi 15 | # if there is a golden file, run the code and compare output 16 | if [ -f ${fn}.golden ]; then 17 | bun run out.js > tmp/${bn}.out 18 | if [ $? != "0" ]; then 19 | echo Run failed for $fn 20 | failed=$((failed + 1)) 21 | continue 22 | fi 23 | if ! diff -q tmp/${bn}.out ${fn}.golden; then 24 | echo "Output mismatch for $fn" 25 | failed=$((failed + 1)) 26 | fi 27 | fi 28 | done 29 | echo "Total tests: $total" 30 | echo "Failed tests: $failed" 31 | 32 | -------------------------------------------------------------------------------- /scripts/stats.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | import sys 3 | fn = sys.argv[1] 4 | stats = {} 5 | acc = '' 6 | name = '' 7 | for line in open(fn): 8 | if line.startswith('const'): 9 | if name: stats[name] = len(acc) 10 | acc = line 11 | name = line.split()[1] 12 | else: 13 | acc += line 14 | if name: stats[name] = len(acc) 15 | 16 | sorted_stats = sorted(((v, k) for k, v in stats.items())) 17 | for value, key in sorted_stats: 18 | print(value, key) 19 | -------------------------------------------------------------------------------- /scripts/test: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | SAMPLES=$(find playground/samples -name "*.newt") 3 | # NCC="bun run newt.js" 4 | NCC="node newt.js" 5 | total=0 6 | failed=0 7 | for fn in tests/*.newt ; do 8 | total=$((total + 1)) 9 | echo Test $fn 10 | bn=$(basename $fn) 11 | if [ -f ${fn}.golden ]; then 12 | $NCC $fn -o out.js > tmp/${bn}.compile 13 | else 14 | # we've dropped support for compiling things without main for now. 15 | $NCC $fn > tmp/${bn}.compile 16 | fi 17 | if [ $? != "0" ]; then 18 | echo Compile failed for $fn 19 | failed=$((failed + 1)) 20 | continue 21 | fi 22 | # if there is a golden file, run the code and compare output 23 | if [ -f ${fn}.golden ]; then 24 | bun run out.js > tmp/${bn}.out 25 | if [ $? != "0" ]; then 26 | echo Run failed for $fn 27 | failed=$((failed + 1)) 28 | continue 29 | fi 30 | if ! diff -q tmp/${bn}.out ${fn}.golden; then 31 | echo "Output mismatch for $fn" 32 | failed=$((failed + 1)) 33 | fi 34 | fi 35 | done 36 | echo "Total tests: $total" 37 | echo "Failed tests: $failed" 38 | 39 | -------------------------------------------------------------------------------- /scripts/translate.sh: -------------------------------------------------------------------------------- 1 | #!/bin/zsh 2 | 3 | # script to translate a file from idris to newt 4 | # this is just a first pass, hopefully 5 | mkdir -p xlate 6 | 7 | find src -type f -name '*.idr' | while read -r file; do 8 | output_file="xlate/${file#src/}" 9 | output_file="${output_file%.idr}.newt" 10 | mkdir -p "$(dirname "$output_file")" 11 | if [[ ! -f "$output_file" ]]; then 12 | echo "$file -> $output_file" 13 | perl -pe ' 14 | use strict; 15 | 16 | s/^%.*//; 17 | s/\bType\b/U/g; 18 | s/\binterface\b/class/g; 19 | s/import public/import/g; 20 | s/\[\]/Nil/g; 21 | s{\[([^<|][^()]*?)\]}{"(" . (join " ::", split /,/, $1) . " :: Nil)"}ge; 22 | s/\bsym\b/symbol/g; 23 | s/^export//g; 24 | s/^\s*covering//g; 25 | s/pure \(\)/pure MkUnit/; 26 | s/M \(\)/M Unit/; 27 | s/Parser \(\)/Parser Unit/; 28 | s/OK \(\)/OK MkUnit/; 29 | s/ifThenElse/ite/; 30 | s/toks,\s*com,\s*ops,\s*col/toks com ops col/; 31 | s/\bNat\b/Int/g; 32 | s/(\s+when [^\$]+\$)(.*)/\1 \\ _ =>\2/; 33 | s/^public export//g; 34 | s/\(([A-Z]\w+), ?([^)]+)\)/(\1 × \2)/g; 35 | s/\|\|\|/--/; 36 | # maybe break down an add the sugar? 37 | # patterns would be another option, but 38 | # we would need to handle overlapping ones 39 | 40 | s/ \. / ∘ /g; 41 | s/\(([<>\/+]+)\)/_\1_/g; 42 | s/\{-/\/-/g; 43 | s/-\}/-\//g; 44 | s/\[<\]/Lin/g; 45 | s/\[<([^\],]+)\]/(Lin :< \1)/g; 46 | # s/\[([^\],]+)\]/(\1 :: Nil)/g; 47 | s/^([A-Z].*where)/instance \1/g; 48 | s/^data (.*:\s*\w+)$/\1/g; 49 | ' "$file" > "$output_file" 50 | fi 51 | done 52 | #rsync -av done/ xlate 53 | -------------------------------------------------------------------------------- /src/Data/IORef.newt: -------------------------------------------------------------------------------- 1 | module Data.IORef 2 | 3 | import Prelude 4 | 5 | -- We should test this at some point 6 | 7 | ptype IORef : U → U 8 | pfunc primNewIORef uses (MkIORes) : ∀ a. a → IO (IORef a) := `(_, a) => (w) => Prelude_MkIORes(null, [a], w)` 9 | pfunc primReadIORef uses (MkIORes) : ∀ a. IORef a → IO a := `(_, ref) => (w) => Prelude_MkIORes(null, ref[0], w)` 10 | pfunc primWriteIORef uses (MkIORes MkUnit) : ∀ a. IORef a → a → IO Unit := `(_, ref, a) => (w) => { 11 | ref[0] = a 12 | return Prelude_MkIORes(null,Prelude_MkUnit,w) 13 | }` 14 | 15 | newIORef : ∀ io a. {{HasIO io}} → a → io (IORef a) 16 | newIORef a = liftIO $ primNewIORef a 17 | 18 | readIORef : ∀ io a. {{HasIO io}} → IORef a → io a 19 | readIORef ref = liftIO $ primReadIORef ref 20 | 21 | writeIORef : ∀ io a. {{HasIO io}} → IORef a -> a -> io Unit 22 | writeIORef ref a = liftIO $ primWriteIORef ref a 23 | 24 | -- Idris HasIO constraints to monad, we don't have those constraints yet 25 | modifyIORef : ∀ io a. {{Monad io}} {{HasIO io}} → IORef a -> (a -> a) -> io Unit 26 | modifyIORef {io} ref f = 27 | bind {io} (readIORef ref) $ \a => writeIORef ref (f a) 28 | -------------------------------------------------------------------------------- /src/Data/Int.newt: -------------------------------------------------------------------------------- 1 | module Data.Int 2 | 3 | import Prelude 4 | 5 | div : Int → Int → Int 6 | div a b = a / b 7 | 8 | instance Cast Char Int where 9 | cast = ord 10 | 11 | instance Cast Int String where 12 | cast = show 13 | -------------------------------------------------------------------------------- /src/Data/List1.newt: -------------------------------------------------------------------------------- 1 | module Data.List1 2 | 3 | import Prelude 4 | 5 | infixr 7 _:::_ 6 | 7 | record List1 a where 8 | constructor _:::_ 9 | head1 : a 10 | tail1 : List a 11 | 12 | split1 : String → String → List1 String 13 | split1 str by = case split str by of 14 | Nil => str ::: Nil 15 | x :: xs => x ::: xs 16 | 17 | unsnoc : ∀ a. List1 a → List a × a 18 | unsnoc {a} (x ::: xs) = go x xs 19 | where 20 | go : a → List a → List a × a 21 | go x Nil = (Nil, x) 22 | go x (y :: ys) = let (as, a) = go y ys in (x :: as, a) 23 | 24 | splitFileName : String → String × String 25 | splitFileName fn = case split1 fn "." of 26 | part ::: Nil => (part, "") 27 | xs => mapFst (joinBy ".") $ unsnoc xs 28 | -------------------------------------------------------------------------------- /src/Data/SnocList.newt: -------------------------------------------------------------------------------- 1 | module Data.SnocList 2 | 3 | import Prelude 4 | 5 | snoclen : ∀ a. SnocList a → Nat 6 | snoclen {a} xs = go xs Z 7 | where 8 | go : SnocList a → Nat → Nat 9 | go Lin acc = acc 10 | go (xs :< x) acc = go xs (S acc) 11 | 12 | snocelem : ∀ a. {{Eq a}} → a → SnocList a → Bool 13 | snocelem a Lin = False 14 | snocelem a (xs :< x) = if a == x then True else snocelem a xs 15 | -------------------------------------------------------------------------------- /src/Data/String.newt: -------------------------------------------------------------------------------- 1 | module Data.String 2 | 3 | import Prelude 4 | 5 | unwords : List String → String 6 | unwords stuff = joinBy " " stuff 7 | 8 | instance Cast String Int where 9 | cast = stringToInt 10 | -------------------------------------------------------------------------------- /src/Data/TestGraph.newt: -------------------------------------------------------------------------------- 1 | module Data.TestGraph 2 | 3 | import Prelude 4 | import Data.Graph 5 | import Node 6 | 7 | main : IO Unit 8 | main = do 9 | let (_ :: fn :: Nil) = getArgs | args => putStrLn "bad args \{show args}" 10 | (Right text) <- readFile fn | Left err => putStrLn "Can't read \{fn}: \{show err}" 11 | let graph = mapMaybe readLine $ split text "\n" 12 | debugLog graph 13 | let result = tarjan graph 14 | debugLog result 15 | where 16 | readLine : String → Maybe (String × List String) 17 | readLine line = case split line " " of 18 | ("" :: _) => Nothing 19 | (x :: rest) => Just (x, rest) 20 | _ => Nothing 21 | -------------------------------------------------------------------------------- /src/Lib/LiftWhere.newt: -------------------------------------------------------------------------------- 1 | module Lib.LiftWhere 2 | 3 | import Prelude 4 | import Lib.Common 5 | import Lib.Types 6 | import Lib.TopContext 7 | import Lib.Ref2 8 | import Data.SortedMap 9 | import Data.IORef 10 | 11 | -- track depth and whether we need to replace Bnd with a top level call 12 | LiftEnv : U 13 | LiftEnv = List (Maybe (QName × Nat)) 14 | 15 | liftWhereTm : {{Ref2 Defs St}} → QName → LiftEnv → Tm → M Tm 16 | liftWhereTm name env (Lam fc nm icit quant t) = 17 | Lam fc nm icit quant <$> liftWhereTm name (Nothing :: env) t 18 | liftWhereTm name env (App fc t u) = 19 | App fc <$> liftWhereTm name env t <*> liftWhereTm name env u 20 | liftWhereTm name env (Pi fc nm icit quant t u) = do 21 | t <- liftWhereTm name env t 22 | u <- liftWhereTm name (Nothing :: env) u 23 | pure $ Pi fc nm icit quant t u 24 | liftWhereTm name env (Let fc nm v sc) = do 25 | v <- liftWhereTm name env v 26 | sc <- liftWhereTm name (Nothing :: env) sc 27 | pure $ Let fc nm v sc 28 | liftWhereTm name env tm@(Case fc t alts) = do 29 | t <- liftWhereTm name env t 30 | alts' <- traverse liftWhereAlt alts 31 | pure $ Case fc t alts' 32 | where 33 | -- This is where I wish I had put indexes on things 34 | liftWhereAlt : CaseAlt → M CaseAlt 35 | liftWhereAlt (CaseDefault tm) = CaseDefault <$> liftWhereTm name env tm 36 | liftWhereAlt (CaseLit l tm) = CaseLit l <$> liftWhereTm name env tm 37 | liftWhereAlt (CaseCons qn args tm) = 38 | CaseCons qn args <$> liftWhereTm name (map (const Nothing) args ++ env) tm 39 | -- This is where the magic happens 40 | liftWhereTm name env (LetRec fc nm ty t u) = do 41 | let l = length env 42 | qn <- getName name nm 43 | let env' = (Just (qn, S l) :: env) 44 | -- environment should subst this function (see next case) 45 | t' <- liftWhereTm qn env' t 46 | -- TODO we could have subst in this var and dropped the extra argument 47 | modifyRef Defs (updateMap qn (Fn $ wrapLam (S l) t')) 48 | 49 | -- The rest 50 | u' <- liftWhereTm qn env' u 51 | pure $ LetRec fc nm (Erased fc) (Erased fc) u' 52 | where 53 | -- TODO might be nice if we could nest the names (Foo.go.go) for nested where 54 | getName : QName → String → M QName 55 | getName qn@(QN ns nm) ext = do 56 | let qn' = QN ns (nm ++ "." ++ ext) 57 | top <- getRef Defs 58 | let (Just _) = lookupMap qn' top | _ => pure qn' 59 | getName qn (ext ++ "'") 60 | 61 | -- Hacky - CompileExp expects a pi type that matches arity 62 | wrapPi : Nat → Tm → Tm 63 | wrapPi Z tm = tm 64 | wrapPi (S k) tm = Pi fc "_" Explicit Many (Erased fc) $ wrapPi k tm 65 | 66 | wrapLam : Nat → Tm → Tm 67 | wrapLam Z tm = tm 68 | -- REVIEW We've already erased, hopefully we don't need quantity 69 | wrapLam (S k) tm = Lam fc "_" Explicit Many $ wrapLam k tm 70 | 71 | -- And where it lands 72 | liftWhereTm name env tm@(Bnd fc k) = case getAt (cast k) env of 73 | Just (Just (qn, v)) => pure $ apply (length' env) (cast v) (Ref fc qn) 74 | _ => pure tm 75 | where 76 | apply : Int → Int → Tm → Tm 77 | apply l 0 tm = tm 78 | -- (l - k) is like lvl2ix, but witih k one bigger 79 | apply l k tm = App fc (apply l (k - 1) tm) (Bnd fc (l - k)) 80 | liftWhereTm name env tm = pure tm 81 | 82 | liftWhereFn : {{Ref2 Defs St}} → QName × Def → M Unit 83 | liftWhereFn (name, Fn tm) = do 84 | tm' <- liftWhereTm name Nil tm 85 | modifyRef Defs $ updateMap name (Fn tm') 86 | -- updateDef name fc type (Fn tm') 87 | liftWhereFn _ = pure MkUnit 88 | 89 | liftWhere : {{Ref2 Defs St}} → M Unit 90 | liftWhere = do 91 | defs <- getRef Defs 92 | ignore $ traverse liftWhereFn $ toList defs 93 | -------------------------------------------------------------------------------- /src/Lib/Ref2.newt: -------------------------------------------------------------------------------- 1 | module Lib.Ref2 2 | 3 | import Prelude 4 | import Lib.Common 5 | import Lib.Types 6 | import Data.IORef 7 | import Data.SortedMap 8 | 9 | data Defs : U where 10 | 11 | -- St holds our code while we're optimizing 12 | St : U 13 | St = SortedMap QName Def 14 | 15 | -- This is inspired by Idris. 16 | -- Mainly to get an extra state variable into M 17 | -- I tried parameterizing M, but inference was having trouble 18 | -- in the existing code. 19 | data Ref2 : (l : U) → U → U where 20 | MkRef : ∀ a . {0 x : U} → IORef a → Ref2 x a 21 | 22 | getRef : ∀ io a. {{HasIO io}} → (l : U) → {{Ref2 l a}} → io a 23 | getRef l {{MkRef a}} = readIORef a 24 | 25 | modifyRef : ∀ io a. {{HasIO io}} → (l : U) → {{Ref2 l a}} → (a → a) → io Unit 26 | -- TODO inference needs liftIO here 27 | modifyRef l {{MkRef a}} f = liftIO $ modifyIORef a f 28 | -------------------------------------------------------------------------------- /src/Lib/Token.newt: -------------------------------------------------------------------------------- 1 | module Lib.Token 2 | 3 | import Prelude 4 | 5 | record Bounds where 6 | constructor MkBounds 7 | startLine : Int 8 | startCol : Int 9 | endLine : Int 10 | endCol : Int 11 | 12 | 13 | instance Eq Bounds where 14 | (MkBounds sl sc el ec) == (MkBounds sl' sc' el' ec') = 15 | sl == sl' 16 | && sc == sc' 17 | && el == el' 18 | && ec == ec' 19 | 20 | 21 | record WithBounds ty where 22 | constructor MkBounded 23 | val : ty 24 | bounds : Bounds 25 | 26 | 27 | data Kind 28 | = Ident 29 | | UIdent 30 | | Keyword 31 | | MixFix 32 | | Number 33 | | Character 34 | | StringKind 35 | | JSLit 36 | | Symbol 37 | | Space 38 | | Comment 39 | | Pragma 40 | | Projection 41 | -- not doing Layout.idr 42 | | LBrace 43 | | Semi 44 | | RBrace 45 | | EOI 46 | | StartQuote 47 | | EndQuote 48 | | StartInterp 49 | | EndInterp 50 | 51 | 52 | instance Show Kind where 53 | show Ident = "Ident" 54 | show UIdent = "UIdent" 55 | show Keyword = "Keyword" 56 | show MixFix = "MixFix" 57 | show Number = "Number" 58 | show Character = "Character" 59 | show Symbol = "Symbol" 60 | show Space = "Space" 61 | show LBrace = "LBrace" 62 | show Semi = "Semi" 63 | show RBrace = "RBrace" 64 | show Comment = "Comment" 65 | show EOI = "EOI" 66 | show Pragma = "Pragma" 67 | show StringKind = "String" 68 | show JSLit = "JSLit" 69 | show Projection = "Projection" 70 | show StartQuote = "StartQuote" 71 | show EndQuote = "EndQuote" 72 | show StartInterp = "StartInterp" 73 | show EndInterp = "EndInterp" 74 | 75 | 76 | instance Eq Kind where 77 | a == b = show a == show b 78 | 79 | 80 | record Token where 81 | constructor Tok 82 | kind : Kind 83 | text : String 84 | 85 | 86 | 87 | instance Show Token where 88 | show (Tok k v) = "<\{show k}:\{show v}>" 89 | 90 | 91 | BTok : U 92 | BTok = WithBounds Token 93 | 94 | 95 | value : BTok -> String 96 | value (MkBounded (Tok _ s) _) = s 97 | 98 | 99 | getStart : BTok -> (Int × Int) 100 | getStart (MkBounded _ (MkBounds l c _ _)) = (l,c) 101 | -------------------------------------------------------------------------------- /src/Lib/Util.newt: -------------------------------------------------------------------------------- 1 | module Lib.Util 2 | 3 | import Prelude 4 | import Lib.Common 5 | import Lib.Types 6 | import Data.List1 7 | 8 | -- pi arity is primitive functions 9 | piArity : Tm -> Nat 10 | piArity (Pi _ _ _ quant _ b) = S (piArity b) 11 | piArity _ = Z 12 | 13 | funArgs : Tm -> (Tm × List Tm) 14 | funArgs tm = go tm Nil 15 | where 16 | go : Tm -> List Tm -> (Tm × List Tm) 17 | go (App _ t u) args = go t (u :: args) 18 | go t args = (t, args) 19 | 20 | data Binder : U where 21 | MkBinder : FC -> String -> Icit -> Quant -> Tm -> Binder 22 | 23 | -- I don't have a show for terms without a name list 24 | 25 | instance Show Binder where 26 | show (MkBinder _ nm icit quant t) = "(\{show quant}\{nm} \{show icit} : ... :: Nil)" 27 | 28 | splitTele : Tm -> (Tm × List Binder) 29 | splitTele = go Nil 30 | where 31 | go : List Binder -> Tm -> (Tm × List Binder) 32 | go ts (Pi fc nm icit quant t u) = go (MkBinder fc nm icit quant t :: ts) u 33 | go ts tm = (tm, reverse ts) 34 | 35 | 36 | 37 | getBaseDir : String → String → M (String × QName) 38 | getBaseDir fn modName = do 39 | let (path, modName') = unsnoc $ split1 modName "." 40 | let parts = split1 fn "/" 41 | let (dirs,file) = unsnoc parts 42 | let (name, ext) = splitFileName file 43 | 44 | let parts = split1 fn "/" 45 | let (dirs,file) = unsnoc parts 46 | let (path, modName') = unsnoc $ split1 modName "." 47 | unless (modName' == name) $ \ _ => error (MkFC fn (0,0)) "module name \{modName'} doesn't match \{name}" 48 | let (Right base) = baseDir (Lin <>< dirs) (Lin <>< path) 49 | | Left err => error (MkFC fn (0,0)) err 50 | let base = if base == "" then "." else base 51 | pure (base, QN path modName') 52 | where 53 | baseDir : SnocList String -> SnocList String -> Either String String 54 | baseDir dirs Lin = Right $ joinBy "/" (dirs <>> Nil) 55 | baseDir (dirs :< d) (ns :< n) = if d == n 56 | then baseDir dirs ns 57 | else Left "module path doesn't match directory" 58 | baseDir Lin _ = Left "module path doesn't match directory" 59 | -------------------------------------------------------------------------------- /src/Monad/State.newt: -------------------------------------------------------------------------------- 1 | module Monad.State 2 | 3 | import Prelude 4 | 5 | record State s a where 6 | constructor MkState 7 | runState : s -> (a × s) 8 | 9 | get : ∀ s. State s s 10 | get = MkState (\s => (s, s)) 11 | 12 | put : ∀ s. s -> State s Unit 13 | put s = MkState (\_ => (MkUnit, s)) 14 | 15 | modify : ∀ s. (s → s) → State s Unit 16 | modify f = do 17 | v <- get 18 | put $ f v 19 | 20 | instance ∀ s. Functor (State s) where 21 | map f (MkState run) = MkState (\s => let (a, s') = run s in (f a, s')) 22 | 23 | instance ∀ s. Applicative (State s) where 24 | return x = MkState (\s => (x, s)) 25 | (MkState f) <*> (MkState x) = MkState (\s => let (g, s') = f s in 26 | let (a, s'') = x s' 27 | in (g a, s'')) 28 | 29 | instance ∀ s. Monad (State s) where 30 | pure x = MkState (\s => (x, s)) 31 | bind (MkState x) f = MkState (\s => let (a, s') = x s in 32 | let (MkState y) = f a in 33 | y s') 34 | -------------------------------------------------------------------------------- /src/Node.newt: -------------------------------------------------------------------------------- 1 | module Node 2 | 3 | import Prelude 4 | 5 | pfunc getArgs uses (arrayToList MkIORes) : IO (List String) := `(w) => Prelude_MkIORes(null, Prelude_arrayToList(null, process.argv.slice(1)), w)` 6 | pfunc readFile uses (MkIORes Left Right) : (fn : String) -> IO (Either String String) := `(fn) => (w) => { 7 | let fs = require('fs') 8 | let result 9 | try { 10 | let content = fs.readFileSync(fn, 'utf8') 11 | result = Prelude_Right(null, null, content) 12 | } catch (e) { 13 | let err = ""+e 14 | result = Prelude_Left(null, null, e) 15 | } 16 | return Prelude_MkIORes(null, result, w) 17 | }` 18 | 19 | -- I wonder if I should automatically `uses` the constructors in the types 20 | pfunc writeFile uses (MkIORes MkUnit) : String → String → IO (Either String Unit) := `(fn, content) => (w) => { 21 | let fs = require('fs') 22 | let result 23 | try { 24 | fs.writeFileSync(fn, content, 'utf8') 25 | result = Prelude_Right(null, null, Prelude_MkUnit) 26 | } catch (e) { 27 | let err = ""+e 28 | result = Prelude_Left(null, null, e) 29 | } 30 | return Prelude_MkIORes(null, result, w) 31 | }` 32 | 33 | -- maybe System.exit or something, like the original putStrLn msg >> exitFailure 34 | pfunc exitFailure : ∀ a. String → a := `(_, msg) => { 35 | console.log(msg); 36 | process.exit(1); 37 | }` 38 | 39 | -------------------------------------------------------------------------------- /src/Prelude.newt: -------------------------------------------------------------------------------- 1 | ../newt/Prelude.newt -------------------------------------------------------------------------------- /src/Serialize.newt: -------------------------------------------------------------------------------- 1 | module Serialize 2 | 3 | import Prelude 4 | import Node 5 | import Lib.Common 6 | import Lib.Types 7 | import Data.SortedMap 8 | 9 | ModFile : U 10 | ModFile = (String × List TopEntry × List (String × OpDef) × List (QName × MetaEntry)) 11 | 12 | pfunc checksum uses (MkIORes) : String → IO String := `(a) => (w) => { 13 | const arr = new TextEncoder().encode(a); 14 | // djb2 hash 15 | let val = 5381 16 | for (let i = 0; i < arr.length; i++) { 17 | val = ((val * 33) + arr[i]) | 0 18 | } 19 | return Prelude_MkIORes(null, ""+val, w); 20 | }` 21 | 22 | -- this was an experiment, prepping for dumping module information 23 | pfunc dumpModFile uses (MkIORes MkUnit): String → ModFile → IO Unit := `(fn,a) => (w) => { 24 | let fs = require('fs') 25 | try { 26 | let {EncFile} = require('./serializer') 27 | let enc = EncFile.encode(a) 28 | fs.writeFileSync(fn, enc) 29 | } catch (e) {} 30 | return Prelude_MkIORes(null, Prelude_MkUnit, w) 31 | }` 32 | 33 | 34 | -- for now, include src and use that to see if something changed 35 | dumpModule : QName → String → ModContext → M Unit 36 | dumpModule qn src mod = do 37 | let fn = "build/\{show qn}.newtmod" 38 | let csum = mod.csum 39 | let defs = listValues mod.modDefs 40 | let ops = toList mod.ctxOps 41 | let mctx = toList mod.modMetaCtx.metas 42 | liftIO $ dumpModFile fn (csum,defs,ops,mctx) 43 | 44 | pfunc readModFile uses (MkIORes Just Nothing): String → IO (Maybe ModFile) := `(fn) => (w) => { 45 | let fs = require('fs') 46 | try { 47 | let {DecFile} = require('./serializer') 48 | let data = fs.readFileSync(fn) 49 | let dec = DecFile.decode(data) 50 | return Prelude_MkIORes(null, Prelude_Just(null, dec), w) 51 | } catch (e) { 52 | return Prelude_MkIORes(null, Prelude_Nothing, w) 53 | } 54 | }` 55 | 56 | loadModule : QName → String → M (Maybe ModContext) 57 | loadModule qn src = do 58 | let fn = "build/\{show qn}.newtmod" 59 | (Just (csum, defs, ops, mctx)) <- liftIO {M} $ readModFile fn 60 | | _ => pure Nothing 61 | 62 | let ops = mapFromList ops 63 | let defs = mapFromList $ map (\ entry => (entry.name, entry)) defs 64 | -- REVIEW can we ignore those last two inside a module 65 | let mctx = MC (mapFromList mctx) Nil 0 NoCheck 66 | if csum == src 67 | then pure $ Just $ MkModCtx csum defs mctx ops 68 | else pure Nothing 69 | -------------------------------------------------------------------------------- /src/Test/Parser.newt: -------------------------------------------------------------------------------- 1 | module Test.Parser 2 | 3 | import Prelude 4 | import Lib.Parser 5 | import Lib.Tokenizer 6 | import Node 7 | 8 | 9 | 10 | main : IO Unit 11 | main = do 12 | let fn = "port/Lib/Parser.newt" 13 | (Right text) <- readFile fn 14 | | Left msg => putStrLn $ "ERROR: " ++ msg 15 | let (Right toks) = tokenise fn text 16 | | Left (E fc msg) => putStrLn msg 17 | | _ => putStrLn "postpone error" 18 | -- debugLog toks 19 | 20 | let (OK a toks com ops) = runP parseMod toks False EmptyMap (MkFC fn (0,0)) 21 | | fail => debugLog fail 22 | putStrLn "Module" 23 | debugLog $ a 24 | let (MkModule name imports decls) = a 25 | let lines = map (render 90 ∘ pretty) decls 26 | putStrLn $ joinBy "\n" lines 27 | -------------------------------------------------------------------------------- /test/src/Main.idr: -------------------------------------------------------------------------------- 1 | module Main 2 | 3 | import Lib.Types 4 | import Lib.ProcessDecl 5 | import Lib.TopContext 6 | import Lib.Syntax 7 | 8 | {- 9 | 10 | Expect these to throw. (need failing blocks or a white box test here) 11 | After we get pack/lsp issues sorted with this directory 12 | 13 | foo : Maybe (Int × Int) -> Int 14 | foo 1 = ? 15 | foo _ = ? 16 | 17 | foo : Maybe (Int × Int) -> Int 18 | foo (1,1) = ? 19 | foo _ = ? 20 | 21 | -} 22 | 23 | testCase : M () 24 | testCase = do 25 | -- need to get some defs in here 26 | top <- get 27 | let ctx = mkCtx top.metaCtx 28 | let e = emptyFC 29 | -- maybe easier to parse out this data. 30 | processDecl (Data e "Foo" (RU e) []) 31 | 32 | tree <- buildTree ctx (MkProb [] (VU emptyFC)) 33 | --ty <- check (mkCtx top.metaCtx) tm (VU fc) 34 | pure () 35 | 36 | 37 | main : IO () 38 | main = do 39 | -- TODO move the tests elsewhere 40 | -- We'll need a new top, start an M, maybe push a few things in there 41 | -- run buildTree and see what we get back 42 | ctx <- empty 43 | Right _ <- runEitherT $ runStateT ctx $ testCase 44 | | Left (E fc msg) => putStrLn "Error: \{msg}" 45 | putStrLn "done" 46 | pure () 47 | -- A telescope is a list of binders, right? I've been leaving things as pi types to be explicit 48 | -------------------------------------------------------------------------------- /test/test.ipkg: -------------------------------------------------------------------------------- 1 | package newt-test 2 | version = 0.1.0 3 | authors = "Steve Dunham" 4 | -- maintainers = 5 | -- license = 6 | -- brief = 7 | -- readme = 8 | -- homepage = 9 | -- sourceloc = 10 | -- bugtracker = 11 | 12 | -- the Idris2 version required (e.g. langversion >= 0.5.1) 13 | -- langversion 14 | 15 | -- packages to add to search path 16 | depends = newt 17 | 18 | -- modules to install 19 | -- modules = 20 | 21 | -- main file (i.e. file to load at REPL) 22 | main = Main 23 | 24 | -- name of executable 25 | executable = "newt-test" 26 | -- opts = 27 | sourcedir = "src" 28 | -- builddir = 29 | -- outputdir = 30 | 31 | -- script to run before building 32 | -- prebuild = 33 | 34 | -- script to run after building 35 | -- postbuild = 36 | 37 | -- script to run after building, before installing 38 | -- preinstall = 39 | 40 | -- script to run after installing 41 | -- postinstall = 42 | 43 | -- script to run before cleaning 44 | -- preclean = 45 | 46 | -- script to run after cleaning 47 | -- postclean = 48 | -------------------------------------------------------------------------------- /tests/CaseEval.newt: -------------------------------------------------------------------------------- 1 | module CaseEval 2 | 3 | data Nat : U where 4 | Z : Nat 5 | S : Nat -> Nat 6 | 7 | plus : Nat -> Nat -> Nat 8 | plus Z y = y 9 | plus (S x) y = S (plus x y) 10 | 11 | data Eq : {A : U} -> A -> A -> U where 12 | Refl : {A : U} -> {x : A} -> Eq x x 13 | 14 | two : Eq (plus (S Z) (S Z)) (S (S Z)) 15 | two = Refl 16 | 17 | three : Eq (plus (S Z) (S (S Z))) (plus (S (S Z)) (S Z)) 18 | three = Refl 19 | 20 | addZero : {n : Nat} -> Eq (plus Z n) n 21 | addZero {n} = Refl 22 | 23 | infixr 1 _,_ 24 | data Pair : U -> U -> U where 25 | _,_ : {A B : U} -> A -> B -> Pair A B 26 | 27 | fst : {A B : U} -> Pair A B -> A 28 | fst (a,b) = a 29 | 30 | -- I had an ordering issue, but it didn't show up with only one constructor argument 31 | test : Eq (fst (Z, S Z)) Z 32 | test = Refl 33 | -------------------------------------------------------------------------------- /tests/Concat.newt: -------------------------------------------------------------------------------- 1 | module Concat 2 | 3 | data Nat : U where 4 | Z : Nat 5 | S : Nat -> Nat 6 | 7 | infixl 7 _+_ 8 | _+_ : Nat -> Nat -> Nat 9 | Z + m = m 10 | S n + m = S (n + m) 11 | 12 | infixr 3 _::_ 13 | data List : U -> U where 14 | Nil : {A : U} -> List A 15 | _::_ : {A : U} -> A -> List A -> List A 16 | 17 | length : {A : U} -> List A -> Nat 18 | length Nil = Z 19 | length (x :: xs) = S (length xs) 20 | 21 | infixl 2 _++_ 22 | 23 | _++_ : {A : U} -> List A -> List A -> List A 24 | Nil ++ ys = ys 25 | x :: xs ++ ys = x :: (xs ++ ys) 26 | 27 | infixl 1 _≡_ 28 | data _≡_ : {A : U} -> A -> A -> U where 29 | Refl : {A : U} {a : A} -> a ≡ a 30 | 31 | replace : {A : U} {a b : A} -> (P : A -> U) -> a ≡ b -> P a -> P b 32 | replace p Refl x = x 33 | 34 | cong : {A B : U} {a b : A} -> (f : A -> B) -> a ≡ b -> f a ≡ f b 35 | cong f Refl = Refl 36 | 37 | thm : {A : U} (xs ys : List A) -> length (xs ++ ys) ≡ length xs + length ys 38 | thm Nil ys = Refl 39 | thm (x :: xs) ys = cong S (thm xs ys) 40 | -------------------------------------------------------------------------------- /tests/DupImport.newt: -------------------------------------------------------------------------------- 1 | module DupImport 2 | 3 | import Prelude 4 | import Prelude 5 | 6 | -------------------------------------------------------------------------------- /tests/Equality.newt: -------------------------------------------------------------------------------- 1 | module Equality 2 | 3 | data Eq : {A : U} -> A -> A -> U where 4 | Refl : {A : U} {a : A} -> Eq a a 5 | 6 | -- Some magic is not happening here. 7 | 8 | sym : {A : U} {x y : A} -> Eq x y -> Eq y x 9 | sym Refl = Refl 10 | 11 | trans : {A : U} {x y z : A} -> Eq x y -> Eq y z -> Eq x z 12 | trans Refl Refl = Refl 13 | 14 | coerce : {A B : U} -> Eq A B -> A -> B 15 | coerce Refl a = a 16 | 17 | J : {A : U} -> 18 | {C : (x y : A) -> Eq x y -> U} -> 19 | (c : (x : _) -> C x x Refl) -> 20 | (x y : A) -> 21 | (p : Eq x y) -> 22 | C x y p 23 | -- this was failing until I constrained scrutinee to the constructor + args 24 | J c x y Refl = c x 25 | -------------------------------------------------------------------------------- /tests/ForwardRecord.newt: -------------------------------------------------------------------------------- 1 | module ForwardRecord 2 | 3 | import Prelude 4 | 5 | record Point where 6 | x : Int 7 | y : Int 8 | 9 | instance Show Point 10 | 11 | 12 | instance Show Point where 13 | show pt = show pt.x ++ "," ++ show pt.y 14 | 15 | 16 | main : IO Unit 17 | main = do 18 | printLn $ MkPoint 1 2 19 | -------------------------------------------------------------------------------- /tests/ForwardRecord.newt.golden: -------------------------------------------------------------------------------- 1 | 1,2 2 | -------------------------------------------------------------------------------- /tests/InferenceIssue.newt: -------------------------------------------------------------------------------- 1 | module InferenceIssue 2 | 3 | import Prelude 4 | 5 | something : String → Maybe (Either String String) 6 | 7 | foo : String → Maybe String 8 | foo s = do 9 | bar <- something s 10 | case bar of 11 | Left x => Just x 12 | Right y => Just y 13 | 14 | -------------------------------------------------------------------------------- /tests/Let.newt: -------------------------------------------------------------------------------- 1 | module Let 2 | 3 | 4 | 5 | foo : Int -> Int 6 | foo n = let x = 42 in x 7 | -------------------------------------------------------------------------------- /tests/Neighbors.newt: -------------------------------------------------------------------------------- 1 | -- https://www.youtube.com/watch?v=pNBPCnZEdSs 2 | module Neighbors 3 | 4 | -- Prf ? 5 | import Prelude 6 | 7 | data Void : U where 8 | 9 | data Prf : U → U where 10 | Pf : ∀ a. {{_ : a}} → Prf a 11 | 12 | tryThis : ∀ A B. Prf A → Prf B → Prf A 13 | -- this needs help in newt 14 | tryThis (Pf {{x}}) b = Pf {_} {{x}} 15 | 16 | P : U 17 | 18 | data Bnd : U where 19 | bot : Bnd 20 | val : P → Bnd 21 | top : Bnd 22 | 23 | Rel : U → U 24 | Rel a = a × a → U 25 | 26 | L : P × P → U 27 | 28 | -- FIXME Rel Bnd needs to be expanded 29 | -- LH LB : Rel Bnd → U 30 | LH LB : Bnd × Bnd → U 31 | LH (bot, _) = Unit 32 | LH (val x, val y) = L (x, y) 33 | LH _ = Void 34 | LB xy = Prf (LH xy) 35 | data Set : U where 36 | SR SP : Set -- recursive / param 37 | S0 S1 : Set -- empty, unit 38 | _:+_ _:*_ : (S T : Set) → Set 39 | 40 | infixl 5 _:+_ _:*_ 41 | SetF : Set → U → U 42 | SetF sr r = r 43 | SetF sr p = p 44 | SetF (s :+ t) r = SetF s r + SetF t r 45 | SetF (s :* t) r = SetF s r * SetF t r 46 | 47 | infixl 5 <_> 48 | data MuSet : Set → U where 49 | <_> : ∀ t. SetF t (MuSet t) → MuSet t 50 | 51 | -- 9:30 52 | -------------------------------------------------------------------------------- /tests/Oper.newt: -------------------------------------------------------------------------------- 1 | module Oper 2 | 3 | -- These are hard-coded at the moment 4 | -- For now they must be of the form _op_, we'll circle back 5 | -- with a different parser, but that works today. 6 | 7 | -- this will be parsed as a top level decl, collected in TopContext, and 8 | -- injected into the Parser. It'll need to be passed around or available 9 | -- for read in the monad. 10 | 11 | -- long term, I might want TopContext in the parser, and parse a top-level 12 | -- declaration at a time (for incremental updates), but much longer term. 13 | 14 | infixl 8 _+_ _-_ 15 | infixl 9 _*_ _/_ 16 | 17 | 18 | 19 | ptype JVoid 20 | 21 | -- If we had a different quote here, we could tell vscode it's javascript. 22 | -- or actually just switch modes inside pfunc 23 | pfunc log : String -> JVoid := `(x) => console.log(x)` 24 | pfunc plus : Int -> Int -> Int := `(x,y) => x + y` 25 | pfunc _*_ : Int -> Int -> Int := `(x,y) => x * y` 26 | 27 | -- We now have to clean JS identifiers 28 | _+_ : Int -> Int -> Int 29 | _+_ x y = plus x y 30 | 31 | test : Int -> Int 32 | test x = 42 + x * 3 + 2 33 | 34 | infixr 0 _,_ 35 | data Pair : U -> U -> U where 36 | _,_ : {A B : U} -> A -> B -> Pair A B 37 | 38 | blah : Int -> Int -> Int -> Pair Int (Pair Int Int) 39 | blah x y z = (x , y, z) 40 | 41 | curryPlus : Pair Int Int -> Int 42 | curryPlus (a, b) = a + b 43 | 44 | -- case is different path, so separate test 45 | caseCurry : Pair Int Int -> Int 46 | caseCurry x = case x of 47 | (a, b) => a + b 48 | -------------------------------------------------------------------------------- /tests/Prelude.newt: -------------------------------------------------------------------------------- 1 | ../newt/Prelude.newt -------------------------------------------------------------------------------- /tests/RUTest.newt: -------------------------------------------------------------------------------- 1 | module RUTest 2 | 3 | import Prelude 4 | 5 | record Foo where 6 | constructor MkFoo 7 | bar : Nat 8 | baz : Nat 9 | 10 | blah : Foo → Foo 11 | blah x = [ bar := Z ] x 12 | 13 | main : IO Unit 14 | main = do 15 | let x = blah $ MkFoo (S Z) (S (S Z)) 16 | printLn x.bar 17 | -- this is unfortunate, it can't get record type from a meta 18 | let x' = the Foo $ [ baz := Z ] x 19 | printLn x'.baz 20 | -------------------------------------------------------------------------------- /tests/RUTest.newt.golden: -------------------------------------------------------------------------------- 1 | 0 2 | 0 3 | -------------------------------------------------------------------------------- /tests/SortedMap.newt: -------------------------------------------------------------------------------- 1 | ../newt/SortedMap.newt -------------------------------------------------------------------------------- /tests/TestCase.newt: -------------------------------------------------------------------------------- 1 | module TestCase 2 | 3 | -- I'm testing cases here, but using examples carefully design to be 4 | -- simple case trees. Patterns are a var or a constructor applied to vars. 5 | 6 | -- There are indexes below, but we're got pulling constraints out of them yet. 7 | 8 | 9 | 10 | data Nat : U where 11 | Z : Nat 12 | S : Nat -> Nat 13 | 14 | data Vect : Nat -> U -> U where 15 | Nil : {a : U} -> Vect Z a 16 | Cons : {a : U} {n : Nat} -> a -> Vect n a -> Vect (S n) a 17 | 18 | plus : Nat -> Nat -> Nat 19 | plus = \ n m => case n of 20 | Z => m 21 | S k => S (plus k m) 22 | 23 | -- Example from Jesper talk (translated to explicit case tree) 24 | max : Nat -> Nat -> Nat 25 | max = \ n m => case n of 26 | Z => m 27 | S k => case m of 28 | Z => S k 29 | S l => S (max k l) 30 | 31 | length : {a : U} {n : Nat} -> Vect n a -> Nat 32 | length = \ v => case v of 33 | Nil => Z 34 | Cons x xs => S (length xs) 35 | 36 | data Unit : U where 37 | MkUnit : Unit 38 | 39 | -- This should fail (and does!) 40 | -- bar : Vect (S Z) Unit 41 | -- bar = (Cons MkUnit (Cons MkUnit Nil)) 42 | 43 | data Bool : U where 44 | True : Bool 45 | False : Bool 46 | 47 | not : Bool -> Bool 48 | not = \ v => case v of 49 | True => False 50 | False => True 51 | 52 | 53 | not2 : Bool -> Bool 54 | not2 = \ v => case v of 55 | True => False 56 | x => True 57 | 58 | and : Bool -> Bool -> Bool 59 | and = \ x y => case x of 60 | True => y 61 | False => False 62 | 63 | nand : Bool -> Bool -> Bool 64 | nand = \ x y => not (case x of 65 | True => y 66 | False => False) 67 | 68 | -- -- this should be an error. 69 | -- foo : Bool -> Bool 70 | 71 | data Void : U where 72 | 73 | foo : Int 74 | foo = 42 75 | -------------------------------------------------------------------------------- /tests/TestCase2.newt: -------------------------------------------------------------------------------- 1 | module TestCase2 2 | 3 | data Nat : U where 4 | Z : Nat 5 | S : Nat -> Nat 6 | 7 | plus : Nat -> Nat -> Nat 8 | plus Z m = m 9 | -- if this is a capital K on LHS, it fails with a poor error message 10 | plus (S k) m = S (plus k m) 11 | 12 | -- -- Example from Jesper talk (translated to case tree) 13 | max : Nat -> Nat -> Nat 14 | max Z m = m 15 | max n Z = n 16 | max (S k) (S l) = S (max k l) 17 | 18 | data List : U -> U where 19 | LN : {a : U} -> List a 20 | LCons : {a : U} -> a -> List a -> List a 21 | 22 | data Vect : Nat -> U -> U where 23 | Nil : {a : U} -> Vect Z a 24 | Cons : {a : U} {n : Nat} -> a -> Vect n a -> Vect (S n) a 25 | 26 | -- NEXT Need to handle implicits 27 | -- I've hacked implicits, but need to figure out indices.. 28 | length : {a : U} {n : Nat} -> Vect n a -> Nat 29 | length Nil = Z 30 | length (Cons x xs) = S (length xs) 31 | 32 | data Unit : U where 33 | MkUnit : Unit 34 | 35 | -- This should fail (and does!) 36 | -- bar : Vect (S Z) Unit 37 | -- bar = (Cons MkUnit (Cons MkUnit Nil)) 38 | 39 | data Bool : U where 40 | True : Bool 41 | False : Bool 42 | 43 | not : Bool -> Bool 44 | not True = False 45 | not False = True 46 | 47 | 48 | not2 : Bool -> Bool 49 | not2 True = False 50 | not2 x = True 51 | 52 | -- TEST CASE - remove second clause here and expect error 53 | and : Bool -> Bool -> Bool 54 | and True y = y 55 | and False _ = False 56 | 57 | nand : Bool -> Bool -> Bool 58 | nand x y = not (case x of 59 | True => y 60 | False => False) 61 | 62 | 63 | -- for stuff like this, we should add Agda () and check for no constructors 64 | data Void : U where 65 | 66 | SnocList : U -> U 67 | SnocList a = List a 68 | 69 | -------------------------------------------------------------------------------- /tests/TestCase3.newt: -------------------------------------------------------------------------------- 1 | module TestCase3 2 | 3 | data Nat : U where 4 | Z : Nat 5 | S : Nat -> Nat 6 | 7 | data Maybe : U -> U where 8 | Just : {a : U} -> a -> Maybe a 9 | Nothing : {a : U} -> Maybe a 10 | 11 | 12 | -- failed to unify _:1 with Val 13 | -- Legit on RHS, IMO. On LHS, we should be dotting? 14 | -- I either need to unify and collect constraints or figure out how 15 | -- other systems manage this. 16 | 17 | -- Note that an unused 18 | -- variable may stand for either a wildcard or a forced pattern. In the latter case our algorithm 19 | -- treats it as a let-bound variable in the right-hand side of the clause. 20 | 21 | -- we need let-bound in environment but we do have define. 22 | 23 | fromMaybe : Maybe Nat -> Nat 24 | fromMaybe (Just x) = x 25 | fromMaybe Nothing = Z 26 | -------------------------------------------------------------------------------- /tests/TestCase4.newt: -------------------------------------------------------------------------------- 1 | module TestCase4 2 | 3 | data Nat : U where 4 | Z : Nat 5 | S : Nat -> Nat 6 | 7 | data Vect : Nat -> U -> U where 8 | Nil : {a : U} -> Vect Z a 9 | _::_ : {a : U} -> {k : Nat} -> a -> Vect k a -> Vect (S k) a 10 | 11 | infixr 5 _::_ 12 | 13 | head : {a : U} {k : Nat} -> Vect (S k) a -> a 14 | head (x :: xs) = x 15 | 16 | -- These came from a Conor McBride lecture where they use SHE 17 | 18 | vapp : {s t : U} {k : Nat} -> Vect k (s -> t) -> Vect k s -> Vect k t 19 | vapp (f :: fs) (t :: ts) = f t :: vapp fs ts 20 | vapp Nil Nil = Nil 21 | 22 | vec : { a : U } -> (n : Nat) -> a -> Vect n a 23 | vec Z x = Nil 24 | vec (S k) x = x :: vec k x 25 | 26 | -- And then typeclass, which I don't have yet. I'll add a few underlying functions 27 | 28 | fmap : {a b : U} {n : Nat} -> (a -> b) -> Vect n a -> Vect n b 29 | fmap f Nil = Nil 30 | fmap f (x :: xs) = (f x :: fmap f xs) 31 | 32 | pure : {a : U} {n : Nat} -> a -> Vect n a 33 | pure {a} {n} = vec n 34 | 35 | _<*>_ : {s t : U} {k : Nat} -> Vect k (s -> t) -> Vect k s -> Vect k t 36 | _<*>_ = vapp 37 | 38 | -- and idiom brackets (maybe someday) 39 | 40 | -- I'll add foldl 41 | 42 | foldl : {acc el : U} {n : Nat} -> (acc -> el -> acc) -> acc -> Vect n el -> acc 43 | foldl f acc Nil = acc 44 | foldl f acc (x :: xs) = foldl f (f acc x) xs 45 | 46 | zipWith : {a b c : U} {m : Nat} -> (a -> b -> c) -> Vect m a -> Vect m b -> Vect m c 47 | zipWith f Nil Nil = Nil 48 | zipWith f (x :: xs) (y :: ys) = f x y :: zipWith f xs ys 49 | 50 | transpose : {a : U} {m n : Nat} -> Vect m (Vect n a) -> Vect n (Vect m a) 51 | transpose {a} {Z} {n} Nil = vec n Nil 52 | transpose {a} {S z} {n} (_::_ {a'} {j} x xs) = zipWith (_::_) x (transpose xs) 53 | 54 | 55 | 56 | myArr : Vect (S (S (S Z))) (Vect (S (S Z)) Int) 57 | myArr = (1 :: 2 :: Nil) :: (3 :: 4 :: Nil) :: (5 :: 6 :: Nil) :: Nil 58 | 59 | 60 | /- 61 | 62 | -- this possibly needs dynamic pattern unification 63 | -- It's complaining about a meta in a pattern 64 | data Ix : U where 65 | 66 | infixr 2 _:-:_ 67 | data Path : (Sig : Ix -> Ix -> U) (i j : Ix) -> U where 68 | Stop : {Sig : Ix -> Ix -> U} {i : Ix} -> Path Sig i i 69 | _:-:_ : {Sig : Ix -> Ix -> U} {i j k : Ix} -> Sig i j -> Path Sig j k -> Path Sig i k 70 | 71 | 72 | pmap : {s t : Ix -> Ix -> U} -> (f : {i j : Ix} -> s i j -> t i j) -> {i j : Ix} -> Path s i j -> Path t i j 73 | pmap f Stop = Stop 74 | pmap f (s :-: ss) = f s :-: pmap f ss 75 | -/ 76 | -------------------------------------------------------------------------------- /tests/TestCase5.newt: -------------------------------------------------------------------------------- 1 | module TestCase5 2 | 3 | -- last bit tests pulling solutions from context 4 | 5 | data Plus : U -> U where 6 | MkPlus : {A : U} -> (A -> A -> A) -> Plus A 7 | 8 | infixl 7 _+_ 9 | _+_ : {A : U} {{_ : Plus A}} -> A -> A -> A 10 | _+_ {{MkPlus plus}} x y = plus x y 11 | 12 | 13 | pfunc plusInt : Int -> Int -> Int := `(x,y) => x + y` 14 | 15 | PlusInt : Plus Int 16 | PlusInt = MkPlus plusInt 17 | 18 | -- TODO this needs some aggressive inlining... 19 | double : Int -> Int 20 | double x = x + x 21 | 22 | data Nat : U where 23 | Z : Nat 24 | S : Nat -> Nat 25 | 26 | plus : Nat -> Nat -> Nat 27 | plus Z m = m 28 | plus (S n) m = S (plus n m) 29 | 30 | PlusNat : Plus Nat 31 | PlusNat = MkPlus plus 32 | 33 | double2 : {A : U} {{foo : Plus A}} -> A -> A 34 | double2 = \ a => a + a 35 | 36 | -------------------------------------------------------------------------------- /tests/TestImport.newt: -------------------------------------------------------------------------------- 1 | module TestImport 2 | 3 | import Prelude 4 | 5 | one : Nat 6 | one = S Z 7 | 8 | -------------------------------------------------------------------------------- /tests/TestMap.newt: -------------------------------------------------------------------------------- 1 | module TestMap 2 | 3 | import Prelude 4 | import SortedMap 5 | 6 | main : IO Unit 7 | main = do 8 | let m = updateMap 2 0 EmptyMap 9 | debugLog $ toList m 10 | debugLog $ toList $ deleteMap 2 m 11 | debugLog $ toList $ updateMap 2 3 m 12 | debugLog $ toList $ updateMap 1 3 m 13 | let x = 4 :: 1 :: 5 :: 7 :: 2 :: 9 :: 3 :: 10 :: 6 :: 0 :: 11 :: 12 :: 13 :: 20 :: 14 :: 16 :: 17 :: 8 :: Nil 14 | let m = foldl (\ m x => updateMap x MkUnit m) EmptyMap x 15 | debugLog $ toList m 16 | debugLog $ leftMost m 17 | debugLog $ rightMost m 18 | _ <- for x $ \ n => do 19 | putStrLn $ "ohne " ++ show n 20 | -- debugLog $ m 21 | debugLog $ map fst $ toList $ deleteMap n m 22 | putStrLn "" 23 | -------------------------------------------------------------------------------- /tests/TestMap.newt.golden: -------------------------------------------------------------------------------- 1 | [(2, 0)] 2 | [] 3 | [(2, 3)] 4 | [(1, 3), (2, 0)] 5 | [(0, "MkUnit"), (1, "MkUnit"), (2, "MkUnit"), (3, "MkUnit"), (4, "MkUnit"), (5, "MkUnit"), (6, "MkUnit"), (7, "MkUnit"), (8, "MkUnit"), (9, "MkUnit"), (10, "MkUnit"), (11, "MkUnit"), (12, "MkUnit"), (13, "MkUnit"), (14, "MkUnit"), (16, "MkUnit"), (17, "MkUnit"), (20, "MkUnit")] 6 | (Just _ (0, "MkUnit")) 7 | (Just _ (20, "MkUnit")) 8 | ohne 4 9 | [0, 1, 2, 3, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 20] 10 | ohne 1 11 | [0, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 20] 12 | ohne 5 13 | [0, 1, 2, 3, 4, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 20] 14 | ohne 7 15 | [0, 1, 2, 3, 4, 5, 6, 8, 9, 10, 11, 12, 13, 14, 16, 17, 20] 16 | ohne 2 17 | [0, 1, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 20] 18 | ohne 9 19 | [0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 11, 12, 13, 14, 16, 17, 20] 20 | ohne 3 21 | [0, 1, 2, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 20] 22 | ohne 10 23 | [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 11, 12, 13, 14, 16, 17, 20] 24 | ohne 6 25 | [0, 1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 20] 26 | ohne 0 27 | [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 20] 28 | ohne 11 29 | [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 13, 14, 16, 17, 20] 30 | ohne 12 31 | [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 14, 16, 17, 20] 32 | ohne 13 33 | [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 14, 16, 17, 20] 34 | ohne 20 35 | [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17] 36 | ohne 14 37 | [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 16, 17, 20] 38 | ohne 16 39 | [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 17, 20] 40 | ohne 17 41 | [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 20] 42 | ohne 8 43 | [0, 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, 12, 13, 14, 16, 17, 20] 44 | 45 | -------------------------------------------------------------------------------- /tests/TestPrim.newt: -------------------------------------------------------------------------------- 1 | module TestPrim 2 | 3 | 4 | -- we need to be able to declare a primitive type 5 | -- distinct from inductive type. there are no constructors per-se but it is inhabited 6 | 7 | 8 | 9 | 10 | pfunc strlen : String -> Int := `(x) => x.length()` 11 | 12 | -- why is there an eta in here? 13 | foo : String -> Int 14 | foo = \ x => strlen x 15 | 16 | bar : String -> String -> Int 17 | bar = \ x y => strlen x 18 | 19 | pfunc append : String -> String -> String := `(a,b) => a + b` 20 | 21 | blah : String 22 | blah = append "hello" "world" 23 | 24 | pfunc plus : Int -> Int -> Int := `(a,b) => a + b` 25 | 26 | answer : Int 27 | answer = plus 40 2 28 | 29 | -- I'd like to define prim operators too 30 | 31 | -- codegen test cases 32 | -- works, but two looks like () => (eta1) => (eta0) => one(eta1, eta0) 33 | pfunc one : Int -> Int -> Int := `(x,y) => x + y` 34 | 35 | two : Int -> Int -> Int 36 | two = one 37 | 38 | three : Int -> Int -> Int 39 | three = \ x => two x 40 | 41 | four : Int -> Int -> Int 42 | four = \x y => three x y 43 | 44 | -------------------------------------------------------------------------------- /tests/Tree.newt: -------------------------------------------------------------------------------- 1 | module Tree 2 | 3 | -- adapted from Conor McBride's 2-3 tree example 4 | -- youtube video: https://youtu.be/v2yXrOkzt5w?t=3013 5 | 6 | 7 | data Nat : U where 8 | Z : Nat 9 | S : Nat -> Nat 10 | 11 | data Unit : U where 12 | MkUnit : Unit 13 | 14 | data Void : U where 15 | 16 | infixl 4 _+_ 17 | 18 | data _+_ : U -> U -> U where 19 | inl : {A B} -> A -> A + B 20 | inr : {A B} -> B -> A + B 21 | 22 | infix 4 _<=_ 23 | 24 | _<=_ : Nat -> Nat -> U 25 | Z <= y = Unit 26 | S x <= Z = Void 27 | S x <= S y = x <= y 28 | 29 | cmp : (x y : Nat) -> (x <= y) + (y <= x) 30 | cmp Z y = inl MkUnit 31 | cmp (S z) Z = inr MkUnit 32 | cmp (S x) (S y) = cmp x y 33 | 34 | -- 53:21 35 | 36 | data Bnd : U where 37 | Bot : Bnd 38 | N : Nat -> Bnd 39 | Top : Bnd 40 | 41 | infix 4 _<<=_ 42 | 43 | _<<=_ : Bnd -> Bnd -> U 44 | Bot <<= _ = Unit 45 | N x <<= N y = x <= y 46 | _ <<= Top = Unit 47 | _ <<= _ = Void 48 | 49 | data Intv : Bnd -> Bnd -> U where 50 | intv : {l u} (x : Nat) (lx : l <<= N x) (xu : N x <<= u) -> Intv l u 51 | 52 | data T23 : Bnd -> Bnd -> Nat -> U where 53 | leaf : {l u} (lu : l <<= u) -> T23 l u Z 54 | node2 : {l u h} (x : _) 55 | (tlx : T23 l (N x) h) (txu : T23 (N x) u h) -> 56 | T23 l u (S h) 57 | node3 : {l u h} (x y : _) 58 | (tlx : T23 l (N x) h) (txy : T23 (N x) (N y) h) (tyu : T23 (N y) u h) -> 59 | T23 l u (S h) 60 | 61 | -- 56: 62 | 63 | infixl 5 _*_ 64 | infixr 1 _,_ 65 | data Sg : (A : U) -> (A -> U) -> U where 66 | _,_ : {A : U} {B : A -> U} -> (a : A) -> B a -> Sg A B 67 | 68 | _*_ : U -> U -> U 69 | A * B = Sg A (\ _ => B) 70 | 71 | TooBig : Bnd -> Bnd -> Nat -> U 72 | TooBig l u h = Sg Nat (\ x => T23 l (N x) h * T23 (N x) u h) 73 | 74 | insert : {l u h} -> Intv l u -> T23 l u h -> TooBig l u h + T23 l u h 75 | insert (intv x lx xu) (leaf lu) = inl (x , (leaf lx , leaf xu)) 76 | insert (intv x lx xu) (node2 y tly tyu) = case cmp x y of 77 | -- u := N y is not solved at this time 78 | inl xy => case insert (intv {_} {N y} x lx xy) tly of 79 | inl (z , (tlz , tzy)) => inr (node3 z y tlz tzy tyu) 80 | inr tly' => inr (node2 y tly' tyu) 81 | inr yx => case insert (intv {N y} x yx xu) tyu of 82 | inl (z , (tyz , tzu)) => inr (node3 y z tly tyz tzu) 83 | inr tyu' => inr (node2 y tly tyu') 84 | insert (intv x lx xu) (node3 y z tly tyz tzu) = case cmp x y of 85 | inl xy => case insert (intv {_} {N y} x lx xy) tly of 86 | inl (v , (tlv , tvy)) => inl (y , (node2 v tlv tvy , node2 z tyz tzu)) 87 | inr tly' => inr (node3 y z tly' tyz tzu) 88 | inr yx => case cmp x z of 89 | inl xz => case insert (intv {N y} {N z} x yx xz) tyz of 90 | inl (w , (tyw , twz)) => inl (w , (node2 y tly tyw , node2 z twz tzu)) 91 | inr tyz' => inr (node3 y z tly tyz' tzu) 92 | inr zx => case insert (intv {N z} x zx xu) tzu of 93 | inl (w , (tzw , twu)) => inl (z , (node2 y tly tyz , node2 w tzw twu)) 94 | inr tzu' => inr (node3 y z tly tyz tzu') 95 | -------------------------------------------------------------------------------- /tests/TypeClass.newt: -------------------------------------------------------------------------------- 1 | module TypeClass 2 | 3 | data Monad : (U -> U) -> U where 4 | MkMonad : { M : U -> U } -> 5 | (bind : ∀ A B. (M A) -> (A -> M B) -> M B) -> 6 | (pure : ∀ A. A -> M A) -> 7 | Monad M 8 | 9 | infixl 1 _>>=_ _>>_ 10 | _>>=_ : ∀ m a b. {{Monad m}} -> (m a) -> (a -> m b) -> m b 11 | _>>=_ {{MkMonad bind' _}} ma amb = bind' ma amb 12 | 13 | _>>_ : ∀ m a b. {{Monad m}} -> m a -> m b -> m b 14 | ma >> mb = mb 15 | 16 | pure : ∀ m a. {{Monad m}} -> a -> m a 17 | pure {{MkMonad _ pure'}} a = pure' a 18 | 19 | data Either : U -> U -> U where 20 | Left : ∀ A B. A -> Either A B 21 | Right : ∀ A B. B -> Either A B 22 | 23 | bindEither : ∀ A B C. (Either A B) -> (B -> Either A C) -> Either A C 24 | bindEither (Left a) amb = Left a 25 | bindEither (Right b) amb = amb b 26 | 27 | EitherMonad : {A : U} -> Monad (Either A) 28 | EitherMonad = MkMonad {Either A} bindEither Right 29 | 30 | data Maybe : U -> U where 31 | Just : ∀ A. A -> Maybe A 32 | Nothing : ∀ A. Maybe A 33 | 34 | bindMaybe : ∀ A B. Maybe A -> (A -> Maybe B) -> Maybe B 35 | bindMaybe Nothing amb = Nothing 36 | bindMaybe (Just a) amb = amb a 37 | 38 | MaybeMonad : Monad Maybe 39 | MaybeMonad = MkMonad bindMaybe Just 40 | 41 | infixr 7 _::_ 42 | data List : U -> U where 43 | Nil : ∀ A. List A 44 | _::_ : ∀ A. A -> List A -> List A 45 | 46 | infixl 7 _++_ 47 | _++_ : ∀ A. List A -> List A -> List A 48 | Nil ++ ys = ys 49 | (x :: xs) ++ ys = x :: (xs ++ ys) 50 | 51 | bindList : ∀ A B. List A -> (A -> List B) -> List B 52 | bindList Nil f = Nil 53 | bindList (x :: xs) f = f x ++ bindList xs f 54 | 55 | singleton : ∀ A. A -> List A 56 | singleton a = a :: Nil 57 | 58 | -- TODO need better error when the monad is not defined 59 | ListMonad : Monad List 60 | ListMonad = MkMonad bindList singleton 61 | 62 | infixr 1 _,_ 63 | data Pair : U -> U -> U where 64 | _,_ : ∀ A B. A -> B -> Pair A B 65 | 66 | 67 | 68 | test : Maybe Int 69 | test = pure 10 70 | 71 | foo : Int -> Maybe Int 72 | foo x = Just 42 >> Just x >>= (\ x => pure 10) 73 | 74 | bar : Int -> Maybe Int 75 | bar x = do 76 | let y = x 77 | z <- Just x 78 | pure z 79 | 80 | baz : ∀ A B. List A -> List B -> List (Pair A B) 81 | baz xs ys = do 82 | x <- xs 83 | y <- ys 84 | pure (x , y) 85 | -------------------------------------------------------------------------------- /tests/Zoo1.newt: -------------------------------------------------------------------------------- 1 | module Zoo1 2 | 3 | -- I'm starting to translate ezoo 01-eval-closures-debruijn as a test cases. 4 | 5 | 6 | 7 | 8 | ------- Prelude stuff 9 | 10 | data Nat : U where 11 | Z : Nat 12 | S : Nat -> Nat 13 | 14 | data Unit : U where 15 | MkUnit : Unit 16 | 17 | data List : U -> U where 18 | Nil : {a : U} -> List a 19 | Cons : {a : U} -> a -> List a -> List a 20 | 21 | data Maybe : U -> U where 22 | Just : {a : U} -> a -> Maybe a 23 | Nothing : {a : U} -> Maybe a 24 | 25 | 26 | ---------------------------------- 27 | 28 | -- forward declaration 29 | Val : U 30 | 31 | data Tm : U where 32 | Var : Nat -> Tm 33 | Lam : Tm -> Tm -- lam (x.t) 34 | App : Tm -> Tm -> Tm 35 | Let : Tm -> Tm -> Tm -- let t (x.u) 36 | 37 | data Env : U where 38 | ENil : Env 39 | Define : Env -> Val -> Env 40 | 41 | data Closure : U where 42 | MkClosure : Env -> Tm -> Closure 43 | 44 | data Val : U where 45 | VVar : Nat -> Val 46 | VApp : Val -> Val -> Val 47 | VLam : Closure -> Val 48 | 49 | length : Env -> Nat 50 | length ENil = Z 51 | length (Define env _) = S (length env) 52 | 53 | lookup : Env -> Nat -> Maybe Val 54 | lookup (Define env v) Z = Just v 55 | -- If I write "Just (lookup env k)" on RHS, it's wrong, but the error message is unusable (mainly due to FC) 56 | -- The FC is fine if I write lookup {Val} env k 57 | lookup (Define env _) (S k) = lookup env k 58 | lookup (ENil) x = Nothing 59 | 60 | eval : Env -> Tm -> Val 61 | 62 | cApp : Closure -> Val -> Val 63 | -- If I put Closure instead of MkClosure, it reports missing case, fix that (should be bad constructor or something) 64 | cApp (MkClosure env t) u = eval (Define env u) t 65 | 66 | hole : Val 67 | 68 | -- TODO need to inline solved metas somewhere, as error messages are unreadable 69 | -- NEXT fix FC for missing case if we remove _ 70 | 71 | eval env tm = case tm of 72 | (Var x) => 73 | case lookup env x of 74 | -- case doesn't use the new code. We've got a wildcard here that 75 | -- is forced to {Val}, but we don't have forcing/dotting 76 | -- I guess we see what Jesper says about dotting 77 | Just x => x 78 | Nothing => VVar x 79 | -- TODO no tupls yet 80 | App t u => case eval env t of 81 | VLam t => cApp t (eval env u) 82 | t => VApp t (eval env u) 83 | Lam t => VLam (MkClosure env t) 84 | Let t u => eval (Define env (eval env t)) u 85 | -- NEXT this is unreachable, find out how to warn about it 86 | -- _ => hole 87 | 88 | lvl2ix : Nat -> Nat -> Nat 89 | lvl2ix (S k) (S j) = lvl2ix k j 90 | lvl2ix Z (S j) = j 91 | lvl2ix _ Z = Z -- shouldn't happen 92 | 93 | quote : Nat -> Val -> Tm 94 | quote l v = case v of 95 | VVar x => Var (lvl2ix l x) 96 | VApp t u => App (quote l t) (quote l u) 97 | VLam t => Lam (quote (S l) (cApp t (VVar l))) 98 | 99 | nf : Env -> Tm -> Tm 100 | nf env t = quote (length env) (eval env t) 101 | 102 | -- and then a parser / example 103 | -- Are we ready to try building a parser in newt? 104 | 105 | 106 | -------------------------------------------------------------------------------- /tests/Zoo2eg.newt: -------------------------------------------------------------------------------- 1 | module Zoo2eg 2 | 3 | id : (A : U) -> A -> A 4 | id = \ A x => x 5 | 6 | const : (A B : U) -> A -> B -> A 7 | const = \A B x y => x 8 | 9 | Nat : U 10 | Nat = (N : U) -> (N -> N) -> N -> N 11 | 12 | zero : Nat 13 | zero = \ _ s z => z 14 | 15 | succ : Nat -> Nat 16 | succ = \ n ty s z => s (n ty s z) 17 | 18 | -- need Nat to reduce (and syntax highlighting) 19 | five : Nat 20 | five = \ N s z => s (s (s (s (s z)))) 21 | 22 | add : Nat -> Nat -> Nat 23 | add = \a b N s z => a N s (b N s z) 24 | 25 | mul : Nat -> Nat -> Nat 26 | mul = \a b N s z => a N (b N s) z 27 | 28 | ten : Nat 29 | ten = add five five 30 | 31 | hundred : Nat 32 | hundred = mul ten ten 33 | 34 | thousand : Nat 35 | thousand = mul ten hundred 36 | 37 | -- and then nf / eval of hundred 38 | -- #nf hundred 39 | -------------------------------------------------------------------------------- /tests/Zoo3eg.newt: -------------------------------------------------------------------------------- 1 | module Zoo3eg 2 | 3 | id : (A : _) -> A -> A 4 | id = \ A x => x 5 | 6 | List : U -> U 7 | List = \ A => (L : _) -> (A -> L -> L) -> L -> L 8 | 9 | nil : (A : _) -> List A 10 | nil = \ A L cons nil => nil 11 | 12 | cons : (A : _) -> A -> List A -> List A 13 | cons = \A x xs L cons nil => cons x (xs _ cons nil) 14 | 15 | Bool : U 16 | Bool = (B : _) -> B -> B -> B 17 | 18 | true : Bool 19 | true = \ B t f => t 20 | 21 | false : Bool 22 | false = \ B t f => f 23 | 24 | not : Bool -> Bool 25 | not = \ b B t f => b B f t 26 | 27 | Eq : (A : _) -> A -> A -> U 28 | Eq = \A x y => (P : A -> U) -> P x -> P y 29 | 30 | refl : (A : _) (x : A) -> Eq A x x 31 | refl = \ A x p px => px 32 | 33 | list1 : List Bool 34 | list1 = cons _ true (cons _ false (nil _)) 35 | 36 | Nat : U 37 | Nat = (N : U) -> (N -> N) -> N -> N 38 | 39 | five : Nat 40 | five = \ N s z => s (s (s (s (s z)))) 41 | 42 | add : Nat -> Nat -> Nat 43 | add = \ a b N s z => a N s (b N s z) 44 | 45 | mul : Nat -> Nat -> Nat 46 | mul = \a b N s z => a N (b N s) z 47 | 48 | ten : Nat 49 | ten = add five five 50 | 51 | hundred : Nat 52 | hundred = mul ten ten 53 | 54 | thousand : Nat 55 | thousand = mul ten hundred 56 | 57 | eqTest : Eq _ hundred hundred 58 | eqTest = refl _ _ 59 | -------------------------------------------------------------------------------- /tests/Zoo4eg.newt: -------------------------------------------------------------------------------- 1 | module Zoo4eg 2 | 3 | id : {A : U} -> A -> A 4 | id = \x => x -- elaborated to \{A} x. x 5 | 6 | -- implicit arg types can be omitted 7 | const : {A B : U} -> A -> B -> A 8 | const = \x y => x 9 | 10 | -- function arguments can be grouped: 11 | group1 : {A B : U}(x y z : A) -> B -> B 12 | group1 = \x y z b => b 13 | 14 | group2 : {A B : U}(x y z : A) -> B -> B 15 | group2 = \x y z b => b 16 | 17 | -- explicit id function used for annotation as in Idris 18 | the : (A : _) -> A -> A 19 | the = \_ x => x 20 | 21 | -- implicit args can be explicitly given 22 | -- NB kovacs left off the type (different syntax), so I put a hole in there 23 | argTest1 : _ 24 | argTest1 = const {U} {U} U 25 | 26 | -- I've decided not to do = in the {} for now. 27 | -- let argTest2 = const {B = U} U; -- only give B, the second implicit arg 28 | 29 | -- again no type, this hits a lambda in infer. 30 | -- I think we need to create two metas and make a pi of them. 31 | insert2 : _ 32 | insert2 = (\{A} x => the A x) U -- (\{A} x => the A x) {U} U 33 | 34 | Bool : U 35 | Bool = (B : _) -> B -> B -> B 36 | 37 | true : Bool 38 | true = \B t f => t 39 | 40 | false : Bool 41 | false = \B t f => f 42 | 43 | List : U -> U 44 | List = \A => (L : _) -> (A -> L -> L) -> L -> L 45 | 46 | nil : {A : U} -> List A 47 | nil = \L cons nil => nil 48 | 49 | cons : {A : U} -> A -> List A -> List A 50 | cons = \ x xs L cons nil => cons x (xs L cons nil) 51 | 52 | map : {A B : U} -> (A -> B) -> List A -> List B 53 | map = \{A} {B} f xs L c n => xs L (\a => c (f a)) n 54 | 55 | list1 : List Bool 56 | list1 = cons true (cons false (cons true nil)) 57 | 58 | -- dependent function composition 59 | comp : {A : U} {B : A -> U} {C : {a : A} -> B a -> U} 60 | (f : {a : A} (b : B a) -> C b) 61 | (g : (a : A) -> B a) 62 | (a : A) 63 | -> C (g a) 64 | comp = \f g a => f (g a) 65 | 66 | -- TODO unsolved metas in dependent function composition 67 | -- compExample : List Bool 68 | -- compExample = comp (cons true) (cons false) nil 69 | 70 | Nat : U 71 | Nat = (N : U) -> (N -> N) -> N -> N 72 | 73 | mul : Nat -> Nat -> Nat 74 | mul = \a b N s z => a _ (b _ s) z 75 | 76 | ten : Nat 77 | ten = \N s z => (s (s (s (s (s (s (s (s (s (s z)))))))))) 78 | 79 | hundred : _ 80 | hundred = mul ten ten 81 | 82 | -- Leibniz equality 83 | Eq : {A : U} -> A -> A -> U 84 | Eq = \{A} x y => (P : A -> U) -> P x -> P y 85 | 86 | refl : {A : U} {x : A} -> Eq x x 87 | refl = \_ px => px 88 | 89 | sym : {A x y : _} -> Eq {A} x y -> Eq y x 90 | sym = \p => p (\y => Eq y x) refl 91 | 92 | eqtest : Eq (mul ten ten) hundred 93 | eqtest = refl 94 | -------------------------------------------------------------------------------- /tests/aside/Test1.newt: -------------------------------------------------------------------------------- 1 | module Test1 2 | 3 | -- This is not total 4 | nat : U 5 | nat = {C : U} -> C -> (nat -> C) -> C 6 | 7 | -- TESTCASE This was broken when I wasn't expanding Ref ty in check 8 | -- Also broken when I tried to put Def in VRef 9 | -- Broken if I don't `nf` the type of a function before putting in TopContext 10 | succ : nat -> nat 11 | succ = \n => \ z s => s n 12 | -------------------------------------------------------------------------------- /vim/compiler/newt.vim: -------------------------------------------------------------------------------- 1 | 2 | 3 | let current_compiler = 'newt' 4 | if exists(":CompilerSet") != 2 5 | command -nargs=* CompilerSet setlocal 6 | endif 7 | 8 | CompilerSet makeprg=newt 9 | " doesn't work 10 | setlocal errorformat=ERROR\ at\ %f:(%l\,\ %c):\ %m,%-G%.%# 11 | 12 | -------------------------------------------------------------------------------- /vim/ftdetect/newt.vim: -------------------------------------------------------------------------------- 1 | autocmd BufRead,BufNewFile *.newt set filetype=newt -------------------------------------------------------------------------------- /vim/ftplugin/newt.vim: -------------------------------------------------------------------------------- 1 | setlocal syntax=newt 2 | setlocal comments=s1:/-,mb:*,ex:-/,:-- 3 | setlocal commentstring=--\ %s 4 | setlocal expandtab 5 | setlocal tabstop=2 6 | 7 | setlocal makeprg=build/exec/newt\ % 8 | -------------------------------------------------------------------------------- /vim/indent/newt.vim: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dunhamsteve/newt/8dae8880f9bf3bf0363378b56c9d67e2529c0fb0/vim/indent/newt.vim -------------------------------------------------------------------------------- /vim/syntax/newt.vim: -------------------------------------------------------------------------------- 1 | syn keyword newtInfix infix infixl infixr 2 | syn keyword newtKW data where let in case of 3 | syn keyword newtLet let in 4 | syn match newtIdentifier "[a-zA-Z][a-zA-Z]*" contained 5 | syn keyword newtStructure data import module where 6 | syn region newtBlockComment start="/-" end="-/" contained 7 | syn match newtLineComment "--.*$" contains=@Spell 8 | 9 | " no idea why this works for idris but not here 10 | "highlight dev link newtIdentifier Identifier 11 | highlight def link newtInfix PreProc 12 | highlight def link newtBlockComment Comment 13 | highlight def link newtLineComment Comment 14 | highlight def link newtLet Structure 15 | highlight def link newtStructure Structure 16 | 17 | let b:current_syntax = "newt" 18 | --------------------------------------------------------------------------------