ref: d9ada2faca466d1c98464c9c8a055c012f962015
parent: 347f024319705f65e29163f05a9a06253521b7ee
author: Lennart Augustsson <lennart.augustsson@epicgames.com>
date: Tue Sep 19 12:55:11 EDT 2023
Avoid quadratic concatenation by using diff lists.
--- a/comb/mhs.comb
+++ b/comb/mhs.comb
@@ -1,3 +1,3 @@
v3.4
-830
-(($A :0 ((_627 _578) (($B ((($S' ($C ((($C' ($S' _627)) (($B ($C _2)) _562)) (($B ($B (_627 _656))) ((($C' ($C' $C)) ((($C' ($S' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $S)))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' $C))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' ($C' $S'))))) ((($C' ($C' ($C' ($C' ($C' $C'))))) ((($C' ($C' ($C' ($S' ($C' $C'))))) (($B ($B ($B ($B $B')))) ((($S' $B) ($B' ($B' (($B ($S' $B)) (($B ($B _628)) ((($C' $B) (($B _724) (($B _646) ((($C' _761) _8) 0)))) (($B (_724 _649)) (($B (_662 "top level defns: ")) _608)))))))) ((($S' $B) ($B' (($B ($C' $B)) (($B $B') (($B ($B _628)) ((($C' $B) (($B _724) (($B _646) ((($C' _761) _8) 1)))) (_645 ($T (($B ($B (_724 _649))) ((($C' $B) (($B _662) ((($C' _662) _568) " = "))) _393)))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _628))) ((($C' $B) ($B' (($B _724) (($B _651) _11)))) (($B _662) ((($C' _662) (($B (_662 _1)) _608)) (($O 10) $K)))))) (($B ($B (_627 _656))) ((($C' $B) ($B' (($B _724) (($B _646) ((($C' _761) _8) 0))))) (($B ($B (_724 _649))) ((($C' ($C' _662)) (($B ($B (_662 "final pass "))) (($B ($B (_622 6))) (($B ($B _608)) _755)))) "ms"))))))) _3))))) (($B (($C' $C) (($B ($C _667)) _393))) (($C _680) (_696 0))))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) ((($C' ($C' ($C' ($C' _662)))) (($B ($C' ($C' _662))) ((($C' ($C' ($C' _662))) (($B (($C' $B) (($B _662) ((($C' _662) (($B (_662 "(($A :")) _608)) (($O 32) $K))))) ($B _393))) ") "))) (($O 41) $K)))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _369)) $I))) ($BK $K))) $K))))) (($B (($S' _724) (($B _721) (($B (_724 _768)) (($B (_662 "main: findIdent: ")) _568))))) (($C' _597) _565)))) _604))) (($B ($B _601)) ((($C' $B) (($B _664) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _565))) $K)))))) (($C _680) (_696 0))))))) ($T $A))) ($T $K))) $I)) (($B (_724 _368)) (($B (_724 _562)) (($B (_662 (($O 95) $K))) _608)))))))) (($S (($S ((($S' _7) (($B _679) (_666 (_620 "-v")))) ((_695 _620) "-r"))) (($B (_660 (($O 46) $K))) (($B _723) (_665 ((_684 _746) "-i")))))) (($B (_724 _691)) ((($C' _662) (($B _723) (_665 ((_684 _746) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _757) _679) 1)) (_768 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _691)) (_666 ((_725 _766) ((_725 (_620 (($O 45) $K))) (_677 1))))))) (_687 ((_725 _766) (_620 "--")))))) (($A :1 "v3.4\10&") (($A :2 ((($S' ($S' _627)) _16) (($B ($B ($B (_627 _656)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _628) (($B (_724 _647)) (($B (_724 (_678 1000000))) _192)))))) (($B ($B ($B ($B (_627 _656))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _628))) ((($C' $B) ($B' (($B _724) (($B _646) ((($C' _761) _8) 0))))) (($B ($B (_724 _649))) ((($C' ($C' _662)) (($B ($B (_662 "combinator conversion "))) (($B ($B (_622 6))) (($B ($B _608)) _755)))) "ms")))))) (($B ($B _629)) (($B $P) (($C _571) (_562 "main")))))))) (_664 ($T ((($C' ($C' $O)) ((($C' $B) $P) _396)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_627 _578)))) (($B ($B ($B (($C' _579) ((($C' _750) (($B _679) (_687 ((_725 _766) (_620 "--"))))) 1))))) (($B ($B ($B (_724 _6)))) ($C $C))))) (($B ($B $Y)) (($B ($B ($B _553))) (($C' ($C' _664)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _724) (($B _721) (($B (_724 _768)) (($B (_662 "not found ")) _568))))) ($C _554))))) (($A :4 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _6)) _4)) _4))) ($BK $K))) ((($C' ($S' $C)) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _6)) $K))) ((($C' $B) _4) _395))) (($B (_724 (_721 (_768 "primlookup")))) (($C (_701 _620)) _5)))) $K))) (_768 "trans: impossible"))) (($A :5 (($O (($P (($O 66) $K)) $B)) (($O (($P (($O 79) $K)) $O)) (($O (($P (($O 75) $K)) $K)) (($O (($P "C'") $C')) (($O (($P (($O 67) $K)) $C)) (($O (($P (($O 65) $K)) $A)) (($O (($P "
\ No newline at end of file
+836
+(($A :0 ((_632 _582) (($B ((($S' ($C ((($C' ($S' _632)) (($B ($C _2)) _565)) (($B ($B (_632 _661))) ((($C' ($C' $C)) ((($C' ($S' ($C' $C))) ((($C' ($C' ($C' $C))) ((($C' ($C' ($C' ($C' $S')))) (($B ($B ($B ($B $C)))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' $S)))) ((($C' ($C' ($C' ($C' $C)))) ((($C' ($C' ($C' ($C' ($C' $S'))))) (($B ($B ($B ($B ($B $C))))) ((($C' ($C' ($C' ($C' ($C' $C))))) ((($C' ($C' ($C' $B))) (($B ($B ($B ($C' ($C' $S'))))) ((($C' ($C' ($C' ($C' ($C' $C'))))) ((($C' ($C' ($C' ($S' ($C' $C'))))) (($B ($B ($B ($B $B')))) ((($S' $B) ($B' ($B' (($B ($S' $B)) (($B ($B _633)) ((($C' $B) (($B _730) (($B _651) ((($C' _767) _8) 0)))) (($B (_730 _654)) (($B (_667 "top level defns: ")) _612)))))))) ((($S' $B) ($B' (($B ($C' $B)) (($B $B') (($B ($B _633)) ((($C' $B) (($B _730) (($B _651) ((($C' _767) _8) 1)))) (_650 ($T (($B ($B (_730 _654))) ((($C' $B) (($B _667) ((($C' _667) _571) " = "))) (($C _395) $K))))))))))) ((($C' $B) ((($S' $C') (($B $C') (($B $C') _9))) ((($S' $B) (($B ($C' ($C' _633))) ((($C' $B) ($B' (($B _730) (($B _656) _11)))) (($B _667) ((($C' _667) (($B (_667 _1)) _612)) (($O 10) $K)))))) (($B ($B (_632 _661))) ((($C' $B) ($B' (($B _730) (($B _651) ((($C' _767) _8) 0))))) (($B ($B (_730 _654))) ((($C' ($C' _667)) (($B ($B (_667 "final pass "))) (($B ($B (_626 6))) (($B ($B _612)) _761)))) "ms"))))))) _3))))) ((($C' ($C' $C)) (($B (($C' $C) (($B ($C _672)) _395))) (($C _685) (_701 0)))) $K))) (($B ($C $B)) (($B ($B ($C $B))) (($B ($B $BK)) (($B ($B (($C' $B) (($B _731) (($B _667) ((($C' _667) (($B (_667 "(($A :")) _612)) (($O 32) $K))))))) ((($C' $B) (($B ($C' _731)) ($B _395))) (($B (_731 (_667 ") "))) (($C _731) (_667 (($O 41) $K)))))))))))) $T)) (($B $Y) ((($C' ($C' $S)) ((($C' ($C' $S)) ((($C' $B) $P) ((($S' ($C' $B)) ($B _370)) $I))) ($BK $K))) $K))))) (($B (($S' _730) (($B _727) (($B (_730 _774)) (($B (_667 "main: findIdent: ")) _571))))) (($C' _601) _568)))) _608))) (($B ($B _605)) ((($C' $B) (($B _669) (($B $T) (($B ($C $B)) (($B ($B $BK)) ((($C' ($C' ($C' $O))) ($B (($C' $P) _568))) $K)))))) (($C _685) (_701 0))))))) ($T $A))) ($T $K))) $I)) (($B (_730 _369)) (($B (_730 _565)) (($B (_667 (($O 95) $K))) _612)))))))) (($S (($S ((($S' _7) (($B _684) (_671 (_624 "-v")))) ((_700 _624) "-r"))) (($B (_665 (($O 46) $K))) (($B _729) (_670 ((_689 _752) "-i")))))) (($B (_730 _696)) ((($C' _667) (($B _729) (_670 ((_689 _752) "-o")))) (($O "out.comb") $K))))) (($B (($S (($C ((($C' _763) _684) 1)) (_774 "Usage: mhs [-v] [-r] [-iPATH] [-oFILE] ModuleName"))) _696)) (_671 ((_731 _772) ((_731 (_624 (($O 45) $K))) (_682 1))))))) (_692 ((_731 _772) (_624 "--")))))) (($A :1 "v3.4\10&") (($A :2 ((($S' ($S' _632)) _16) (($B ($B ($B (_632 _661)))) ((($C' ($C' $B)) (($B ($B ($C' (($S' _632) (($B _634) (_723 _216)))))) (($B ($B ($B ($B $T)))) (($B ($B ($B ($B (_632 _661))))) ((($C' $B) (($B ($C' $B)) (($B ($B ($C' _633))) ((($C' $B) ($B' (($B _730) (($B _651) ((($C' _767) _8) 0))))) (($B ($B (_730 _654))) ((($C' ($C' _667)) (($B ($B (_667 "combinator conversion "))) (($B ($B (_626 6))) (($B ($B _612)) _761)))) "ms")))))) (($B ($B _634)) (($B $P) (($C _574) (_565 "main"))))))))) (_669 ($T ((($C' ($C' $O)) ((($C' $B) $P) _398)) $K))))))) (($A :3 ($T (($C ((($C' $C') (($B ($S' ($B (_632 _582)))) (($B ($B ($B (($C' _583) ((($C' _756) (($B _684) (_692 ((_731 _772) (_624 "--"))))) 1))))) (($B ($B ($B (_730 _6)))) ($C $C))))) (($B ($B $Y)) (($B ($B ($B _556))) (($C' ($C' _669)) (($B ($B $T)) ((($C' ($C' ($C' ($C' $O)))) (($B ($B (($C' $B) $P))) ($B _4))) $K))))))) (($B (($S' _730) (($B _727) (($B (_730 _774)) (($B (_667 "not found ")) _571))))) ($C _557))))) (($A :4 ((($C' $C) ((($S' $C) ((($C' ($C' $S')) (($S $P) ((($S' ($C' $B)) (($B ($B _6)) _4)) _4))) ($BK $K))) ((($C' ($S' $C)) ((($C' ($C' $C)) (($B (($C' $C) (($B ($P _6)) $K))) ((($C' $B) _4) _397))) ((($S' _730) (($B _727) (($B (_730 _774)) (_667 "primlookup: ")))) (($C (_706 _624)) _5)))) $K))) (_774 "trans: impossible"))) (($A :5 (($O (($P (($O 66) $K)) $B)) (($O (($P (($O 79) $K)) $O)) (($O (($P (($O 75) $K)) $K)) (($O (($P "C'") $C')) (($O (($P
\ No newline at end of file
--- a/src/MicroHs/Exp.hs
+++ b/src/MicroHs/Exp.hs
@@ -132,19 +132,21 @@
_ -> False
-}
-toStringP :: Exp -> String
+-- Avoid quadratic concatenation by using difference lists,
+-- turning concatenation into function composition.
+toStringP :: Exp -> (String -> String)
toStringP ae =
case ae of
- Var x -> showIdent x
+ Var x -> (showIdent x ++)
Lit (LStr s) ->
-- Encode very short string directly as combinators.
if length s > 1 then
- quoteString s
+ (quoteString s ++)
else
toStringP (encodeString s)
- Lit l -> showLit l
- Lam x e -> "(\\" ++ showIdent x ++ " " ++ toStringP e ++ ")"
- App f a -> "(" ++ toStringP f ++ " " ++ toStringP a ++ ")"+ Lit l -> (showLit l ++)
+ Lam x e -> (("(\\" ++ showIdent x ++ " ") ++) . toStringP e . (")" ++)+ App f a -> ("(" ++) . toStringP f . (" " ++) . toStringP a . (")" ++)quoteString :: String -> String
quoteString s =
--- a/src/MicroHs/Main.hs
+++ b/src/MicroHs/Main.hs
@@ -41,20 +41,22 @@
Var n -> findIdent n
App f a -> App (substv f) (substv a)
e -> e
- --Xdef :: ((Ident, Exp), Int) -> String -> String
+ def :: ((Ident, Exp), Int) -> (String -> String) -> (String -> String)
def d r =
case d of
- ((_, e), i) -> "(($A :" ++ showInt i ++ " " ++ toStringP (substv e) ++ ") " ++ r ++ ")"
- res = foldr def (toStringP emain) (zip ds (enumFrom 0))
+ ((_, e), i) ->
+ (("(($A :" ++ showInt i ++ " ") ++) . toStringP (substv e) . (") " ++) . r . (")" ++)+ res = foldr def (toStringP emain) (zip ds (enumFrom 0)) ""
numDefs = M.size defs
when (verbose flags > 0) $
putStrLn $ "top level defns: " ++ showInt numDefs
when (verbose flags > 1) $
- mapM_ (\ (i, e) -> putStrLn $ showIdent i ++ " = " ++ toStringP e) ds
+ mapM_ (\ (i, e) -> putStrLn $ showIdent i ++ " = " ++ toStringP e "") ds
if runIt flags then do
let
prg = translate cmdl
-- putStrLn "Run:"
+-- writeSerialized "ser.comb" prg
prg
-- putStrLn "done"
else do
--
⑨