feat(es): Add source map support for --cg javascript backend

idris2api.ipkg

@@ -31,6 +31,7 @@ modules =
     Compiler.ES.Doc,
     Compiler.ES.Javascript,
     Compiler.ES.Node,
+    Compiler.ES.SourceMap,
     Compiler.ES.State,
     Compiler.ES.TailRec,
     Compiler.ES.ToAst,

src/Compiler/ES/Codegen.idr

@@ -4,10 +4,12 @@ import Compiler.Common
 import Core.CompileExpr
 import Core.Directory
 import Core.Env
+import Core.FC
 import Data.String
 import Data.SortedMap
 import Compiler.ES.Ast
 import Compiler.ES.Doc
+import Compiler.ES.SourceMap
 import Compiler.ES.ToAst
 import Compiler.ES.TailRec
 import Compiler.ES.State
@@ -720,14 +722,14 @@ printDoc Pretty y = pretty (y <+> LineBreak)
 printDoc Compact y = compact y
 printDoc Minimal y = compact y
 
--- generate code for the given toplevel function.
-def :  {auto c : Ref Ctxt Defs}
-    -> {auto s : Ref Syn SyntaxInfo}
-    -> {auto e : Ref ESs ESSt}
-    -> {auto nm : Ref NoMangleMap NoMangleMap}
-    -> Function
-    -> Core String
-def (MkFunction n as body) = do
+-- generate code Doc for the given toplevel function.
+defDoc :  {auto c : Ref Ctxt Defs}
+       -> {auto s : Ref Syn SyntaxInfo}
+       -> {auto e : Ref ESs ESSt}
+       -> {auto nm : Ref NoMangleMap NoMangleMap}
+       -> Function
+       -> Core Doc
+defDoc (MkFunction fc n as body) = do
   reset
   defs <- get Ctxt
   mty <- do log "compiler.javascript.doc" 50 $ "Looking up \{show n}"
@@ -739,21 +741,34 @@ def (MkFunction n as body) = do
             pure (Just (shown ty))
   ref  <- getOrRegisterRef n
   args <- traverse registerLocal as
-  mde  <- mode <$> get ESs
   b    <- stmt Returns body >>= stmt
   let cmt = comment $ hsep (shown n :: toList ((":" <++>) <$> mty))
+  -- Wrap function definition with Loc for source map support
+  let wrapLoc = Loc fc
   if null args && n /= mainExpr
     -- zero argument toplevel functions are converted to
     -- lazily evaluated constants (except the main expression).
-    then pure $ printDoc mde $ vcat
+    then pure $ wrapLoc $ vcat
           [ cmt
           , constant (var !(get NoMangleMap) ref)
                ("__lazy(" <+> function neutral [] b <+> ")") ]
-    else pure $ printDoc mde $ vcat
+    else pure $ wrapLoc $ vcat
           [ cmt
           , function (var !(get NoMangleMap) ref)
                (map (var !(get NoMangleMap)) args) b ]
 
+-- generate code for the given toplevel function (as String).
+def :  {auto c : Ref Ctxt Defs}
+    -> {auto s : Ref Syn SyntaxInfo}
+    -> {auto e : Ref ESs ESSt}
+    -> {auto nm : Ref NoMangleMap NoMangleMap}
+    -> Function
+    -> Core String
+def f = do
+  d   <- defDoc f
+  mde <- mode <$> get ESs
+  pure $ printDoc mde d
+
 -- generate code for the given foreign function definition
 foreign :  {auto c : Ref ESs ESSt}
         -> {auto d : Ref Ctxt Defs}
@@ -837,3 +852,83 @@ compileToES c s cg tm ccTypes = do
   let pre = showSep "\n" $ static_preamble :: (values $ preamble st)
 
   pure $ fastUnlines [pre,allDecls,main]
