write output to file (if -o), cmd line parser, handle dup imports

This commit is contained in:
2024-09-29 11:06:48 -07:00
parent fa7d803ebb
commit 76e627825c
5 changed files with 55 additions and 32 deletions

View File

@@ -34,7 +34,8 @@ I may be done with `U` - I keep typing `Type`.
- [ ] do blocks - [ ] do blocks
- [ ] some solution for `+` problem (classes? ambiguity?) - [ ] some solution for `+` problem (classes? ambiguity?)
- [x] show compiler failure in the editor (exit code != 0) - [x] show compiler failure in the editor (exit code != 0)
- [ ] write js files into `out` directory - [x] write output to file
- uses `-o` option
- [ ] detect extra clauses in case statements - [ ] detect extra clauses in case statements
- [ ] add test framework - [ ] add test framework
- [ ] decide what to do for erasure - [ ] decide what to do for erasure

View File

@@ -19,11 +19,11 @@ lookup nm top = go top.defs
export export
covering covering
Show TopContext where Show TopContext where
show (MkTop defs metas _ _) = "\nContext:\n [\{ joinBy "\n" $ map show defs}]" show (MkTop defs metas _ _ _) = "\nContext:\n [\{ joinBy "\n" $ map show defs}]"
public export public export
empty : HasIO m => m TopContext empty : HasIO m => m TopContext
empty = pure $ MkTop [] !(newIORef (MC [] 0)) False !(newIORef []) empty = pure $ MkTop [] !(newIORef (MC [] 0)) False !(newIORef []) []
||| set or replace def. probably need to check types and Axiom on replace ||| set or replace def. probably need to check types and Axiom on replace
public export public export

View File

@@ -342,6 +342,8 @@ record TopContext where
metas : IORef MetaContext metas : IORef MetaContext
verbose : Bool verbose : Bool
errors : IORef (List Error) errors : IORef (List Error)
||| loaded modules
loaded : List String
-- we'll use this for typechecking, but need to keep a TopContext around too. -- we'll use this for typechecking, but need to keep a TopContext around too.

View File

@@ -25,21 +25,6 @@ import System.Directory
import System.File import System.File
import System.Path import System.Path
{-
import
need to find the file.
- get base directory
- . to /
- add .newt
loop back to processFile
-}
fail : String -> M a fail : String -> M a
fail msg = putStrLn msg >> exitFailure fail msg = putStrLn msg >> exitFailure
@@ -58,6 +43,13 @@ dumpSource = do
doc <- compile doc <- compile
putStrLn $ render 90 doc putStrLn $ render 90 doc
writeSource : String -> M ()
writeSource fn = do
doc <- compile
Right _ <- writeFile fn $ render 90 doc
| Left err => fail (show err)
pure ()
parseFile : String -> M (String,Module) parseFile : String -> M (String,Module)
parseFile fn = do parseFile fn = do
Right src <- readFile $ fn Right src <- readFile $ fn
@@ -67,15 +59,22 @@ parseFile fn = do
| Left y => fail (showError src y) | Left y => fail (showError src y)
pure (src, res) pure (src, res)
loadModule : String -> String -> M () loadModule : String -> List String -> String -> M ()
loadModule base name = do loadModule base stk name = do
top <- get
-- already loaded?
let False := elem name top.loaded | _ => pure ()
modify { loaded $= (name::) }
let fn = base ++ "/" ++ name ++ ".newt" let fn = base ++ "/" ++ name ++ ".newt"
(src, res) <- parseFile fn (src, res) <- parseFile fn
putStrLn "module \{res.name}" putStrLn "module \{res.name}"
let True = name == res.name let True = name == res.name
| _ => fail "module name \{show res.name} doesn't match file name \{show fn}" | _ => fail "module name \{show res.name} doesn't match file name \{show fn}"
-- TODO separate imports and detect loops / redundant -- TODO separate imports and detect loops / redundant
for_ res.imports $ \ (MkImport fc name) => loadModule base name for_ res.imports $ \ (MkImport fc name') => do
-- we could use `fc` if it had a filename in it
when (name' `elem` stk) $ error emptyFC "import loop \{show name} -> \{show name'}"
loadModule base (name :: stk) name'
-- TODO Lift the error exit, so import errors can get a FC in current file -- TODO Lift the error exit, so import errors can get a FC in current file
putStrLn "process Decls" putStrLn "process Decls"
@@ -92,12 +91,11 @@ processFile fn = do
let parts = splitPath fn let parts = splitPath fn
let file = fromMaybe "" $ last' parts let file = fromMaybe "" $ last' parts
let dir = fromMaybe "./" $ parent fn let dir = fromMaybe "./" $ parent fn
let (base,ext) = splitFileName (fromMaybe "" $ last' parts) let (name,ext) = splitFileName (fromMaybe "" $ last' parts)
putStrLn "\{show dir} \{show base} \{show ext}" putStrLn "\{show dir} \{show name} \{show ext}"
loadModule dir base loadModule dir [] name
top <- get top <- get
dumpContext top -- dumpContext top
dumpSource
[] <- readIORef top.errors [] <- readIORef top.errors
| errors => do | errors => do
@@ -106,14 +104,31 @@ processFile fn = do
exitFailure exitFailure
pure () pure ()
cmdLine : List String -> M (Maybe String, List String)
cmdLine [] = pure (Nothing, [])
cmdLine ("-v" :: args) = do
modify { verbose := True }
cmdLine args
cmdLine ("-o" :: fn :: args) = do
(out, files) <- cmdLine args
pure (out <|> Just fn, files)
cmdLine (fn :: args) = do
let True := ".newt" `isSuffixOf` fn
| _ => error emptyFC "Bad argument \{show fn}"
(out, files) <- cmdLine args
pure $ (out, fn :: files)
main' : M () main' : M ()
main' = do main' = do
args <- getArgs (arg0 :: args) <- getArgs
putStrLn "Args: \{show args}" | _ => error emptyFC "error reading args"
let (_ :: files) = args (out, files) <- cmdLine args
| _ => putStrLn "Usage: newt foo.newt" traverse_ processFile files
when ("-v" `elem` files) $ modify { verbose := True } case out of
traverse_ processFile (filter (".newt" `isSuffixOf`) files) Nothing => pure ()
Just name => writeSource name
-- traverse_ processFile (filter (".newt" `isSuffixOf`) files) out
main : IO () main : IO ()
main = do main = do

View File

@@ -0,0 +1,5 @@
module DupImport
import Prelude
import Prelude