shithub: MicroHs

--- a/comb/mhs.comb

+++ b/comb/mhs.comb

@@ -1,3 +1,3 @@

 v4.0

-1115

-((A :0 _938) ((A :1 ((B _984) _0)) ((A :2 (((S' _984) _0) I)) ((A :3 _908) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _937) ((C _84) _5))) ((A :7 (((C' _6) (_955 _73)) ((_84 _953) _72))) ((A :8 ((B ((S _984) _953)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_84 _207)) _10)) ((A :12 ((B (B (_82 _9))) (((C' B) ((B C) _10)) (B _10)))) ((A :13 ((B (B (_82 _9))) (((C' B) ((B C) _10)) (BK _10)))) ((A :14 ((B (_82 _9)) P)) ((A :15 ((B (B (_82 _9))) ((B ((C' C) _10)) (B P)))) ((A :16 _15) ((A :17 (((C' B) _12) (((C' B) _12) (B _14)))) ((A :18 ((B (_82 _9)) (B (P _866)))) ((A :19 ((B (_82 _9)) (BK (P _866)))) ((A :20 ((_82 _9) ((S P) I))) ((A :21 ((B (_82 _9)) ((C (S' P)) I))) ((A :22 ((B Y) ((B (B (P (_14 _123)))) (((C' B) ((B (C' B)) (B _12))) (((C' (C' B)) (B _12)) ((B (B _14)) _124)))))) ((A :23 ((B Y) ((B (B (P (_14 _866)))) ((B (C' B)) (B _13))))) ((A :24 _3) ((A :25 (T (_14 _866))) ((A :26 (_22 _85)) ((A :27 (R _34)) ((A :28 (T _33)) ((A :29 ((P _34) _33)) ((A :30 _34) ((A :31 ((C ((C S') _29)) I)) ((A :32 ((C S) _29)) ((A :33 K) ((A :34 A) ((A :35 ((_76 _902) _903)) ((A :36 ((_76 _912) (_80 _36))) ((A :37 _913) ((A :38 _914) ((A :39 (((S' _28) (_905 #97)) ((C _905) #122))) ((A :40 (((S' _28) (_905 #65)) ((C _905) #90))) ((A :41 (((S' _27) _39) _40)) ((A :42 (((S' _28) (_905 #48)) ((C _905) #57))) ((A :43 (((S' _28) (_905 #32)) ((C _905) #126))) ((A :44 _902) ((A :45 _903) ((A :46 _905) ((A :47 _904) ((A :48 (((S' _27) ((C _44) #32)) (((S' _27) ((C _44) #9)) ((C _44) #10)))) ((A :49 ((S ((S (((S' _28) (_46 #65)) ((C _46) #90))) (_34 (((_865 "lib/Data/Char.hs") #3) #8)))) ((B _37) (((C' _91) (((C' _92) _38) (_38 #65))) (_38 #97))))) ((A :50 ((S ((S (((S' _28) (_46 #97)) ((C _46) #97))) (_34 (((_865 "lib/Data/Char.hs") #3) #8)))) ((B _37) (((C' _91) (((C' _92) _38) (_38 #97))) (_38 #65))))) ((A :51 _873) ((A :52 _874) ((A :53 _875) ((A :54 _876) ((A :55 (_52 %0.0)) ((A :56 _51) ((A :57 _52) ((A :58 _53) ((A :59 _54) ((A :60 ((_76 _877) _878)) ((A :61 (_77 _60)) ((A :62 (_78 _60)) ((A :63 _879) ((A :64 _880) ((A :65 _881) ((A :66 _882) ((A :67 _63) ((A :68 _64) ((A :69 _65) ((A :70 _66) ((A :71 _883) ((A :72 ((B BK) T)) ((A :73 (BK T)) ((A :74 (((S' _76) (((S' C) ((B (C S')) (((C' C) ((B (C C')) ((B _77) (T K)))) (K _33)))) ((B ((C' B) (T (K _33)))) ((B _77) (T A))))) ((B _80) ((B _74) (((S' P) (T K)) (T A)))))) ((A :75 P) ((A :76 P) ((A :77 (T K)) ((A :78 (T A)) ((A :79 (K (noDefault "Eq.=="))) ((A :80 ((B (B (B _29))) _77)) ((A :81 ((_76 ((C ((C S') _29)) I)) (_80 _81))) ((A :82 I) ((A :83 (S _910)) ((A :84 B) ((A :85 I) ((A :86 K) ((A :87 C) ((A :88 _909) ((A :89 ((C ((C S') _207)) _208)) ((A :90 (((C' (S' (C' B))) B) I)) ((A :91 _867) ((A :92 _868) ((A :93 _869) ((A :94 _870) ((A :95 _871) ((A :96 _872) ((A :97 (_92 #0)) ((A :98 ((_76 _890) _891)) ((A :99 _892) ((A :100 _893) ((A :101 _894) ((A :102 _895) ((A :103 (_77 _98)) ((A :104 (BK K)) ((A :105 ((B BK) ((B (B BK)) P))) ((A :106 ((B (B (B BK))) ((B (B (B BK))) ((B (B (B C))) ((B (B C)) P))))) ((A :107 (((S' S) (((S' (S' C)) (((C' (C' S)) (((C' B) ((B (S' S')) (((C' B) ((B _27) (_100 #0))) ((C (_77 _98)) #0)))) ((B (B ((C' P) (_96 #1)))) _91))) (C P))) _94)) _95)) ((A :108 _104) ((A :109 (((S' C) ((B (P _194)) (((C' (C' B)) (((C' C) (_77 _98)) _194)) _195))) ((B ((C' (C' (C' C))) (((C' (C' (C' C))) (((C' (C' (C' (C' S')))) ((B (B (B (B C)))) ((B ((C' (C' (C' C))) ((B (B (B ((S' S') ((C (_77 _98)) #0))))) ((B ((C' (C' C)) ((B (B ((S' S') ((C (_77 _98)) #1)))) ((B ((C' C) ((B ((C' S') ((C (_77 _98)) #2))) (C _109)))) (C _109))))) (C _109))))) (C _109)))) (T K))) (T A)))) ((C _107) #4)))) ((A :110 (_116 _86)) ((A :111 ((_132 (_89 _110)) _108)) ((A :112 ((C (((C' B) ((P _123) (((C' (C' O)) P) K))) (((S' (C' (C' (C' B)))) ((B (B (B (B _113)))) (((S' (C' (C' B))) ((B (B (B _113))) (((S' (C' B)) ((B (B _113)) (((C' B) ((B _130) (T #0))) _112))) (((C' B) ((B _130) (T #1))) _112)))) (((C' B) ((B _130) (T #2))) _112)))) (((C' B) ((B _130) (T #3))) _112)))) ((B T) ((B (B P)) ((C' _91) (_93 #4)))))) ((A :113 ((S S) ((B BK) ((B BK) (((S' S) T) ((B BK) ((B BK) ((C (((S' C'

\ No newline at end of file

+1118

+((A :0 _941) ((A :1 ((B _987) _0)) ((A :2 (((S' _987) _0) I)) ((A :3 _911) ((A :4 (_3 "undefined")) ((A :5 I) ((A :6 (((C' B) _940) ((C _84) _5))) ((A :7 (((C' _6) (_958 _73)) ((_84 _956) _72))) ((A :8 ((B ((S _987) _956)) _3)) ((A :9 T) ((A :10 (T I)) ((A :11 ((B (_84 _207)) _10)) ((A :12 ((B (B (_82 _9))) (((C' B) ((B C) _10)) (B _10)))) ((A :13 ((B (B (_82 _9))) (((C' B) ((B C) _10)) (BK _10)))) ((A :14 ((B (_82 _9)) P)) ((A :15 ((B (B (_82 _9))) ((B ((C' C) _10)) (B P)))) ((A :16 _15) ((A :17 (((C' B) _12) (((C' B) _12) (B _14)))) ((A :18 ((B (_82 _9)) (B (P _869)))) ((A :19 ((B (_82 _9)) (BK (P _869)))) ((A :20 ((_82 _9) ((S P) I))) ((A :21 ((B (_82 _9)) ((C (S' P)) I))) ((A :22 ((B Y) ((B (B (P (_14 _123)))) (((C' B) ((B (C' B)) (B _12))) (((C' (C' B)) (B _12)) ((B (B _14)) _124)))))) ((A :23 ((B Y) ((B (B (P (_14 _869)))) ((B (C' B)) (B _13))))) ((A :24 _3) ((A :25 (T (_14 _869))) ((A :26 (_22 _85)) ((A :27 (R _34)) ((A :28 (T _33)) ((A :29 ((P _34) _33)) ((A :30 _34) ((A :31 ((C ((C S') _29)) I)) ((A :32 ((C S) _29)) ((A :33 K) ((A :34 A) ((A :35 ((_76 _905) _906)) ((A :36 ((_76 _915) (_80 _36))) ((A :37 _916) ((A :38 _917) ((A :39 (((S' _28) (_908 #97)) ((C _908) #122))) ((A :40 (((S' _28) (_908 #65)) ((C _908) #90))) ((A :41 (((S' _27) _39) _40)) ((A :42 (((S' _28) (_908 #48)) ((C _908) #57))) ((A :43 (((S' _28) (_908 #32)) ((C _908) #126))) ((A :44 _905) ((A :45 _906) ((A :46 _908) ((A :47 _907) ((A :48 (((S' _27) ((C _44) #32)) (((S' _27) ((C _44) #9)) ((C _44) #10)))) ((A :49 ((S ((S (((S' _28) (_46 #65)) ((C _46) #90))) (_34 (((_868 "lib/Data/Char.hs") #3) #8)))) ((B _37) (((C' _91) (((C' _92) _38) (_38 #65))) (_38 #97))))) ((A :50 ((S ((S (((S' _28) (_46 #97)) ((C _46) #97))) (_34 (((_868 "lib/Data/Char.hs") #3) #8)))) ((B _37) (((C' _91) (((C' _92) _38) (_38 #97))) (_38 #65))))) ((A :51 _876) ((A :52 _877) ((A :53 _878) ((A :54 _879) ((A :55 (_52 %0.0)) ((A :56 _51) ((A :57 _52) ((A :58 _53) ((A :59 _54) ((A :60 ((_76 _880) _881)) ((A :61 (_77 _60)) ((A :62 (_78 _60)) ((A :63 _882) ((A :64 _883) ((A :65 _884) ((A :66 _885) ((A :67 _63) ((A :68 _64) ((A :69 _65) ((A :70 _66) ((A :71 _886) ((A :72 ((B BK) T)) ((A :73 (BK T)) ((A :74 (((S' _76) (((S' C) ((B (C S')) (((C' C) ((B (C C')) ((B _77) (T K)))) (K _33)))) ((B ((C' B) (T (K _33)))) ((B _77) (T A))))) ((B _80) ((B _74) (((S' P) (T K)) (T A)))))) ((A :75 P) ((A :76 P) ((A :77 (T K)) ((A :78 (T A)) ((A :79 (K (noDefault "Eq.=="))) ((A :80 ((B (B (B _29))) _77)) ((A :81 ((_76 ((C ((C S') _29)) I)) (_80 _81))) ((A :82 I) ((A :83 (S _913)) ((A :84 B) ((A :85 I) ((A :86 K) ((A :87 C) ((A :88 _912) ((A :89 ((C ((C S') _207)) _208)) ((A :90 (((C' (S' (C' B))) B) I)) ((A :91 _870) ((A :92 _871) ((A :93 _872) ((A :94 _873) ((A :95 _874) ((A :96 _875) ((A :97 (_92 #0)) ((A :98 ((_76 _893) _894)) ((A :99 _895) ((A :100 _896) ((A :101 _897) ((A :102 _898) ((A :103 (_77 _98)) ((A :104 (BK K)) ((A :105 ((B BK) ((B (B BK)) P))) ((A :106 ((B (B (B BK))) ((B (B (B BK))) ((B (B (B C))) ((B (B C)) P))))) ((A :107 (((S' S) (((S' (S' C)) (((C' (C' S)) (((C' B) ((B (S' S')) (((C' B) ((B _27) (_100 #0))) ((C (_77 _98)) #0)))) ((B (B ((C' P) (_96 #1)))) _91))) (C P))) _94)) _95)) ((A :108 _104) ((A :109 (((S' C) ((B (P _194)) (((C' (C' B)) (((C' C) (_77 _98)) _194)) _195))) ((B ((C' (C' (C' C))) (((C' (C' (C' C))) (((C' (C' (C' (C' S')))) ((B (B (B (B C)))) ((B ((C' (C' (C' C))) ((B (B (B ((S' S') ((C (_77 _98)) #0))))) ((B ((C' (C' C)) ((B (B ((S' S') ((C (_77 _98)) #1)))) ((B ((C' C) ((B ((C' S') ((C (_77 _98)) #2))) (C _109)))) (C _109))))) (C _109))))) (C _109)))) (T K))) (T A)))) ((C _107) #4)))) ((A :110 (_116 _86)) ((A :111 ((_132 (_89 _110)) _108)) ((A :112 ((C (((C' B) ((P _123) (((C' (C' O)) P) K))) (((S' (C' (C' (C' B)))) ((B (B (B (B _113)))) (((S' (C' (C' B))) ((B (B (B _113))) (((S' (C' B)) ((B (B _113)) (((C' B) ((B _130) (T #0))) _112))) (((C' B) ((B _130) (T #1))) _112)))) (((C' B) ((B _130) (T #2))) _112)))) (((C' B) ((B _130) (T #3))) _112)))) ((B T) ((B (B P)) ((C' _91) (_93 #4)))))) ((A :113 ((S S) ((B BK) ((B BK) (((S' S) T) ((B BK) ((B BK) ((C (((S' C'

\ No newline at end of file

--- a/src/MicroHs/Desugar.hs

+++ b/src/MicroHs/Desugar.hs

@@ -27,7 +27,7 @@

 desugar atm =

   case atm of

     TModule mn fxs tys syns clss insts vals ds ->

-      TModule mn fxs tys syns clss insts vals $ checkDup $ concatMap (dsDef mn) ds

+      TModule mn fxs tys syns clss insts vals $ map lazier $ checkDup $ concatMap (dsDef mn) ds

 dsDef :: IdentModule -> EDef -> [LDef]

 dsDef mn adef =

@@ -408,8 +408,7 @@

 eEqChar = Var $ mkIdent "Primitives.primCharEQ"

 eEqStr :: Exp

-eEqStr = --Var $ mkIdent "Text.String.eqString"

-         Lit (LPrim "equal")

+eEqStr = Lit (LPrim "equal")

 mkCase :: Exp -> [(SPat, Exp)] -> Exp -> Exp

 mkCase var pes dflt =

@@ -518,3 +517,29 @@

         -- XXX mysteriously the location for i2 is the same as i1

         -- ++ ", also at " ++ showSLoc (getSLocIdent i2)

     _ -> error "checkDup"

+-- Make recursive definitions lazier.

+-- The idea is that we have

+--  f x y = ... (f x) ...

+-- we turn this into

+--  f x = letrec f' y = ... f' ... in f'

+-- thus avoiding the extra argument passing.

+-- XXX should generalize for an arbitrary length prefix of variables.

+lazier :: LDef -> LDef

+{-

+lazier def@(fcn, Lam x (Lam y body)) =

+  let fcn' = addIdentSuffix fcn "@"

+      vfcn' = Var fcn'

+      repl :: Exp -> S.State Bool Exp

+      repl (Lam i e) = Lam i <$> repl e

+      repl (App (Var af) (Var ax)) | eqIdent af fcn && eqIdent ax x = S.do

+        put True

+        S.return vfcn'

+      repl (App f a) = App <$> repl f <*> repl a

+      repl e@(Var _) = S.return e

+      repl e@(Lit _) = S.return e

+  in  case S.runState (repl body) False of

+        (_, False) -> def

+        (e', True) -> (fcn, Lam x $ letRecE fcn' (Lam y e') vfcn')

+-}

+lazier def = def

--

⑨