+
+||| Compiles the given `ClosedTerm` for the list of supported
+||| backends to JS code, with source map generation.
+||| Returns (JS code, Source Map JSON).
+export
+compileToESWithSourceMap : Ref Ctxt Defs -> Ref Syn SyntaxInfo ->
+              (cg : CG) -> ClosedTerm -> List String -> (outputFile : String)
+              -> Core (String, String)
+compileToESWithSourceMap c s cg tm ccTypes outFile = do
+  _ <- initNoMangle ccTypes validJSName
+
+  cdata <- getCompileDataWith ccTypes False Cases tm
+
+  -- always use Pretty mode for source maps (minification loses mappings)
+  directives <- getDirectives cg
+  let mode = Pretty
+
+  -- initialize the state used in the code generator
+  s <- newRef ESs $ init mode (isArg mode) isFun ccTypes !(get NoMangleMap)
+
+  -- register the toplevel `__tailRec` function to make sure
+  -- it is not mangled in `Minimal` mode
+  addRef tailRec (VName tailRec)
+
+  -- the list of all toplevel definitions (including the main
+  -- function)
+  let allDefs =  (mainExpr, EmptyFC, MkNmFun [] $ forget cdata.mainExpr)
+              :: cdata.namedDefs
+
+      -- tail-call optimized set of toplevel functions
+      defs    = TailRec.functions tailRec allDefs
+
+  -- collect Docs for all toplevel function definitions
+  defDocs <- traverse defDoc defs
+
+  -- pretty printed toplevel FFI definitions (no source locations)
+  foreigns <- concat <$> traverse foreign allDefs
+
+  -- lookup the (possibly mangled) name of the main function
+  mainName <- compact . var !(get NoMangleMap) <$> getOrRegisterRef mainExpr
+
+  -- main function call
+  let main =  "try{"
+           ++ mainName
+           ++ "()}catch(e){if(e instanceof IdrisError){console.log('ERROR: ' + e.message)}else{throw e} }"
+
+  st <- get ESs
+
+  -- main preamble containing primops implementations
+  static_preamble <- readDataFile ("js/support.js")
+
+  -- complete preamble, including content from additional
+  -- support files (if any)
+  let pre = showSep "\n" $ static_preamble :: (values $ preamble st)
+
+  -- combine all Docs for function definitions
+  let allDefDocs = vcat defDocs
+
+  -- render with source mappings
+  let (renderedDefs, mappings) = prettyWithMappings (allDefDocs <+> LineBreak)
+
+  -- Calculate line offset: count lines in preamble and foreigns
+  let preLines = cast {to=Int} $ length $ lines pre
+  let foreignLines = cast {to=Int} $ length foreigns
+  let lineOffset = preLines + foreignLines
+
+  -- Adjust mapping line numbers by offset
+  let adjustedMappings = map (\m => { genLine := m.genLine + lineOffset } m) mappings
+
+  -- combine foreigns (no mappings) with rendered defs
+  let allDecls = fastUnlines foreigns ++ renderedDefs
+
+  -- generate source map JSON with adjusted mappings
+  let sourceMap = generateSourceMap outFile adjustedMappings
+
+  -- add source map reference comment
+  let jsCode = fastUnlines [pre, allDecls, main]
+            ++ "\n//# sourceMappingURL=" ++ outFile ++ ".map\n"
+
+  pure (jsCode, sourceMap)

src/Compiler/ES/Doc.idr

@@ -1,6 +1,7 @@
 module Compiler.ES.Doc
 
 import Data.List
+import Core.FC
 
 public export
 data Doc
@@ -11,6 +12,7 @@ data Doc
   | Text String
   | Nest Nat Doc
   | Seq Doc Doc
+  | Loc FC Doc -- source location annotation for source maps
 
 export
 Semigroup Doc where
@@ -43,6 +45,7 @@ isMultiline (Text x)   = False
 isMultiline (Comment x) = isMultiline x
 isMultiline (Nest k x) = isMultiline x
 isMultiline (Seq x y)  = isMultiline x || isMultiline y
