diff --git a/golden/factorial/exec b/golden/factorial/exec new file mode 100644 index 0000000..f17cfa4 --- /dev/null +++ b/golden/factorial/exec @@ -0,0 +1,2 @@ +ret > ExitSuccess +out > 720 diff --git a/golden/factorial/source.scm b/golden/factorial/source.scm new file mode 100644 index 0000000..313b5ae --- /dev/null +++ b/golden/factorial/source.scm @@ -0,0 +1,5 @@ +(letrec ((fac (λ (n) + (if (zero? n) + 1 + (* n (fac (- n 1))))))) + (fac 6)) diff --git a/src/Gyehoek/CPS/Convert.hs b/src/Gyehoek/CPS/Convert.hs index 11270dd..0a77a66 100644 --- a/src/Gyehoek/CPS/Convert.hs +++ b/src/Gyehoek/CPS/Convert.hs @@ -14,6 +14,10 @@ import Control.Monad.Cont qualified as Cont import Control.Lens import qualified Data.List.NonEmpty as NE import qualified Gyehoek.Sexp +import Data.String.Interpolate (i) +import Data.Functor (unzip) +import Data.List (List) +import Prelude hiding (unzip) -- 뻘짓이어라 @@ -45,11 +49,10 @@ convert (Scm.ExpPrim p) k = convert (Scm.ExpLambda xs e) k = do f <- gensym' "λ-body" - ktail <- gensym' "λ-tail" - m <- convert e $ \e' -> pure $ ExpContinue ktail [e'] + lam <- convertLambda xs e ke <- k $ ValVar f pure [cps| - (letrec ((#{f} (λ (##{xs} #{ktail}) #{m}))) + (letrec ((#{f} #{lam})) #{ke}) |] @@ -80,7 +83,24 @@ convert (Scm.ExpLet bs e) k = (continue #{kbody} ##{rhss'})) |] -convert _ k = _ +convert (Scm.ExpLetRec bs m) k = do + let bs' = bs & each . _2 %~ (^?! #ExpLambda) + let conv = traverseOf _2 (uncurry $ convertLambda @es) + bs'' <- traverse conv bs' + m' <- convert m k + pure [cps| + (letrec #{bs''} #{m'}) + |] + +-- convert e k = error [i|unimplemented expr: #{e}|] + +convertLambda + :: GenSym :> es + => List Name -> Scm.Exp -> Eff es Lambda +convertLambda bs m = do + ktail <- gensym' "lambda-tail" + m' <- convert m $ pure . ExpContinue ktail . (:[]) + pure [cps|(λ (##{bs} #{ktail}) #{m'})|] convertProgram :: forall es. (GenSym :> es) => Scm.Program -> Eff es Program convertProgram p = diff --git a/test/Gyehoek/Test/Golden.hs b/test/Gyehoek/Test/Golden.hs index eb8a535..1355108 100644 --- a/test/Gyehoek/Test/Golden.hs +++ b/test/Gyehoek/Test/Golden.hs @@ -25,6 +25,7 @@ brokenWasmTests = , "fn-of-fn" , "let-fn" , "apply2" + , "factorial" ] brokenStackifyTests :: List String