Tying the Knot

.gitignore

.stack-work
stack.yaml

LICENSE

YO

Main.hs

{-# LANGUAGE FlexibleContexts #-}

import qualified Data.Map as M
import Control.Monad.Reader

data Hir
  = HLabel String
  | HJump String
  | HNop
  deriving (Show, Eq)

data Lir
  = LJumpRel Int
  | LNop
  deriving (Show, Eq)

data SomeError
  = NotFound String
  deriving (Show, Eq)

type Table = M.Map String Int
type TableM = Reader Table

assemble' :: [(Int, Hir)] -> TableM ([Either SomeError Lir], [Table -> Table])
assemble' = (unzip <$>) . mapM go
  where
    go (ix, hir) = case hir of
      HLabel name ->
        pure (Right LNop, M.insert name ix)
      HJump name -> do
        mbIx <- asks (M.lookup name)
        -- Must be lazy here, or we would scrutinize the thunk too soon.
        pure (maybe (Left (NotFound name)) (Right . mkJ ix) mbIx, id)
      HNop ->
        pure (Right LNop, id)

    mkJ ix ix' = LJumpRel (ix' - ix)

  
assemble :: [Hir] -> Either SomeError [Lir]
assemble hs = verify res
  where
    (res, mkT) = runReader (assemble' (zip [0..] hs)) (l2r mkT M.empty)
    verify = sequence
    l2r = foldr (.) id

sampleHir = [ HJump "hai"
            , HLabel "hai"
            , HNop
            ]

main = print (assemble sampleHir)

Setup.hs

import Distribution.Simple
main = defaultMain

tying-knot-backpatching-sample.cabal

-- Initial tying-knot-backpatching-sample.cabal generated by cabal init.  
-- For further documentation, see http://haskell.org/cabal/users-guide/

name:                tying-knot-backpatching-sample
version:             0.1.0.0
-- synopsis:            
-- description:         
-- license:             
license-file:        LICENSE
author:              Overmind JIANG
maintainer:          redacted@gmail.com
-- copyright:           
-- category:            
build-type:          Simple
-- extra-source-files:  
cabal-version:       >=1.10

executable tying-knot-backpatching-sample
  main-is:             Main.hs
  -- other-modules:       
  -- default-extensions:
  build-depends:       base >=4.8 && <4.9
                     , containers
                     , mtl
  -- hs-source-dirs:      
  default-language:    Haskell2010