Last active
March 29, 2023 19:10
-
-
Save JordanMartinez/d66cb8170067c7eeb59c9e9d68260261 to your computer and use it in GitHub Desktop.
Generate mkFnX/runFnX FFI
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| module Main where | |
| import Prelude | |
| import Data.Array as Array | |
| import Data.Foldable as F | |
| import Data.Traversable as T | |
| import Effect (Effect) | |
| import Effect.Class.Console (log) | |
| import TryPureScript as TryPureScript | |
| import Dodo as D | |
| import Data.Monoid (power) | |
| main :: Effect Unit | |
| main = TryPureScript.render =<< TryPureScript.withConsole do | |
| let fns = buildFunctions | |
| log $ D.print D.plainText D.twoSpaces $ | |
| F.fold | |
| [ (F.intercalate (D.break <> D.break) fns.mkFnX) | |
| , (D.break <> D.break) | |
| , (F.intercalate (D.break <> D.break) fns.runFnX) | |
| ] | |
| buildFunctions | |
| :: { mkFnX :: Array (D.Doc Void) | |
| , runFnX :: Array (D.Doc Void) | |
| } | |
| buildFunctions = | |
| { mkFnX: map _.mkFnX intermediateResult | |
| , runFnX: map _.runFnX intermediateResult | |
| } | |
| where | |
| args = ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j"] | |
| intermediateResult = _.value $ T.mapAccumL accumFn [] args | |
| accumFn | |
| :: Array String | |
| -> String | |
| -> { accum :: Array String | |
| , value :: | |
| { mkFnX :: D.Doc Void | |
| , runFnX :: D.Doc Void | |
| } | |
| } | |
| accumFn arraySoFar nextArg = do | |
| let newAccum = Array.snoc arraySoFar nextArg | |
| { accum: newAccum | |
| , value: | |
| { mkFnX: mkFnX newAccum | |
| , runFnX: runFnX newAccum | |
| } | |
| } | |
| mkFnX :: Array String -> D.Doc Void | |
| mkFnX args = | |
| D.lines | |
| [ D.text $ "(scm:define mkFn" <> show argLength | |
| , D.indent $ D.lines | |
| [ D.text "(scm:lambda (fn)" | |
| , D.indent $ rest \idents -> do | |
| let | |
| result = idents # flip F.foldr { init: true, doc: mempty } \next dAcc -> | |
| { init: false | |
| , doc: if dAcc.init then | |
| D.text $ "(fn " <> next <> ")" | |
| else | |
| D.words [ D.text "(" <> dAcc.doc, D.text $ next <> ")" ] | |
| } | |
| result.doc <> (D.text $ power ")" (2 + Array.length idents)) | |
| ] | |
| ] | |
| where | |
| argLength = Array.length args | |
| rest :: (Array String -> D.Doc Void) -> D.Doc Void | |
| rest cb = (F.foldr foldFn cb args) [] | |
| where | |
| foldFn next acc idents = do | |
| D.lines | |
| [ D.text $ "(scm:lambda (" <> next <> ")" | |
| , D.indent $ acc $ Array.cons next idents | |
| ] | |
| runFnX :: Array String -> D.Doc Void | |
| runFnX args = | |
| D.lines | |
| [ D.text $ "(scm:define runFn" <> show (Array.length args) | |
| , D.indent $ D.lines | |
| [ D.text "(scm:lambda (fn)" | |
| , D.indent $ D.lines | |
| [ D.text "(scm:lambda (" <> (D.words $ map D.text args) <> D.text ")" | |
| , D.indent do | |
| let | |
| result = args # flip F.foldl { init: true, doc: mempty } \dAcc next -> | |
| { init: false | |
| , doc: if dAcc.init then | |
| D.words [ D.text $ "(fn", D.text $ next <> ")" ] | |
| else | |
| D.words [ D.text "(" <> dAcc.doc, D.text $ next <> ")" ] | |
| } | |
| result.doc <> D.text ")))" | |
| ] | |
| ] | |
| ] | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment