Skip to content

Commit 7229e30

Browse files
plajjanplajjan
authored
Merge pull request #2518 from actonlang/codegen-lines
Emit #line directives
2 parents ed5c5de + 92a19c1 commit 7229e30

File tree

11 files changed

+2858
-18
lines changed

11 files changed

+2858
-18
lines changed

‎cli/src/acton.act‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -891,6 +891,7 @@ def build_cmd_args(args):
891891
"cgen",
892892
"cps",
893893
"cpu",
894+
"dbg-no-lines",
894895
"db",
895896
"deact",
896897
"dep",
@@ -1603,6 +1604,7 @@ actor main(env):
16031604
p.add_bool("ccmd", "Show CC / LD command lines")
16041605
p.add_bool("timing", "Show timing information")
16051606
p.add_bool("cpedantic", "Pedantic C compilation")
1607+
p.add_bool("dbg-no-lines", "Disable emission of C #line directives (for debugging)")
16061608
p.add_bool("quiet", "Be quiet")
16071609
p.add_bool("verbose", "Verbose output")
16081610
p.add_option("optimize", "str", "?", "Debug", "Optimization mode (Debug, ReleaseSafe, ReleaseSmall, ReleaseFast)")

‎compiler/actonc/Main.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -114,7 +114,7 @@ main = do
114114
_ -> printErrorAndExit ("Unknown filetype: " ++ head nms)
115115

116116
defaultOpts = C.CompileOptions False False False False False False False False False False False False
117-
False False False False C.Debug False False False False
117+
False False False False False C.Debug False False False False
118118
"" "" "" C.defTarget "" False []
119119

120120
-- Apply global options to compile options
@@ -1277,7 +1277,8 @@ runRestPasses gopts opts paths env0 parsed srcContent = do
12771277

12781278
-- Convert hash to hex string for comment
12791279
let hexHash = B.unpack $ Base16.encode srcHash
1280-
(n,h,c) <- Acton.CodeGen.generate liftEnv relSrcBase boxed hexHash
1280+
let emitLines = not (C.dbg_no_lines opts)
1281+
(n,h,c) <- Acton.CodeGen.generate liftEnv relSrcBase srcContent emitLines boxed hexHash
12811282
timeCodeGen <- getTime Monotonic
12821283
iff (C.timing gopts) $ putStrLn(" Pass: Generating code : " ++ fmtTime (timeCodeGen - timeBoxing))
12831284

‎compiler/lib/src/Acton/CPS.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -151,20 +151,20 @@ instance CPS [Stmt] where
151151
where t = typeOf env e
152152
nts = extraBinds env ss
153153

154-
cps env ss0@(Assign _ [p] e : ss)
154+
cps env ss0@(Assign l [p] e : ss)
155155
| contCall env e = do k <- newName "cont"
156156
x <- newName "res"
157-
ss' <- cps (define [(x,NVar t)] env) (sAssign p (eVar x) : ss)
157+
ss' <- cps (define [(x,NVar t)] env) (Assign l [p] (eVar x) : ss)
158158
--traceM ("## kDef Assign " ++ prstr k ++ ", updates: " ++ prstrs nts)
159159
return $ kDef env k nts x t ss' :
160160
sReturn (addContArg env (conv env e) (kRef k (dom nts) x t)) : []
161161
where t = typeOf env e
162162
nts = extraBinds env ss0
163163

164-
cps env (MutAssign _ tg e : ss)
164+
cps env (MutAssign l tg e : ss)
165165
| contCall env e = do k <- newName "cont"
166166
x <- newName "res"
167-
ss' <- cps env (sMutAssign tg (eVar x) : ss)
167+
ss' <- cps env (MutAssign l tg (eVar x) : ss)
168168
--traceM ("## kDef MutAssign " ++ prstr k ++ ", updates: " ++ prstrs nts)
169169
return $ kDef env k nts x t ss' :
170170
sReturn (addContArg env (conv env e) (kRef k (dom nts) x t)) : []

‎compiler/lib/src/Acton/CodeGen.hs‎

Lines changed: 50 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -32,14 +32,16 @@ import Control.Monad.State.Lazy
3232
import Prelude hiding ((<>))
3333
import System.FilePath.Posix
3434
import Numeric
35+
-- For fast SrcLoc offset->line lookup when emitting #line
36+
import qualified Data.IntMap.Strict as IM
3537

