Skip to content

Commit 759157f

Browse files
author
VictorTaelin
committed
C runtime refactor + perf: split modular files but build as single translation unit; include runtime sources for TH.
- Split C runtime into organized modules under src/HVM/runtime/* - Build as a single translation unit via src/HVM/Runtime.c aggregator to restore -c performance - Update cabal: include runtime sources in extra-source-files for Template Haskell embedding and sdist - Restores compiled-mode performance on examples/bench_cnots.hvm (-c) to pre-refactor levels Code generated by GPT-5 on Codex
1 parent 9cd8161 commit 759157f

52 files changed

Lines changed: 1702 additions & 1518 deletions

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

‎.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
dist-newstyle/
2+
dist-install/
23
*.o
34
*.hi
45
main

‎HVM.cabal‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,11 @@ author: Victor Taelin
88
maintainer: victor.taelin@gmail.com
99
category: Language
1010
build-type: Simple
11+
extra-source-files:
12+
src/HVM/Runtime.h
13+
src/HVM/runtime/*.c
14+
src/HVM/runtime/reduce/*.c
15+
src/HVM/runtime/prim/*.c
1116

1217

1318
library
@@ -35,6 +40,10 @@ library
3540
, HVM.API
3641
other-modules:
3742
hs-source-dirs: src
43+
include-dirs: src/HVM
44+
includes: Runtime.h
45+
install-includes: Runtime.h
46+
-- Build the runtime as a single translation unit for performance
3847
c-sources: src/HVM/Runtime.c
3948
extra-libraries: c
4049
ghc-options: -Wno-all

‎bug.hvm‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
@main = (+ 1 2)

‎examples/bench_count.hvm‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
1+p: @count(p,(+ k 2))
44
}
55

6-
@main = @count(2_000_000 0)
6+
@main = @count(2_000_000_000 0)
77

88
//WORK: 12000000004 interactions
99
//TIME: 1.1376750 seconds

‎src/HVM/API.hs‎

Lines changed: 52 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ module HVM.API where
33
import Control.DeepSeq (deepseq)
44
import Control.Monad (when, forM_)
55
import Data.Word (Word64)
6+
import Data.List (isPrefixOf)
67
import Foreign.LibFFI
78
import GHC.Clock
89
import HVM.Adjust
@@ -83,7 +84,57 @@ runBook book root mode compiled debug =
8384

8485
compileBookToBin :: FilePath -> Book -> IO FilePath
8586
compileBookToBin filePath book = do
86-
let mainC = compileBook book runtime_c
87+
runtime_c_str <- do
88+
let strip incl = unlines . filter (not . ("#include \"Runtime.h\"" `isPrefixOf`)) . lines $ incl
89+
hdr <- readFile' "src/HVM/Runtime.h"
90+
parts <- mapM (readFile')
91+
[ "src/HVM/runtime/state.c"
92+
, "src/HVM/runtime/heap.c"
93+
, "src/HVM/runtime/term.c"
94+
, "src/HVM/runtime/stack.c"
95+
, "src/HVM/runtime/print.c"
96+
, "src/HVM/runtime/memory.c"
97+
, "src/HVM/runtime/reduce.c"
98+
, "src/HVM/runtime/prim/SUP.c"
99+
, "src/HVM/runtime/prim/DUP.c"
100+
, "src/HVM/runtime/prim/LOG.c"
101+
, "src/HVM/runtime/reduce/app_ctr.c"
102+
, "src/HVM/runtime/reduce/app_era.c"
103+
, "src/HVM/runtime/reduce/app_lam.c"
104+
, "src/HVM/runtime/reduce/app_sup.c"
105+
, "src/HVM/runtime/reduce/app_una.c"
106+
, "src/HVM/runtime/reduce/app_w32.c"
107+
, "src/HVM/runtime/reduce/dup_ctr.c"
108+
, "src/HVM/runtime/reduce/dup_era.c"
109+
, "src/HVM/runtime/reduce/dup_lam.c"
110+
, "src/HVM/runtime/reduce/dup_ref.c"
111+
, "src/HVM/runtime/reduce/dup_sup.c"
112+
, "src/HVM/runtime/reduce/dup_una.c"
113+
, "src/HVM/runtime/reduce/dup_w32.c"
114+
, "src/HVM/runtime/reduce/let.c"
115+
, "src/HVM/runtime/reduce/ref.c"
116+
, "src/HVM/runtime/reduce/ref_sup.c"
117+
, "src/HVM/runtime/reduce/mat_ctr.c"
118+
, "src/HVM/runtime/reduce/mat_era.c"
119+
, "src/HVM/runtime/reduce/mat_lam.c"
120+
, "src/HVM/runtime/reduce/mat_sup.c"
121+
, "src/HVM/runtime/reduce/mat_una.c"
122+
, "src/HVM/runtime/reduce/mat_w32.c"
123+
, "src/HVM/runtime/reduce/opx_ctr.c"
124+
, "src/HVM/runtime/reduce/opx_era.c"
125+
, "src/HVM/runtime/reduce/opx_lam.c"
126+
, "src/HVM/runtime/reduce/opx_sup.c"
127+
, "src/HVM/runtime/reduce/opx_una.c"
128+
, "src/HVM/runtime/reduce/opx_w32.c"
129+
, "src/HVM/runtime/reduce/opy_ctr.c"
130+
, "src/HVM/runtime/reduce/opy_era.c"
131+
, "src/HVM/runtime/reduce/opy_lam.c"
132+
, "src/HVM/runtime/reduce/opy_sup.c"
133+
, "src/HVM/runtime/reduce/opy_una.c"
134+
, "src/HVM/runtime/reduce/opy_w32.c"
135+
]
136+
return $ unlines (hdr : map strip parts)
137+
let mainC = compileBook book runtime_c_str
87138
callCommand "mkdir -p .build"
88139
let fName = last $ words $ map (\c -> if c == '/' then ' ' else c) filePath
89140
let cPath = ".build/" ++ fName ++ ".c"

‎src/HVM/Compile.hs‎

Lines changed: 135 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,8 +18,142 @@ import HVM.Type
1818
import qualified Data.Map.Strict as MS
1919

2020
-- The Runtime.c file content embedded in the binary
21+
-- Embed the entire runtime as a single translation unit for compiled mode.
22+
-- We inline Runtime.h and concatenate all .c modules with the include line removed.
23+
runtime_h :: String
24+
runtime_h = $(embedStringFile "./src/HVM/Runtime.h")
25+
rt_state_c :: String; rt_state_c = $(embedStringFile "./src/HVM/runtime/state.c")
26+
rt_heap_c :: String; rt_heap_c = $(embedStringFile "./src/HVM/runtime/heap.c")
27+
rt_term_c :: String; rt_term_c = $(embedStringFile "./src/HVM/runtime/term.c")
28+
rt_stack_c :: String; rt_stack_c = $(embedStringFile "./src/HVM/runtime/stack.c")
29+
rt_print_c :: String; rt_print_c = $(embedStringFile "./src/HVM/runtime/print.c")
30+
rt_memory_c :: String; rt_memory_c = $(embedStringFile "./src/HVM/runtime/memory.c")
31+
rt_reduce_c :: String; rt_reduce_c = $(embedStringFile "./src/HVM/runtime/reduce.c")
32+
rt_pr_SUP_c :: String; rt_pr_SUP_c = $(embedStringFile "./src/HVM/runtime/prim/SUP.c")
33+
rt_pr_DUP_c :: String; rt_pr_DUP_c = $(embedStringFile "./src/HVM/runtime/prim/DUP.c")
34+
rt_pr_LOG_c :: String; rt_pr_LOG_c = $(embedStringFile "./src/HVM/runtime/prim/LOG.c")
35+
rt_red_app_ctr :: String; rt_red_app_ctr = $(embedStringFile "./src/HVM/runtime/reduce/app_ctr.c")
36+
rt_red_app_era :: String; rt_red_app_era = $(embedStringFile "./src/HVM/runtime/reduce/app_era.c")
37+
rt_red_app_lam :: String; rt_red_app_lam = $(embedStringFile "./src/HVM/runtime/reduce/app_lam.c")
38+
rt_red_app_sup :: String; rt_red_app_sup = $(embedStringFile "./src/HVM/runtime/reduce/app_sup.c")
39+
rt_red_app_una :: String; rt_red_app_una = $(embedStringFile "./src/HVM/runtime/reduce/app_una.c")
40+
rt_red_app_w32 :: String; rt_red_app_w32 = $(embedStringFile "./src/HVM/runtime/reduce/app_w32.c")
41+
rt_red_dup_ctr :: String; rt_red_dup_ctr = $(embedStringFile "./src/HVM/runtime/reduce/dup_ctr.c")
42+
rt_red_dup_era :: String; rt_red_dup_era = $(embedStringFile "./src/HVM/runtime/reduce/dup_era.c")
43+
rt_red_dup_lam :: String; rt_red_dup_lam = $(embedStringFile "./src/HVM/runtime/reduce/dup_lam.c")
44+
rt_red_dup_ref :: String; rt_red_dup_ref = $(embedStringFile "./src/HVM/runtime/reduce/dup_ref.c")
45+
rt_red_dup_sup :: String; rt_red_dup_sup = $(embedStringFile "./src/HVM/runtime/reduce/dup_sup.c")
46+
rt_red_dup_una :: String; rt_red_dup_una = $(embedStringFile "./src/HVM/runtime/reduce/dup_una.c")
47+
rt_red_dup_w32 :: String; rt_red_dup_w32 = $(embedStringFile "./src/HVM/runtime/reduce/dup_w32.c")
48+
rt_red_let :: String; rt_red_let = $(embedStringFile "./src/HVM/runtime/reduce/let.c")
49+
rt_red_ref :: String; rt_red_ref = $(embedStringFile "./src/HVM/runtime/reduce/ref.c")
50+
rt_red_ref_sup :: String; rt_red_ref_sup = $(embedStringFile "./src/HVM/runtime/reduce/ref_sup.c")
51+
rt_red_mat_ctr :: String; rt_red_mat_ctr = $(embedStringFile "./src/HVM/runtime/reduce/mat_ctr.c")
52+
rt_red_mat_era :: String; rt_red_mat_era = $(embedStringFile "./src/HVM/runtime/reduce/mat_era.c")
53+
rt_red_mat_lam :: String; rt_red_mat_lam = $(embedStringFile "./src/HVM/runtime/reduce/mat_lam.c")
54+
rt_red_mat_sup :: String; rt_red_mat_sup = $(embedStringFile "./src/HVM/runtime/reduce/mat_sup.c")
55+
rt_red_mat_una :: String; rt_red_mat_una = $(embedStringFile "./src/HVM/runtime/reduce/mat_una.c")
56+
rt_red_mat_w32 :: String; rt_red_mat_w32 = $(embedStringFile "./src/HVM/runtime/reduce/mat_w32.c")
57+
rt_red_opx_ctr :: String; rt_red_opx_ctr = $(embedStringFile "./src/HVM/runtime/reduce/opx_ctr.c")
58+
rt_red_opx_era :: String; rt_red_opx_era = $(embedStringFile "./src/HVM/runtime/reduce/opx_era.c")
59+
rt_red_opx_lam :: String; rt_red_opx_lam = $(embedStringFile "./src/HVM/runtime/reduce/opx_lam.c")
60+
rt_red_opx_sup :: String; rt_red_opx_sup = $(embedStringFile "./src/HVM/runtime/reduce/opx_sup.c")
61+
rt_red_opx_una :: String; rt_red_opx_una = $(embedStringFile "./src/HVM/runtime/reduce/opx_una.c")
62+
rt_red_opx_w32 :: String; rt_red_opx_w32 = $(embedStringFile "./src/HVM/runtime/reduce/opx_w32.c")
63+
rt_red_opy_ctr :: String; rt_red_opy_ctr = $(embedStringFile "./src/HVM/runtime/reduce/opy_ctr.c")
64+
rt_red_opy_era :: String; rt_red_opy_era = $(embedStringFile "./src/HVM/runtime/reduce/opy_era.c")
65+
rt_red_opy_lam :: String; rt_red_opy_lam = $(embedStringFile "./src/HVM/runtime/reduce/opy_lam.c")
66+
rt_red_opy_sup :: String; rt_red_opy_sup = $(embedStringFile "./src/HVM/runtime/reduce/opy_sup.c")
67+
rt_red_opy_una :: String; rt_red_opy_una = $(embedStringFile "./src/HVM/runtime/reduce/opy_una.c")
68+
rt_red_opy_w32 :: String; rt_red_opy_w32 = $(embedStringFile "./src/HVM/runtime/reduce/opy_w32.c")
69+
70+
stripIncl :: String -> String
71+
stripIncl = unlines . filter (not . isPrefixOf "#include \"Runtime.h\"") . lines
72+
2173
runtime_c :: String
22-
runtime_c = $(embedStringFile "./src/HVM/Runtime.c")
74+
runtime_c = unlines
75+
[ runtime_h
76+
, stripIncl rt_state_c
77+
, stripIncl rt_heap_c
78+
, stripIncl rt_term_c
79+
, stripIncl rt_stack_c
80+
, stripIncl rt_print_c
81+
, stripIncl rt_memory_c
82+
, stripIncl rt_reduce_c
83+
, "Term reduce_ref(Term ref) { inc_itr(); return HVM.book[term_lab(ref)](ref); }"
84+
, unlines
85+
[ "Term reduce_ref_sup(Term ref, u16 idx) {"
86+
, " inc_itr();"
87+
, " Loc ref_loc = term_loc(ref);"
88+
, " Lab ref_lab = term_lab(ref);"
89+
, " u16 fun_id = ref_lab;"
90+
, " u16 arity = HVM.fari[fun_id];"
91+
, " if (idx >= arity) { printf(\"ERROR: Invalid index in reduce_ref_sup\\n\"); exit(1); }"
92+
, " Term sup = got(ref_loc + idx);"
93+
, " if (term_tag(sup) != SUP) { printf(\"ERROR: Expected SUP at index %u\\n\", idx); exit(1); }"
94+
, " Lab sup_lab = term_lab(sup);"
95+
, " Loc sup_loc = term_loc(sup);"
96+
, " Term sup0 = got(sup_loc + 0);"
97+
, " Term sup1 = got(sup_loc + 1);"
98+
, " Loc ref1_loc = alloc_node(arity);"
99+
, " for (u64 i = 0; i < arity; ++i) {"
100+
, " if (i != idx) {"
101+
, " Term arg = got(ref_loc + i);"
102+
, " Loc dup_loc = alloc_node(1);"
103+
, " set(dup_loc + 0, arg);"
104+
, " set(ref_loc + i, term_new(DP0, sup_lab, dup_loc));"
105+
, " set(ref1_loc + i, term_new(DP1, sup_lab, dup_loc));"
106+
, " } else {"
107+
, " set(ref_loc + i, sup0);"
108+
, " set(ref1_loc + i, sup1);"
109+
, " }"
110+
, " }"
111+
, " Term ref0 = term_new(REF, ref_lab, ref_loc);"
112+
, " Term ref1 = term_new(REF, ref_lab, ref1_loc);"
113+
, " set(sup_loc + 0, ref0);"
114+
, " set(sup_loc + 1, ref1);"
115+
, " return term_new(SUP, sup_lab, sup_loc);"
116+
, "}"
117+
]
118+
, stripIncl rt_pr_SUP_c
119+
, stripIncl rt_pr_DUP_c
120+
, stripIncl rt_pr_LOG_c
121+
, stripIncl rt_red_app_ctr
122+
, stripIncl rt_red_app_era
123+
, stripIncl rt_red_app_lam
124+
, stripIncl rt_red_app_sup
125+
, stripIncl rt_red_app_una
126+
, stripIncl rt_red_app_w32
127+
, stripIncl rt_red_dup_ctr
128+
, stripIncl rt_red_dup_era
129+
, stripIncl rt_red_dup_lam
130+
, stripIncl rt_red_dup_ref
131+
, stripIncl rt_red_dup_sup
132+
, stripIncl rt_red_dup_una
133+
, stripIncl rt_red_dup_w32
134+
, stripIncl rt_red_let
135+
, stripIncl rt_red_ref
136+
, stripIncl rt_red_ref_sup
137+
, stripIncl rt_red_mat_ctr
138+
, stripIncl rt_red_mat_era
139+
, stripIncl rt_red_mat_lam
140+
, stripIncl rt_red_mat_sup
141+
, stripIncl rt_red_mat_una
142+
, stripIncl rt_red_mat_w32
143+
, stripIncl rt_red_opx_ctr
144+
, stripIncl rt_red_opx_era
145+
, stripIncl rt_red_opx_lam
146+
, stripIncl rt_red_opx_sup
147+
, stripIncl rt_red_opx_una
148+
, stripIncl rt_red_opx_w32
149+
, stripIncl rt_red_opy_ctr
150+
, stripIncl rt_red_opy_era
151+
, stripIncl rt_red_opy_lam
152+
, stripIncl rt_red_opy_sup
153+
, stripIncl rt_red_opy_una
154+
, stripIncl rt_red_opy_w32
155+
]
156+
23157

24158
-- Generates the complete C code for a Book
25159
compileBook :: Book -> String -> String

0 commit comments

Comments
 (0)