wip

dex.cabal

@@ -53,14 +53,14 @@ library
                      -- , Imp
                      -- , ImpToLLVM
                      , IncState
-                     -- , Inference
+                     , Inference
                      -- , Inline
                      -- , JAX.Concrete
                      -- , JAX.Rename
                      -- , JAX.ToSimp
                      , LLVM.Link
                      , LLVM.Compile
-                     , LLVM.CUDA
+                     -- , LLVM.CUDA
                      , LLVM.Shims
                      , Lexing
                      -- , Linearize
@@ -77,19 +77,19 @@ library
                      -- , RuntimePrint
                      -- , Serialize
                      -- , Simplify
-                     -- , Subst
+                      , Subst
                      , SourceRename
                      , SourceIdTraversal
                      , TopLevel2
                      -- , Transpose
                      , Types.Simple
                      , Types.Complicated
-                     , Types.Imp
+                     -- , Types.Imp
                      , Types.Primitives
                      , Types.Source
                      , Types.Top2
                      -- , QueryType
-                     -- , QueryTypePure
+                     , QueryTypePure
                      , Util
                      -- , Vectorize
                      , Actor

src/dex.hs

@@ -4,8 +4,6 @@
 -- license that can be found in the LICENSE file or at
 -- https://developers.google.com/open-source/licenses/bsd
 
-import System.Console.Haskeline
-import System.Exit
 import Control.Monad
 import Control.Monad.State.Strict
 import Options.Applicative hiding (Success, Failure)
@@ -14,25 +12,17 @@ import System.Posix.Terminal (queryTerminal)
 import System.Posix.IO (stdOutput)
 
 import Data.List
-import qualified Data.Text as T
-import qualified Data.Map.Strict as M
 import qualified System.Console.ANSI as ANSI
 import System.Console.ANSI hiding (Color)
 
 import Types.Source
 import TopLevel2
-import AbstractSyntax (parseTopDeclRepl)
-import ConcreteSyntax (keyWordStrs, preludeImportBlock)
--- import Live.Web
-import PPrint  hiding (hardline)
-import MonadUtil
+import ConcreteSyntax (parseSourceBlocks)
+import PPrint
 import Util (readFileText)
 
-data DocFmt = ResultOnly
-            | TextDoc
-
 data EvalMode = ReplMode
-              | ScriptMode FilePath DocFmt
+              | ScriptMode FilePath
               | WebMode    FilePath
               | GenerateHTML FilePath FilePath
               | ClearCache
@@ -41,70 +31,20 @@ data CmdOpts = CmdOpts EvalMode EvalConfig
 
 runMode :: CmdOpts -> IO ()
 runMode (CmdOpts evalMode cfg) = case evalMode of
-  ScriptMode fname fmt -> do
+  ScriptMode fname -> do
     env <- initTopState -- loadCache
-    ((), finalEnv) <- runTopperM cfg stdOutLogger env do
+    void $ runTopperM cfg stdOutLogger env do
       blocks <- parseSourceBlocks <$> readFileText fname
       forM_ blocks \block -> do
-        case fmt of
-          ResultOnly -> return ()
-          TextDoc    -> liftIO $ putStr $ pprint block
+        liftIO $ putStr $ pprint block
         evalSourceBlockRepl block
-    return ()
-    -- storeCache finalEnv
-  -- ReplMode -> do
-  --   env <- loadCache
-  --   void $ runTopperM cfg stdOutLogger env do
-  --     void $ evalSourceBlockRepl preludeImportBlock
-  --     forever do
-  --        block <- readSourceBlock
-  --        void $ evalSourceBlockRepl block
-  -- WebMode    fname -> do
-  --   env <- loadCache
-  --   runWeb fname cfg env
-  -- GenerateHTML fname dest -> do
-  --   env <- loadCache
-  --   generateHTML fname dest cfg env
-  -- ClearCache -> clearCache
+  _ -> error "not implemented"
 
 stdOutLogger :: Outputs -> IO ()
 stdOutLogger (Outputs outs) = do
   isatty <- queryTerminal stdOutput
   forM_ outs \out -> putStr $ printOutput isatty out
 