36-
generate :: Acton.Env.Env0 -> FilePath -> Module -> String -> IO (String,String,String)
37-
generate env srcbase m hash = do return (n, h, c)
38+
generate :: Acton.Env.Env0 -> FilePath -> String -> Bool -> Module -> String -> IO (String,String,String)
39+
generate env srcbase srcText emitLines m hash = do return (n, h, c)
3840

39-
where n = concat (Data.List.intersperse "." (modPath (modname m))) --render $ quotes $ gen env0 (modname m1)
41+
where n = concat (Data.List.intersperse "." (modPath (modname m))) --render $ quotes $ gen env0 (modname m)
4042
hashComment = text "/* Acton source hash:" <+> text hash <+> text "*/"
4143
h = render $ hashComment $+$ hModule env0 m
42-
c = render $ hashComment $+$ cModule env0 srcbase m
44+
c = render $ hashComment $+$ cModule env0 srcbase srcText emitLines m
4345
env0 = genEnv $ setMod (modname m) env
4446

4547
genRoot :: Acton.Env.Env0 -> QName -> IO String
@@ -55,6 +57,8 @@ genRoot env0 qn@(GName m n) = do return $ render (cInclude $+$ cIncludeM
5557
char '}'
5658

5759

60+
61+
5862
myPretty (GName m n)
5963
| m == mBuiltin = text ("B_" ++ nstr n)
6064
| otherwise = pretty m <> dot <> pretty n
@@ -82,11 +86,16 @@ staticWitnessName _ = (Nothing, [])
8286

8387
-- Environment --------------------------------------------------------------------------------------
8488

85-
genEnv env0 = setX env0 GenX{ globalX = [], localX = [], retX = tNone, volVarsX = []}
89+
genEnv env0 = setX env0 GenX{ globalX = [], localX = [], retX = tNone, volVarsX = [], lineEmitX = Nothing }
8690

8791
type GenEnv = EnvF GenX
8892

89-
data GenX = GenX { globalX :: [Name], localX :: [Name], retX :: Type , volVarsX :: [Name]}
93+
data GenX = GenX { globalX :: [Name]
94+
, localX :: [Name]
95+
, retX :: Type
96+
, volVarsX :: [Name]
97+
, lineEmitX :: Maybe (SrcLoc -> Doc)
98+
}
9099

91100
gdefine te env = modX env1 $ \x -> x{ globalX = dom te ++ globalX x }
92101
where env1 = define te env
@@ -108,6 +117,15 @@ setVolVars as env = modX env $ \x -> x{ volVarsX = as }
108117

109118
isVolVar a env = a `elem` volVarsX (envX env)
110119

120+
-- Line emission helpers
121+
setLineEmit :: (SrcLoc -> Doc) -> GenEnv -> GenEnv
122+
setLineEmit f env = modX env $ \x -> x{ lineEmitX = Just f }
123+
124+
getLineEmit :: GenEnv -> (SrcLoc -> Doc)
125+
getLineEmit env = case lineEmitX (envX env) of
126+
Just f -> f
127+
Nothing -> const empty
128+
111129
-- Helpers ------------------------------------------------------------------------------------------
112130

113131
include :: GenEnv -> String -> ModName -> Doc
@@ -292,12 +310,12 @@ primNEWTUPLE0 = gPrim "NEWTUPLE0"
292310

293311
-- Implementation -----------------------------------------------------------------------------------
294312

295-
cModule env srcbase (Module m imps stmts)
313+
cModule env srcbase srcText emitLines (Module m imps stmts)
296314
= (if inBuiltin env then text "#include \"builtin/builtin.c\"" else empty) $+$
297315
text "#include \"rts/common.h\"" $+$
298316
include env (if inBuiltin env then "" else "out/types") m $+$
299317
ext_include $+$
300-
declModule env1 stmts $+$
318+
declModule envWithLine stmts $+$
301319
text "int" <+> genTopName env initFlag <+> equals <+> text "0" <> semi $+$
302320
(text "void" <+> genTopName env initKW <+> parens empty <+> char '{') $+$
303321
nest 4 (text "if" <+> parens (genTopName env initFlag) <+> text "return" <> semi $+$
@@ -313,6 +331,23 @@ cModule env srcbase (Module m imps stmts)
313331
ext_init = if notImpl then genTopName env (name "__ext_init__") <+> parens empty <> semi else empty
314332
notImpl = hasNotImpl stmts
315333
env1 = classdefine stmts env
334+
-- Emit a C #line directive for a given Acton SrcLoc if available
335+
actFile = srcbase ++ ".act"
336+
-- Our AST source locations (SrcLoc) carry byte offsets (start,end), not (row,col).
337+
-- C's #line requires a 1-based line number, so we convert offsets -> line numbers.
338+
-- We precompute line start offsets and use an IntMap + lookupLE for O(log n) mapping.
339+
lineStarts :: [Int]
340+
lineStarts = 0 : [ i+1 | (i,c) <- zip ([0..] :: [Int]) srcText, c == '\n' ]
341+
lineMap :: IM.IntMap Int
342+
lineMap = IM.fromList (zip lineStarts ([1..] :: [Int]))
343+
offsetToLine :: Int -> Int
344+
offsetToLine off = case IM.lookupLE off lineMap of
345+
Just (_, ln) -> ln
346+
Nothing -> 1
347+
emitLine NoLoc = empty
348+
emitLine (Loc startOffset _) =
349+
text "#line" <+> pretty (offsetToLine startOffset) <+> doubleQuotes (text actFile)
350+
envWithLine = if emitLines then setLineEmit emitLine env1 else env1
316351

317352

318353
declModule env [] = empty
@@ -327,18 +362,20 @@ declModule env (s : ss) = vcat [ genTypeDecl env n t <+> genTopName
327362
env1 = gdefine te env
328363

329364

330-
declDecl env (Def _ n q p KwdNIL (Just t) b d fx ddoc)
365+
declDecl env (Def dloc n q p KwdNIL (Just t) b d fx ddoc)
331366
| hasNotImpl b = gen env t <+> genTopName env n <+> parens (gen env p) <> semi $+$
332367
text "/*" $+$
333368
decl $+$
334369
text "*/"
335370
| otherwise = decl
336371
where (ss',vs) = genSuite env1 b
337-
decl = (genTypeDecl env n t1 <+> genTopName env n <+> parens (gen (setVolVars vs env) p) <+> char '{') $+$
372+
decl = emit dloc $+$
373+
(genTypeDecl env n t1 <+> genTopName env n <+> parens (gen (setVolVars vs env) p) <+> char '{') $+$
338374
nest 4 ss' $+$
339375
char '}'
340376
env1 = setRet t1 $ ldefine (envOf p) $ defineTVars q env
341377
t1 = exposeMsg fx t
378+
emit = getLineEmit env
342379

343380
declDecl env (Class _ n q as b ddoc)
344381
| cDefinedClass = vcat [ declDecl env1 d{ dname = methodname n (dname d) } | Decl _ ds <- b', d@Def{} <- ds ] $+$
@@ -577,10 +614,12 @@ preEscape str = "A_" ++ str
577614

578615
word = text "$WORD"
579616

617+
genSuite :: GenEnv -> Suite -> (Doc,[Name])
580618
genSuite env [] = (empty,[])
581-
genSuite env (s:ss) = (c $+$ cs, vs' ++ (vs `intersect` defined env))
619+
genSuite env (s:ss) = ((emit (sloc s) $+$ c) $+$ cs, vs' ++ (vs `intersect` defined env))
582620
where (cs,vs) = genSuite (ldefine (envOf s) env) ss
583621
(c,vs') = genStmt (setVolVars vs env) s
622+
emit = getLineEmit env
584623

585624
isUnboxed (Internal BoxPass _ _) = True
586625
isUnboxed _ = False

‎compiler/lib/src/Acton/CommandLineParser.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -65,6 +65,7 @@ data CompileOptions = CompileOptions {
6565
ccmd :: Bool,
6666
ty :: Bool,
6767
cpedantic :: Bool,
68+
dbg_no_lines:: Bool,
6869
optimize :: OptimizeMode,
6970
listimports :: Bool,
7071
only_build :: Bool,
@@ -169,6 +170,7 @@ compileOptions = CompileOptions
169170
<*> switch (long "ccmd" <> help "Show CC / LD commands")
170171
<*> switch (long "ty" <> help "Write .ty file to src file directory")
171172
<*> switch (long "cpedantic" <> help "Pedantic C compilation with -Werror")
173+
<*> switch (long "dbg-no-lines" <> help "Disable emission of C #line directives (for debugging codegen)")
172174
<*> optimizeOption
173175
<*> switch (long "list-imports" <> help "List module imports")
174176
<*> switch (long "only-build" <> help "Only perform final build of .c files, do not compile .act files")

‎compiler/lib/test/9-codegen/deact.c‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ B_Times deactQ_W_223;
55
B_Plus deactQ_W_586;
66
B_Eq deactQ_W_761;
77
$R deactQ_L_1C_1cont ($Cont C_cont, B_NoneType C_2res) {
8+
#line 15 "test/src/deact.act"
89
((B_NoneType (*) (B_tuple, B_str, B_str, B_bool, B_bool))B_print)($NEWTUPLE(1, to$str("Apa")), B_None, B_None, B_None, B_None);
910
return $R_CONT(C_cont, B_None);
1011
}
@@ -75,7 +76,9 @@ deactQ_L_4action deactQ_L_4actionG_new(deactQ_Apa G_1) {
7576
}
7677
struct deactQ_L_4actionG_class deactQ_L_4actionG_methods;
7778
$R deactQ_L_5C_3cont ($action cb, $Cont C_cont, B_int C_4res) {
79+
#line 7 "test/src/deact.act"
7880
B_int v = C_4res;
81+
#line 8 "test/src/deact.act"
7982
B_Msg m = ((B_Msg)((B_Msg (*) ($action, B_int))cb->$class->__asyn__)(cb, to$int(2)));
8083
B_int N_tmp = ((B_int (*) (B_Times, B_int, B_int))deactQ_W_223->$class->__mul__)(deactQ_W_223, v, to$int(10));
8184
return $R_CONT(C_cont, N_tmp);
@@ -371,9 +374,13 @@ deactQ_L_19action deactQ_L_19actionG_new(deactQ_main G_1) {
371374
}
372375
struct deactQ_L_19actionG_class deactQ_L_19actionG_methods;
373376
$R deactQ_L_17C_9cont (deactQ_main self, $Cont C_cont, B_int C_10res) {
377+
#line 34 "test/src/deact.act"
374378
self->r = C_10res;
379+
#line 35 "test/src/deact.act"
375380
((B_NoneType (*) (B_tuple, B_str, B_str, B_bool, B_bool))B_print)($NEWTUPLE(2, to$str("r ="), self->r), B_None, B_None, B_None, B_None);
381+
#line 36 "test/src/deact.act"
376382
((B_Msg (*) (deactQ_Apa, $action))self->a->$class->compute)(self->a, (($action)deactQ_L_19actionG_new(self)));
383+
#line 37 "test/src/deact.act"
377384
((B_NoneType (*) (B_tuple, B_str, B_str, B_bool, B_bool))B_print)($NEWTUPLE(1, to$str("main")), B_None, B_None, B_None, B_None);
378385
return $R_CONT(C_cont, B_None);
379386
}
@@ -412,9 +419,13 @@ deactQ_L_20Cont deactQ_L_20ContG_new(deactQ_main G_1, $Cont G_2) {
412419
}
413420
struct deactQ_L_20ContG_class deactQ_L_20ContG_methods;
414421
$R deactQ_L_12C_7cont (deactQ_main self, $Cont C_cont, deactQ_Bepa C_8res) {
422+
#line 30 "test/src/deact.act"
415423
self->b = C_8res;
424+
#line 31 "test/src/deact.act"
416425
((B_NoneType (*) (B_tuple, B_str, B_str, B_bool, B_bool))B_print)($NEWTUPLE(1, to$str("-----")), B_None, B_None, B_None, B_None);
426+
#line 32 "test/src/deact.act"
417427
((B_Msg (*) (deactQ_Apa, $action))self->a->$class->setup)(self->a, (($action)deactQ_L_14actionG_new(self->a)));
428+
#line 33 "test/src/deact.act"
418429
self->x = ((B_Msg (*) (deactQ_Apa, $action))self->a->$class->compute)(self->a, (($action)deactQ_L_16actionG_new(self->b)));
419430
return $AWAIT((($Cont)deactQ_L_20ContG_new(self, C_cont)), self->x);
420431
}
@@ -453,6 +464,7 @@ deactQ_L_21Cont deactQ_L_21ContG_new(deactQ_main G_1, $Cont G_2) {
453464
}
454465
struct deactQ_L_21ContG_class deactQ_L_21ContG_methods;
455466
$R deactQ_L_11C_5cont (deactQ_main self, $Cont C_cont, deactQ_Apa C_6res) {
467+
#line 29 "test/src/deact.act"
456468
self->a = C_6res;
457469
return deactQ_BepaG_newact((($Cont)deactQ_L_21ContG_new(self, C_cont)));
458470
}
@@ -744,16 +756,23 @@ struct deactQ_L_32procG_class deactQ_L_32procG_methods;
744756
$R deactQ_ApaD___init__ (deactQ_Apa self, $Cont C_cont) {
745757
return (($R (*) (deactQ_Apa, $Cont, $action))self->$class->setupG_local)(self, (($Cont)deactQ_L_2ContG_new(C_cont)), (($action)deactQ_L_4actionG_new(self)));
746758
}
759+
#line 2 "test/src/deact.act"
747760
$R deactQ_ApaD_setupG_local (deactQ_Apa self, $Cont C_cont, $action cb) {
761+
#line 3 "test/src/deact.act"
748762
((B_NoneType (*) (B_tuple, B_str, B_str, B_bool, B_bool))B_print)($NEWTUPLE(1, to$str("setup")), B_None, B_None, B_None, B_None);
763+
#line 4 "test/src/deact.act"
749764
((B_Msg (*) ($action, B_int))cb->$class->__asyn__)(cb, to$int(0));
750765
return $R_CONT(C_cont, B_None);
751766
}
767+
#line 5 "test/src/deact.act"
752768
$R deactQ_ApaD_computeG_local (deactQ_Apa self, $Cont C_cont, $action cb) {
769+
#line 6 "test/src/deact.act"
753770
((B_NoneType (*) (B_tuple, B_str, B_str, B_bool, B_bool))B_print)($NEWTUPLE(1, to$str("compute")), B_None, B_None, B_None, B_None);
754771
return $AWAIT((($Cont)deactQ_L_6ContG_new(cb, C_cont)), ((B_Msg)((B_Msg (*) ($action, B_int))cb->$class->__asyn__)(cb, to$int(1))));
755772
}
773+
#line 10 "test/src/deact.act"
756774
$R deactQ_ApaD_noticeG_local (deactQ_Apa self, $Cont C_cont, B_int i) {
775+
#line 11 "test/src/deact.act"
757776
((B_NoneType (*) (B_tuple, B_str, B_str, B_bool, B_bool))B_print)($NEWTUPLE(1, to$str("notice")), B_None, B_None, B_None, B_None);
758777
B_int N_1tmp = ((B_int (*) (B_Plus, B_int, B_int))deactQ_W_586->$class->__add__)(deactQ_W_586, i, to$int(1));
759778
return $R_CONT(C_cont, N_1tmp);
@@ -793,10 +812,13 @@ void deactQ_ApaD__GC_finalizer (void *obj, void *cdata) {
793812
}
794813
struct deactQ_ApaG_class deactQ_ApaG_methods;
795814
$R deactQ_BepaD___init__ (deactQ_Bepa self, $Cont C_cont) {
815+
#line 21 "test/src/deact.act"
796816
((B_NoneType (*) (B_tuple, B_str, B_str, B_bool, B_bool))B_print)($NEWTUPLE(1, to$str("Bepa")), B_None, B_None, B_None, B_None);
797817
return $R_CONT(C_cont, B_None);
798818
}
819+
#line 18 "test/src/deact.act"
799820
$R deactQ_BepaD_callbackG_local (deactQ_Bepa self, $Cont C_cont, B_int i) {
821+
#line 19 "test/src/deact.act"
800822
((B_NoneType (*) (B_tuple, B_str, B_str, B_bool, B_bool))B_print)($NEWTUPLE(2, to$str("callback"), i), B_None, B_None, B_None, B_None);
801823
B_int N_2tmp = ((B_int (*) (B_Plus, B_int, B_int))deactQ_W_586->$class->__add__)(deactQ_W_586, i, to$int(1));
802824
return $R_CONT(C_cont, N_2tmp);
@@ -833,9 +855,13 @@ struct deactQ_BepaG_class deactQ_BepaG_methods;
833855
self->env = env;
834856
return deactQ_ApaG_newact((($Cont)deactQ_L_22ContG_new(self, C_cont)));
835857
}
858+
#line 24 "test/src/deact.act"
836859
$R deactQ_mainD_myprocG_local (deactQ_main self, $Cont C_cont, B_int i) {
860+
#line 25 "test/src/deact.act"
837861
((B_NoneType (*) (B_tuple, B_str, B_str, B_bool, B_bool))B_print)($NEWTUPLE(2, to$str("myproc"), i), B_None, B_None, B_None, B_None);
862+
#line 26 "test/src/deact.act"
838863
if (ORD_B_int__eq__(i, to$int(2))) {
864+
#line 27 "test/src/deact.act"
839865
((B_Msg (*) (B_Env, B_int))self->env->$class->exit)(self->env, to$int(0));
840866
}
841867
return $R_CONT(C_cont, i);

0 commit comments

Comments
 (0)