Merge pull request #206 from kmyk/playground-bundle

docs: Add "Bundle Runtime" checkbox to Jikka Playground

.github/workflows/docs.yml

@@ -23,7 +23,7 @@ jobs:
         run: stack --system-ghc build --only-dependencies
 
       - name: Build and collect logs of splices
-        run: stack --system-ghc build --ghc-options=-ddump-splices --ghc-options=-ddump-to-file
+        run: stack --system-ghc build --flag=Jikka:embed-runtime --ghc-options=-ddump-splices --ghc-options=-ddump-to-file
 
       - name: Run Haddock
         run: stack --system-ghc haddock --haddock-arguments --odir=docs/gh-pages/haddock
@@ -46,8 +46,8 @@ jobs:
       - name: Compile to WebAssembly
         run: |
           echo ahc-cabal new-update >> build.sh
-          echo ahc-cabal new-build --flag compile-web-assembly >> build.sh
-          echo ahc-cabal new-install --flag compile-web-assembly --installdir . >> build.sh
+          echo ahc-cabal new-build --flag=compile-web-assembly --flag=embed-runtime >> build.sh
+          echo ahc-cabal new-install --flag=compile-web-assembly --flag=embed-runtime --installdir . >> build.sh
           echo ahc-dist --input-exe jikka-asterius --export-function=convert --no-main --input-mjs docs/gh-pages/playground/input.mjs --browser --output-directory docs/gh-pages/playground >> build.sh
           docker run --rm -v $(pwd):/workspace -w /workspace terrorjack/asterius bash build.sh
 

app/asterius.hs

@@ -1,7 +1,9 @@
 module Main where
 
 import Asterius.Types
+import Control.Monad.Except
 import qualified Data.Text as T
+import qualified Jikka.CPlusPlus.Convert.BundleRuntime as BundleRuntime
 import Jikka.Common.Format.Error
 import qualified Jikka.Main.Subcommand.Convert as Convert
 import Jikka.Main.Target
@@ -16,5 +18,15 @@ convert = toJSString . convert' . fromJSString
 
 foreign export javascript "convert" convert :: JSString -> JSString
 
+bundleRuntime' :: String -> String
+bundleRuntime' prog = case BundleRuntime.run (T.pack prog) of
+  Left err -> unlines $ prettyError' err
+  Right prog -> T.unpack prog
+
+bundleRuntime :: JSString -> JSString
+bundleRuntime = toJSString . bundleRuntime' . fromJSString
+
+foreign export javascript "bundleRuntime" bundleRuntime :: JSString -> JSString
+
 main :: IO ()
 main = return ()

docs/gh-pages/playground/index.html

@@ -62,20 +62,35 @@
       <h2 class="mt-3 mb-3">Jikka Playground</h2>
 
       <div class="row">
-        <div class="dropdown">
-          <button
-            class="btn btn-secondary dropdown-toggle"
-            type="button"
-            data-bs-toggle="dropdown"
-            aria-expanded="false"
-          >
-            Choose Example
-          </button>
-          <ul
-            class="dropdown-menu"
-            id="dropdown"
-            aria-labelledby="dropdownMenuButton"
-          ></ul>
+        <div class="col">
+          <div class="dropdown">
+            <button
+              class="btn btn-secondary dropdown-toggle"
+              type="button"
+              data-bs-toggle="dropdown"
+              aria-expanded="false"
+            >
+              Choose Example
+            </button>
+            <ul
+              class="dropdown-menu"
+              id="dropdown"
+              aria-labelledby="dropdownMenuButton"
+            ></ul>
+          </div>
+        </div>
+        <div class="col">
+          <div class="form-check">
+            <input
+              class="form-check-input"
+              type="checkbox"
+              value=""
+              id="bundle"
+            />
+            <label class="form-check-label" for="bundle">
+              Bundle Runtime
+            </label>
+          </div>
         </div>
       </div>
 

docs/gh-pages/playground/input.mjs

@@ -8,6 +8,12 @@ async function convert(prog) {
   return await i.exports.convert(prog);
 }
 