--- readSourceBlock :: MonadIO (m n) => m n SourceBlock
--- readSourceBlock = do
---   sourceMap <- withEnv $ envSourceMap . moduleEnv
---   let filenameAndDexCompletions =
---         completeQuotedWord (Just '\\') "\"'" listFiles (dexCompletions sourceMap)
---   let hasklineSettings = setComplete filenameAndDexCompletions defaultSettings
---   liftIO $ runInputT hasklineSettings $ readMultiline prompt (parseTopDeclRepl . T.pack)
---   where prompt = ">=> "
-
-dexCompletions :: Monad m => SourceMap n -> CompletionFunc m
-dexCompletions sourceMap (line, _) = do
-  let varNames = map pprint $ M.keys $ fromSourceMap sourceMap
-  -- note: line and thus word and rest have character order reversed
-  let (word, rest) = break (== ' ') line
-  let startoflineKeywords = ["%bench \"", ":p", ":t", ":html", ":export"]
-  let candidates = (if null rest then startoflineKeywords else []) ++
-                   keyWordStrs ++ varNames
-  let completions = map simpleCompletion $ filter (reverse word `isPrefixOf`) candidates
-  return (rest, completions)
-
-readMultiline :: String -> (String -> Maybe a) -> InputT IO a
-readMultiline prompt parse = loop prompt ""
-  where
-    dots = replicate 3 '.' ++ " "
-    loop prompt' prevRead = do
-      source <- getInputLine prompt'
-      case source of
-        Nothing -> liftIO exitSuccess
-        Just s -> case parse s' of
-          Just ans -> return ans
-          Nothing -> loop dots s'
-          where s' = prevRead ++ s ++ "\n"
-
 simpleInfo :: Parser a -> ParserInfo a
 simpleInfo p = info (p <**> helper) mempty
 
@@ -121,11 +61,7 @@ parseMode = subparser $
   <> command "web"    (simpleInfo (WebMode    <$> sourceFileInfo))
   <> command "generate-html" (simpleInfo (GenerateHTML <$> sourceFileInfo <*> destFileInfo))
   <> command "clean"  (simpleInfo (pure ClearCache))
-  <> command "script" (simpleInfo (ScriptMode <$> sourceFileInfo <*> option
-        (optionList [ ("literate"   , TextDoc)
-                    , ("result-only", ResultOnly)])
-        (long "outfmt" <> value TextDoc <>
-         helpOption "Output format" "literate (default) | result-only | html | json")))
+  <> command "script" (simpleInfo (ScriptMode <$> sourceFileInfo))
   where
     sourceFileInfo = argument str (metavar "FILE"    <> help "Source program")
     destFileInfo   = argument str (metavar "OUTFILE" <> help "Output path")
@@ -148,12 +84,9 @@ parseEvalOpts = EvalConfig
   <*> optional (strOption $ long "prelude" <> metavar "FILE" <> help "Prelude file")
   <*> flag NoOptimize Optimize (short 'O' <> help "Optimize generated code")
   <*> enumOption "print" "Print backend" PrintCodegen printBackends
-  <*> enumOption "loglevel" "Log level" NormalLogLevel logLevels
   where
     printBackends = [ ("haskell", PrintHaskell)
                     , ("dex"    , PrintCodegen) ]
-    logLevels = [ ("normal", NormalLogLevel)
-                , ("debug" , DebugLogLevel ) ]
 
 printOutput :: Bool -> Output -> String
 printOutput isatty out = case out of

src/lib/AbstractSyntax.hs

@@ -101,9 +101,8 @@ checkSourceBlockParses = \case
 type SyntaxM = Except
 
 topDecl :: CTopDeclW -> SyntaxM UTopDecl