+isMultiline (Loc _ x)  = isMultiline x
 
 export
 (<++>) : Doc -> Doc -> Doc
@@ -95,6 +98,7 @@ compact = fastConcat . go
         go (Text x)   = [x]
         go (Nest _ y) = go y
         go (Seq x y)  = go x ++ go y
+        go (Loc _ y)  = go y
 
 export
 pretty : Doc -> String
@@ -110,3 +114,85 @@ pretty = fastConcat . go ""
         go _ (Text x)   = [x]
         go s (Nest x y) = go (s ++ nSpaces x) y
         go s (Seq x y)  = go s x ++ go s y
+        go s (Loc _ y)  = go s y
+
+--------------------------------------------------------------------------------
+--          Source Map Support
+--------------------------------------------------------------------------------
+
+||| A source mapping entry
+||| (sourceFile, sourceLine, sourceCol, generatedLine, generatedCol)
+public export
+record SourceMapping where
+  constructor MkSourceMapping
+  srcOrigin : OriginDesc
+  srcLine   : Int
+  srcCol    : Int
+  genLine   : Int
+  genCol    : Int
+
+export
+Show SourceMapping where
+  show m = "SourceMapping(\{show m.srcOrigin}:\{show m.srcLine}:\{show m.srcCol} -> gen:\{show m.genLine}:\{show m.genCol})"
+
+||| Render state for tracking generated positions
+record RenderState where
+  constructor MkRenderState
+  line     : Int      -- current generated line (0-indexed)
+  col      : Int      -- current generated column (0-indexed)
+  mappings : List SourceMapping
+
+initRenderState : RenderState
+initRenderState = MkRenderState 0 0 []
+
+||| Pretty print with source mappings
+||| Returns the generated code and list of source mappings
+export
+prettyWithMappings : Doc -> (String, List SourceMapping)
+prettyWithMappings doc =
+  let (strs, finalState) = go "" initRenderState doc
+  in (fastConcat strs, reverse finalState.mappings)
+  where
+    nSpaces : Nat -> String
+    nSpaces n = fastPack $ replicate n ' '
+
+    -- Calculate new position after emitting a string
+    updatePos : RenderState -> String -> RenderState
+    updatePos st s =
+      let chars = unpack s
+          newlines = length $ filter (== '\n') chars
+      in if newlines > 0
+         then let lastLineLen = length $ takeWhile (/= '\n') $ reverse chars
+              in { line := st.line + cast newlines, col := cast lastLineLen } st
+         else { col := st.col + cast (length chars) } st
+
+    -- Add a mapping if FC is non-empty
+    addMapping : RenderState -> FC -> RenderState
+    addMapping st fc = case isNonEmptyFC fc of
+      Nothing => st
+      Just (origin, (srcL, srcC), _) =>
+        { mappings := MkSourceMapping origin srcL srcC st.line st.col :: st.mappings } st
+
+    go : (spaces : String) -> RenderState -> Doc -> (List String, RenderState)
+    go _ st Nil        = ([], st)
+    go s st LineBreak  =
+      let st' = { line := st.line + 1, col := cast (length s) } st
+      in (["\n" ++ s], st')
+    go _ st SoftSpace  = ([" "], { col := st.col + 1 } st)
+    go s st (Comment x) =
+      let result = go s st x
+          xs = fst result
+          st1 = snd result
+          st2 = updatePos st1 (fastConcat xs)
+      in ("/* " :: xs ++ [" */"], updatePos st2 "/*  */")
+    go _ st (Text x)   = ([x], updatePos st x)
+    go s st (Nest x y) = go (s ++ nSpaces x) st y
+    go s st (Seq x y)  =
+      let result1 = go s st x
+          xs = fst result1
+          st1 = snd result1
+          result2 = go s st1 y
+          ys = fst result2
+          st2 = snd result2
+      in (xs ++ ys, st2)
+    go s st (Loc fc y) = go s (addMapping st fc) y

src/Compiler/ES/Javascript.idr

@@ -7,6 +7,7 @@ import Compiler.Common
 
 import Libraries.Utils.Path
 
+import Idris.Env
 import Idris.Syntax
 
 import Data.String
@@ -20,6 +21,16 @@ compileToJS :
   ClosedTerm -> Core String
 compileToJS c s tm = compileToES c s Javascript tm ["browser", "javascript"]
 
+||| Compile a TT expression to Javascript with source map
+compileToJSWithSourceMap :
+  Ref Ctxt Defs ->
+  Ref Syn SyntaxInfo ->
+  ClosedTerm ->
+  (outfile : String) ->
+  Core (String, String)
+compileToJSWithSourceMap c s tm outfile =
+  compileToESWithSourceMap c s Javascript tm ["browser", "javascript"] outfile
+
 htmlHeader : String
 htmlHeader = """
   <html>
@@ -55,11 +66,21 @@ compileExpr :
   (outfile : String) ->
   Core (Maybe String)
 compileExpr c s tmpDir outputDir tm outfile =
-  do es <- compileToJS c s tm
-     let res = addHeaderAndFooter outfile es
+  do -- Check for sourcemap directive
+     directives <- getDirectives Javascript
      let out = outputDir </> outfile
-     Core.writeFile out res
-     pure (Just out)
+     if "sourcemap" `elem` directives
+       then do
+         (es, sourceMap) <- compileToJSWithSourceMap c s tm outfile
+         let res = addHeaderAndFooter outfile es
+         Core.writeFile out res
+         Core.writeFile (out ++ ".map") sourceMap
+         pure (Just out)
+       else do
+         es <- compileToJS c s tm
+         let res = addHeaderAndFooter outfile es
+         Core.writeFile out res
+         pure (Just out)
 
 ||| Node implementation of the `executeExpr` interface.
 executeExpr :

src/Compiler/ES/Node.idr

@@ -37,6 +37,20 @@ compileToNode c s tm = do
     shebang : String
     shebang = "#!\{envNode}\n"
 
+||| Compile a TT expression to Node with source map
+compileToNodeWithSourceMap :
+  Ref Ctxt Defs ->
+  Ref Syn SyntaxInfo ->
+  ClosedTerm ->
+  (outfile : String) ->
+  Core (String, String)
+compileToNodeWithSourceMap c s tm outfile = do
+  (js, sourceMap) <- compileToESWithSourceMap c s Node tm ["node", "javascript"] outfile
+  pure (shebang ++ js, sourceMap)
+  where
+    shebang : String
+    shebang = "#!\{envNode}\n"
+
 ||| Node implementation of the `compileExpr` interface.
 compileExpr :
   Ref Ctxt Defs ->
@@ -47,11 +61,21 @@ compileExpr :
   (outfile : String) ->
   Core (Maybe String)
 compileExpr c s tmpDir outputDir tm outfile =
-  do es <- compileToNode c s tm
+  do -- Check for sourcemap directive
+     directives <- getDirectives Node
      let out = outputDir </> outfile
-     Core.writeFile out es
-     coreLift_ $ chmodRaw out 0o755
-     pure (Just out)
+     if "sourcemap" `elem` directives
+       then do
+         (es, sourceMap) <- compileToNodeWithSourceMap c s tm outfile
+         Core.writeFile out es
+         Core.writeFile (out ++ ".map") sourceMap
+         coreLift_ $ chmodRaw out 0o755
+         pure (Just out)
+       else do
+         es <- compileToNode c s tm
+         Core.writeFile out es
+         coreLift_ $ chmodRaw out 0o755
+         pure (Just out)
 
 ||| Node implementation of the `executeExpr` interface.
 executeExpr :