+async function bundleRuntime(prog) {
+  const m = await wasm;
+  const i = await rts.newAsteriusInstance(Object.assign(req, { module: m }));
+  return await i.exports.bundleRuntime(prog);
+}
+
 function loadData() {
   const req = new XMLHttpRequest();
   req.open("GET", "../gallery/data.json", false);
@@ -30,25 +36,28 @@ window.addEventListener("DOMContentLoaded", function () {
       language: "cpp",
     });
 
+    const bundle = document.getElementById("bundle");
+
     // transpiling periodically
-    let lastValue = "";
-    console.log(lastValue);
-    const sync = function () {
+    let lastProgram = "";
+    let lastBundle = "";
+    const sync = async function () {
       try {
-        if (input.getValue() == lastValue) {
-          setTimeout(sync, 1000);
-        } else {
-          lastValue = input.getValue();
+        if (input.getValue() != lastProgram || bundle.checked != lastBundle) {
+          lastProgram = input.getValue();
+          lastBundle = bundle.checked;
           output.setValue("transpiling...");
-          convert(lastValue).then(function (value) {
-            output.setValue(value);
-            setTimeout(sync, 1000);
-          });
+          let transpiledProgram = await convert(lastProgram);
+          if (lastBundle) {
+            transpiledProgram = await bundleRuntime(transpiledProgram);
+          }
+          output.setValue(transpiledProgram);
         }
       } catch (e) {
         console.log(e);
-        setTimeout(sync, 1000);
+        output.setValue(e.toString());
       }
+      setTimeout(sync, 1000);
     };
     sync();
 

package.yaml

@@ -85,6 +85,7 @@ executables:
 #ASTERIUS      - -with-rtsopts=-N
 #ASTERIUS      - -optP-Wno-nonportable-include-path
 #ASTERIUS      - -optl--export-function=convert
+#ASTERIUS      - -optl--export-function=bundleRuntime
 #ASTERIUS    dependencies:
 #ASTERIUS      - Jikka
 

scripts/erase_template_haskell.py

@@ -68,10 +68,32 @@ def apply_splices(*, code: str, splices: List[Splice]) -> str:
 
     buf = list(code)
     for splice in reversed(splices):
-        magic = 3
         l = offset[splice.line] + splice.column
         r = l + splice.width
-        buf[l - magic:r] = splice.after.strip()
+
+        # open
+        delta = 0
+        while l >= 0 and buf[l] != '[' and buf[l:l + 2] != ['$', '(']:
+            l -= 1
+            delta += 1
+        if delta >= 5 or l == 0:
+            raise RuntimeError('splicing failed: failed to find opening paren')
+        if buf[l] == '[':
+            paren = ']'
+        elif buf[l:l + 2] == ['$', '(']:
+            paren = ')'
+        else:
+            assert False
+
+        # close
+        delta = 0
+        while r <= len(buf) and buf[r - 1] != paren:
+            r += 1
+            delta += 1
+        if delta >= 5 or r == len(buf):
+            raise RuntimeError('splicing failed: failed to find closing paren')
+
+        buf[l:r] = splice.after.strip()
 
     return ''.join(buf)
 
@@ -82,11 +104,14 @@ def main() -> None:
     parser.add_argument('--dist-directory', type=pathlib.Path, default=pathlib.Path('.stack-work', 'dist'))
     parser.add_argument('--source-directory', type=pathlib.Path, default=pathlib.Path('src'))
     parser.add_argument('--rewrite', action='store_true')
+    parser.add_argument('--match')
     args = parser.parse_args()
 
     basicConfig(level=DEBUG)
 
     for dump_splices_path in args.dist_directory.glob('**/*.dump-splices'):
+        if args.match and not re.search(args.match, str(dump_splices_path)):
+            continue
         with open(dump_splices_path) as fh:
             content = fh.read()
         splices = parse_splices(content=content)

src/Jikka/CPlusPlus/Convert/BundleRuntime.hs

@@ -37,18 +37,16 @@ import System.IO.Error
 #ifdef JIKKA_EMBED_RUNTIME
 embeddedRuntimeFiles :: [(FilePath, T.Text)]
 embeddedRuntimeFiles = $(embedDir "runtime/include")
-#endif
-
-{-# ANN readRuntimeFile ("HLint: ignore Redundant return" :: String) #-}
-readRuntimeFile :: (MonadIO m, MonadError Error m) => FilePath -> m T.Text
-readRuntimeFile path = do
-  return () -- Without this, Ormolu fails with "The GHC parser (in Haddock mode) failed: parse error on input `='"
 
-#ifdef JIKKA_EMBED_RUNTIME
+readRuntimeFile :: MonadError Error m => FilePath -> m T.Text
+readRuntimeFile path =
   case lookup ("runtime/include/" ++ path) embeddedRuntimeFiles of
     Just file -> return file
     Nothing -> throwInternalError $ "failed to open file. It may need recompile the binary?: " ++ path
+
 #else
+readRuntimeFile :: (MonadIO m, MonadError Error m) => FilePath -> m T.Text
+readRuntimeFile path = do
   resolvedPath <- liftIO $ getDataFileName ("runtime/include/" ++ path)
   file <- liftIO $ tryIOError (T.readFile resolvedPath)
   case file of
@@ -72,11 +70,11 @@ initialPreprocessorState =
 throwInternalErrorAt'' :: MonadError Error m => FilePath -> Integer -> String -> m a
 throwInternalErrorAt'' path lineno msg = wrapError' (path ++ " (line " ++ show lineno ++ ")") $ throwInternalError msg
 
-runLine :: (MonadIO m, MonadError Error m, MonadState PreprocessorState m) => FilePath -> Integer -> T.Text -> m [T.Text]
-runLine path lineno line
+runLine :: (MonadError Error m, MonadState PreprocessorState m) => (FilePath -> m T.Text) -> FilePath -> Integer -> T.Text -> m [T.Text]
+runLine readRuntimeFile path lineno line
   | "#include \"" `T.isPrefixOf` line = case T.splitOn "\"" line of
     ["#include ", path', ""] -> do
-      lines <- runFile (T.unpack path')
+      lines <- runFile readRuntimeFile (T.unpack path')
       return (lines ++ [T.pack ("#line " ++ show (lineno + 1) ++ " \"" ++ path ++ "\"")])
     _ -> throwInternalErrorAt'' path lineno "invalid #include \"...\""
   | otherwise = do
@@ -86,11 +84,11 @@ runLine path lineno line
       False : _ -> return []
       [] -> throwInternalError "there are more #endif than #ifdef and #ifndef"
 
-runLines :: (MonadIO m, MonadError Error m, MonadState PreprocessorState m) => FilePath -> Integer -> [T.Text] -> m [T.Text]
-runLines path lineno lines = concat <$> zipWithM (runLine path) [lineno ..] lines
+runLines :: (MonadError Error m, MonadState PreprocessorState m) => (FilePath -> m T.Text) -> FilePath -> Integer -> [T.Text] -> m [T.Text]
+runLines readRuntimeFile path lineno lines = concat <$> zipWithM (runLine readRuntimeFile path) [lineno ..] lines
 
-runFile :: (MonadIO m, MonadError Error m, MonadState PreprocessorState m) => FilePath -> m [T.Text]
-runFile path = do
+runFile :: (MonadError Error m, MonadState PreprocessorState m) => (FilePath -> m T.Text) -> FilePath -> m [T.Text]
+runFile readRuntimeFile path = do
   file <- readRuntimeFile path
   let lines = T.lines file
   let macro = map (\c -> if isAlphaNum c then toUpper c else '_') path
@@ -107,7 +105,7 @@ runFile path = do
     then return []
     else do
       modify' (\s -> s {definedMacros = S.insert macro macros})
-      (T.pack ("#line 3 \"" ++ path ++ "\"") :) <$> runLines path 3 (drop 2 (init lines))
+      (T.pack ("#line 3 \"" ++ path ++ "\"") :) <$> runLines readRuntimeFile path 3 (drop 2 (init lines))
 
 removeConsecutiveLineDirectives :: [T.Text] -> [T.Text]
 removeConsecutiveLineDirectives = \case
@@ -116,7 +114,11 @@ removeConsecutiveLineDirectives = \case
   [] -> []
 
 -- | `run` bundles runtime headers to C++ code like <https://github.com/online-judge-tools/verification-helper `oj-bundle` command>.
+#ifdef JIKKA_EMBED_RUNTIME
+run :: MonadError Error m => T.Text -> m T.Text
+#else
 run :: (MonadIO m, MonadError Error m) => T.Text -> m T.Text
+#endif
 run prog = wrapError' "Jikka.CPlusPlus.Convert.BundleRuntime" $ do
-  lines <- evalStateT (runLines "main.cpp" 1 (T.lines prog)) initialPreprocessorState
+  lines <- evalStateT (runLines readRuntimeFile "main.cpp" 1 (T.lines prog)) initialPreprocessorState
   return $ T.unlines (removeConsecutiveLineDirectives lines)

src/Jikka/Common/FileEmbed.hs

@@ -3,6 +3,7 @@
 module Jikka.Common.FileEmbed where
 
 import Control.Monad
+import Data.Char
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Language.Haskell.TH
@@ -30,4 +31,5 @@ embedDir path = do
   paths <- runIO $ listDirectoryRecursive path
   contents <- runIO $ mapM T.readFile paths :: Q [T.Text]
   mapM_ addDependentFile paths
-  [e|zip paths contents :: [(FilePath, T.Text)]|]
+  let contents' = map (map ord . T.unpack) contents -- use [Int] instead of T.Text for scripts/erase_template_haskell.py
+  [e|zip paths (map (T.pack . map chr) contents') :: [(FilePath, T.Text)]|]