-topDecl (WithSrcs sid sids topDecl') = undefined
--- topDecl (WithSrcs sid sids topDecl') = case topDecl' of
---   CSDecl ann d -> UTopLet <$> decl ann (WithSrcs sid sids d)
+topDecl (WithSrcs sid sids topDecl') = case topDecl' of
+  CSDecl ann d -> topCSDecl ann (WithSrcs sid sids d)
 --   CData name tyConParams givens constructors -> do
 --     tyConParams' <- fromMaybeM tyConParams Empty aExplicitParams
 --     givens' <- aOptGivens givens
@@ -132,6 +131,29 @@ topDecl (WithSrcs sid sids topDecl') = undefined
 --     return $ UInterface params' methodTys (fromSourceNameW name) (toNest methodNames)
 --   CInstanceDecl def -> aInstanceDef def
 
+topCSDecl :: LetAnn -> CSDeclW -> SyntaxM UTopDecl
+topCSDecl ann (WithSrcs sid _ d) = case d of
+  CLet binder rhs -> do
+    (b, ann) <- topBinderOptAnn binder
+    UTopLet b ann <$> (asExpr <$> block rhs)
+  CDefDecl def -> do
+    (name, lam) <- aDef def
+    return $ UTopLet (fromSourceNameW name) Nothing (WithSrcE sid (ULam lam))
+  CExpr g -> UTopExpr <$> expr g
+  CPass -> error "not implemented"
+
+-- Binder pattern with an optional type annotation
+topBinderOptAnn :: GroupW -> SyntaxM (TopBinder, Maybe (UType VoidS))
+topBinderOptAnn = \case
+  WithSrcs _ _ (CBin Colon lhs typeAnn) -> (,) <$> topBinder lhs <*> (Just <$> expr typeAnn)
+  WithSrcs _ _ (CParens [g]) -> topBinderOptAnn g
+  g -> (,Nothing) <$> topBinder g
+
+topBinder :: GroupW -> SyntaxM TopBinder
+topBinder (WithSrcs sid _ b) = case b of
+  CLeaf (CIdentifier name) -> return $ fromSourceNameW $ WithSrc sid name
+  _ -> throw sid UnexpectedBinder
+
 decl :: LetAnn -> CSDeclW -> SyntaxM (UDecl VoidS VoidS)
 decl ann (WithSrcs sid _ d) = WithSrcB sid <$> case d of
   CLet binder rhs -> do

src/lib/ConcreteSyntax.hs

@@ -5,7 +5,7 @@
 -- https://developers.google.com/open-source/licenses/bsd
 
 module ConcreteSyntax (
-  mustParseit, sourceBlocks, sourceBlock,
+  parseSourceBlocks, mustParseit, sourceBlocks, sourceBlock,
   keyWordStrs, showPrimName,
   parseUModule, parseUModuleDeps,
   finishUModuleParse, preludeImportBlock, mustParseSourceBlock,
@@ -31,6 +31,9 @@ import Types.Source
 import Types.Primitives
 import Util
 
+parseSourceBlocks :: T.Text -> [SourceBlock]
+parseSourceBlocks source = uModuleSourceBlocks $ parseUModule Main source
+
 -- TODO: implement this more efficiently rather than just parsing the whole
 -- thing and then extracting the deps.
 parseUModuleDeps :: ModuleSourceName -> File -> [ModuleSourceName]
@@ -56,7 +59,8 @@ parseUModule name s = do
 {-# SCC parseUModule #-}
 
 preludeImportBlock :: SourceBlock
-preludeImportBlock = SourceBlock 0 0 "" mempty (Misc $ ImportModule Prelude)
+preludeImportBlock = SourceBlock 0 0 "" mempty (Misc EmptyLines)
+-- preludeImportBlock = SourceBlock 0 0 "" mempty (Misc $ ImportModule Prelude)
 
 sourceBlocks :: Parser [SourceBlock]
 sourceBlocks = manyTill (sourceBlock <* outputLines) eof

src/lib/Err.hs

@@ -573,7 +573,7 @@ instance Catchable m => Catchable (StateT s m) where
     f s `catchErr` \e -> runStateT (handler e) s
 
 instance Pretty Err where
-  pretty e = pretty $ printErr e
+  pr e = pr $ printErr e
 
 instance ToJSON SrcId