Aoc passes, and it successfully compiles itself.

This commit is contained in:
2025-01-05 13:56:38 -08:00
parent 9172d88be7
commit 627ca5d91b
6 changed files with 18 additions and 12 deletions

View File

@@ -532,9 +532,11 @@ drop Z xs = xs
drop (S k) (x :: xs) = drop k xs drop (S k) (x :: xs) = drop k xs
take : a. Nat -> List a -> List a take : a. Nat -> List a -> List a
take Z xs = Nil take {a} n xs = go n xs Lin
take _ Nil = Nil where
take (S k) (x :: xs) = x :: take k xs go : Nat List a SnocList a List a
go (S k) (x :: xs) acc = go k xs (acc :< x)
go _ _ acc = acc <>> Nil
getAt : a. Nat List a Maybe a getAt : a. Nat List a Maybe a
getAt _ Nil = Nothing getAt _ Nil = Nothing
@@ -880,8 +882,11 @@ getAt' : ∀ a. Int → List a → Maybe a
getAt' i xs = getAt (cast i) xs getAt' i xs = getAt (cast i) xs
length' : a. List a Int length' : a. List a Int
length' Nil = 0 length' xs = go xs 0
length' (x :: xs) = 1 + length' xs where
go : a. List a Int Int
go Nil acc = acc
go (x :: xs) acc = go xs (acc + 1)
unlines : List String String unlines : List String String
unlines lines = joinBy "\n" lines unlines lines = joinBy "\n" lines

View File

@@ -138,7 +138,7 @@ compileTerm (UU _) = pure $ CRef "U"
compileTerm (Pi _ nm icit rig t u) = do compileTerm (Pi _ nm icit rig t u) = do
t' <- compileTerm t t' <- compileTerm t
u' <- compileTerm u u' <- compileTerm u
pure $ CApp (CRef "PiType") (t' :: u' :: Nil) 0 pure $ CApp (CRef "PiType") (t' :: CLam nm u' :: Nil) 0
compileTerm (Case _ t alts) = do compileTerm (Case _ t alts) = do
t' <- compileTerm t t' <- compileTerm t
alts' <- for alts $ \case alts' <- for alts $ \case

View File

@@ -257,7 +257,7 @@ solveAutos mstart = do
top <- get top <- get
mc <- readIORef top.metaCtx mc <- readIORef top.metaCtx
let mlen = length' mc.metas - mstart let mlen = length' mc.metas - mstart
res <- run $ filter isAuto (take (cast mlen) mc.metas) res <- run $ filter isAuto (ite (mstart == 0) mc.metas $ take (cast mlen) mc.metas)
if res then solveAutos mstart else pure MkUnit if res then solveAutos mstart else pure MkUnit
where where
isAuto : MetaEntry -> Bool isAuto : MetaEntry -> Bool

View File

@@ -80,7 +80,7 @@ class Pretty a where
render : Int -> Doc -> String render : Int -> Doc -> String
render w x = layout (best w 0 x) Lin render w x = layout (best w 0 (noAlt x)) Lin
instance Semigroup Doc where x <+> y = Seq x (Seq (Text " ") y) instance Semigroup Doc where x <+> y = Seq x (Seq (Text " ") y)

View File

@@ -193,7 +193,8 @@ processFile fn = do
processDecl ("Prim" :: Nil) (PType emptyFC "Int" Nothing) processDecl ("Prim" :: Nil) (PType emptyFC "Int" Nothing)
processDecl ("Prim" :: Nil) (PType emptyFC "String" Nothing) processDecl ("Prim" :: Nil) (PType emptyFC "String" Nothing)
processDecl ("Prim" :: Nil) (PType emptyFC "Char" Nothing) processDecl ("Prim" :: Nil) (PType emptyFC "Char" Nothing)
let base = "aoc2024" -- FIXME -- let base = "aoc2024" -- FIXME
let base = "port" -- FIXME
src <- processModule emptyFC base Nil (QN path modName') src <- processModule emptyFC base Nil (QN path modName')
top <- get top <- get
-- -- dumpContext top -- -- dumpContext top

View File

@@ -2,10 +2,10 @@
# script to translate a file from idris to newt # script to translate a file from idris to newt
# this is just a first pass, hopefully # this is just a first pass, hopefully
mkdir -p port mkdir -p xlate
find src -type f -name '*.idr' | while read -r file; do find src -type f -name '*.idr' | while read -r file; do
output_file="port/${file#src/}" output_file="xlate/${file#src/}"
output_file="${output_file%.idr}.newt" output_file="${output_file%.idr}.newt"
mkdir -p "$(dirname "$output_file")" mkdir -p "$(dirname "$output_file")"
if [[ ! -f "$output_file" ]]; then if [[ ! -f "$output_file" ]]; then
@@ -49,4 +49,4 @@ find src -type f -name '*.idr' | while read -r file; do
' "$file" > "$output_file" ' "$file" > "$output_file"
fi fi
done done
rsync -av done/ port #rsync -av done/ xlate