diff --git a/.github/workflows/fourmolu.yml b/.github/workflows/fourmolu.yml
new file mode 100644
index 00000000..a81558d8
--- /dev/null
+++ b/.github/workflows/fourmolu.yml
@@ -0,0 +1,21 @@
+name: fourmolu
+
+on:
+  push:
+    branches: [ master, dev ]
+    paths: [ '**.hs' ]
+  pull_request_target:
+    branches: [ master, dev ]
+    paths: [ '**.hs' ]
+
+jobs:
+  format:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v5
+
+      - uses: haskell-actions/run-fourmolu@v11
+        with:
+          version: "0.17.0.0"
+          follow-symbolic-links: false
+          working-directory: "./compiler"
diff --git a/compiler/Makefile b/compiler/Makefile
index 216554ec..2c9651cc 100644
--- a/compiler/Makefile
+++ b/compiler/Makefile
@@ -11,6 +11,13 @@ clean:
 	rm -rf ../bin
 # If problems still persist after this, remove all GHC compilers in ~/.stack/programs/**/
 
+# https://github.com/fourmolu/fourmolu
+format:
+	fourmolu -i *.hs */*.hs
+
+format/check:
+	fourmolu --mode check *.hs */*.hs
+
 ghci-irtester:
 	stack ghci --main-is Troupe-compiler:exe:irtester --no-load
 
diff --git a/compiler/README.md b/compiler/README.md
index a433982a..1b11e862 100644
--- a/compiler/README.md
+++ b/compiler/README.md
@@ -1 +1,5 @@
-# PicoML-compiler
+# TroupeC: Troupe Compiler
+
+## Formatting
+
+The Haskell code is formatted with [`fourmolu`](https://github.com/fourmolu/fourmolu).
diff --git a/compiler/Setup.hs b/compiler/Setup.hs
index 9a994af6..e8ef27db 100644
--- a/compiler/Setup.hs
+++ b/compiler/Setup.hs
@@ -1,2 +1,3 @@
 import Distribution.Simple
+
 main = defaultMain
diff --git a/compiler/app/Main.hs b/compiler/app/Main.hs
index fd007e2b..4c04533d 100644
--- a/compiler/app/Main.hs
+++ b/compiler/app/Main.hs
@@ -3,303 +3,299 @@
 module Main (main) where
 
 import qualified AtomFolding as AF
-import Parser
-import qualified Core as Core
-import RetDFCPS
 import qualified CaseElimination as C
-import System.Environment
-import Util.FileUtil
 import qualified ClosureConv as CC
+import qualified Core as Core
 import qualified IR as CCIR
 import qualified IROpt
+import Parser
+import RetDFCPS
+import System.Environment
+import Util.FileUtil
+
 -- import qualified RetRewrite as Rewrite
 import qualified CPSOpt as CPSOpt
 import qualified IR2JS
 import qualified IR2Raw
--- import qualified Stack 
+
+-- import qualified Stack
 import qualified Raw2Stack
-import qualified Stack2JS
 import qualified RawOpt
+import qualified Stack2JS
+
 -- import System.IO (isEOF)
+
+import AddAmbientMethods
+import CompileMode
+import Control.Monad (when)
+import Control.Monad.Except
 import qualified Data.ByteString as BS
 import Data.ByteString.Base64 (decode)
-import qualified Data.ByteString.Char8  as BSChar8
+import qualified Data.ByteString.Char8 as BSChar8
 import qualified Data.ByteString.Lazy.Char8 as BSLazyChar8
-import System.IO
-import System.Exit
+import Data.List as List
+import Data.Maybe (fromJust)
+import Exports
 import ProcessImports
-import AddAmbientMethods
 import ShowIndent
-import Exports
-import CompileMode
-import Control.Monad.Except
-import Control.Monad (when)
 import System.Console.GetOpt
-import Data.List as List
-import Data.Maybe (fromJust)
+import System.Exit
 import System.FilePath
+import System.IO
 
 -- import System.Console.Haskeline
 -- import System.Process
 
-
 -- compiler flags
 --
 data Flag
-  = IRMode
-  | JSONIRMode
-  | LibMode
-  | NoRawOpt
-  | OutputFile String
-  | Verbose
-  | Help
-  | Debug
-  deriving (Show, Eq)
+    = IRMode
+    | JSONIRMode
+    | LibMode
+    | NoRawOpt
+    | OutputFile String
+    | Verbose
+    | Help
+    | Debug
+    deriving (Eq, Show)
 
 options :: [OptDescr Flag]
 options =
-  [ Option ['i']      ["ir"]     (NoArg IRMode)              "ir interactive mode"
-  , Option ['j']      ["json"]   (NoArg JSONIRMode)          "ir json interactive mode"
-  , Option []         ["no-rawopt"] (NoArg NoRawOpt) "disable Raw optimization"
-  , Option ['v']      ["verbose"] (NoArg Verbose)            "verbose output"
-  , Option ['d']      ["debug"]  (NoArg Debug)               "debugging information in the .js file"
-  , Option ['l']      ["lib"]    (NoArg LibMode)             "compiling a library"
-  , Option ['h']      ["help"]   (NoArg Help)                "print usage"
-  , Option ['o']      ["output"] (ReqArg OutputFile "FILE")  "output FILE"
-  ]
-
--- debugTokens (Right tks) = 
-  -- mapM_ print tks 
+    [ Option ['i'] ["ir"] (NoArg IRMode) "ir interactive mode"
+    , Option ['j'] ["json"] (NoArg JSONIRMode) "ir json interactive mode"
+    , Option [] ["no-rawopt"] (NoArg NoRawOpt) "disable Raw optimization"
+    , Option ['v'] ["verbose"] (NoArg Verbose) "verbose output"
+    , Option ['d'] ["debug"] (NoArg Debug) "debugging information in the .js file"
+    , Option ['l'] ["lib"] (NoArg LibMode) "compiling a library"
+    , Option ['h'] ["help"] (NoArg Help) "print usage"
+    , Option ['o'] ["output"] (ReqArg OutputFile "FILE") "output FILE"
+    ]
+
+-- debugTokens (Right tks) =
+-- mapM_ print tks
 
 process :: [Flag] -> Maybe String -> String -> IO ExitCode
 process flags fname input = do
-  -- let tokens = parseTokens input
-  -- debugTokens tokens
-  let ast    = parseProg input
-
-  let compileMode =
-        if elem LibMode flags then Export
-        else Normal
-
-  let verbose = Verbose `elem` flags
-      noRawOpt = NoRawOpt `elem` flags
-
-  case ast of
-    Left err -> do
-      -- putStrLn ("Tokens: " ++ show tokens)
-      die $ "Parse Error:\n" ++ err
-
-    Right prog_parsed -> do
-      let prog_empty_imports = 
-            case compileMode of 
-                Normal -> addAmbientMethods prog_parsed 
-                Export -> prog_parsed 
-      prog <- processImports prog_empty_imports
-      
-      exports <- case compileMode of
-        Normal -> return Nothing
-        Export -> case runExcept (extractExports prog) of
-          Right es -> return (Just (es))
-          Left s -> die s
-       
-
-      when verbose $ do printSep "SYNTAX"
-                        putStrLn (showIndent 2 prog)
-
-      --------------------------------------------------
-      prog' <- case runExcept (C.trans compileMode (AF.visitProg prog)) of
-        Right p -> return p
-        Left s -> die s
-      when verbose $ do printSep "PATTERN MATCH ELIMINATION"
-                        writeFileD "out/out.nopats" (showIndent 2 prog')
-      --------------------------------------------------
-      let lowered = Core.lowerProg prog'
-      when verbose $ do printSep  "LOWERING FUNS AND LETS"
-                        writeFileD "out/out.lowered" (showIndent 2 lowered)
-      --------------------------------------------------
-      let renamed = Core.renameProg lowered
-      when verbose $ do printSep "α RENAMING"
-                        writeFileD "out/out.alpha" (showIndent 2 renamed)
-      --------------------------------------------------
-      let cpsed = RetDFCPS.transProg renamed
-      when verbose $ do printSep "CPSED"
-                        writeFileD "out/out.cps" (showIndent 2 cpsed)
-      --------------------------------------------------
-      let rwcps = CPSOpt.rewrite cpsed -- Rewrite.rewrite cpsed
-      when verbose $ do printSep  "REWRITING CPS"
-                        writeFileD "out/out.cpsopt" (showIndent 2 rwcps)
-      --------------------------------------------------
-      ir <- case runExcept (CC.closureConvert compileMode rwcps) of 
-          Right ir -> return ir 
-          Left  s -> die $ "troupec: " ++ s
-        
-      
-      
-
-      when verbose $ writeFileD "out/out.ir" (show ir)
-
-      let iropt = IROpt.iropt ir 
-      when verbose $ writeFileD "out/out.iropt" (show iropt)
-      
-
-      --------------------------------------------------
-      let debugOut = elem Debug flags 
-
-
-      ------ RAW -----------------------------------------
-      let raw = IR2Raw.prog2raw iropt
-      when verbose $ printSep  "GENERATING RAW"
-      when verbose $ writeFileD "out/out.rawout" (show raw)
-
-      ----- RAW OPT --------------------------------------
-
-      rawopt <- do
-            if noRawOpt
-            then return raw
-            else do
-              let opt = RawOpt.rawopt raw
-              when verbose $ printSep  "OPTIMIZING RAW OPT"
-              when verbose $ writeFileD "out/out.rawopt" (show opt)
-              return opt
-
-      ----- STACK ----------------------------------------
-      let stack = Raw2Stack.rawProg2Stack rawopt
-      when verbose $ printSep "GENARTING STACK"
-      when verbose $ writeFileD "out/out.stack" (show stack)
-      let stackjs = Stack2JS.irProg2JSString compileMode debugOut stack
-      let jsFile = outFile flags (fromJust fname)
-      writeFile jsFile stackjs
-
-
-      case exports of
-        Nothing -> return ()
-        Just es -> writeExports jsFile es
-      when verbose printHr
-
-      exitSuccess
-
-
-
+    -- let tokens = parseTokens input
+    -- debugTokens tokens
+    let ast = parseProg input
+
+    let compileMode =
+            if elem LibMode flags
+                then Export
+                else Normal
+
+    let verbose = Verbose `elem` flags
+        noRawOpt = NoRawOpt `elem` flags
+
+    case ast of
+        Left err -> do
+            -- putStrLn ("Tokens: " ++ show tokens)
+            die $ "Parse Error:\n" ++ err
+        Right prog_parsed -> do
+            let prog_empty_imports =
+                    case compileMode of
+                        Normal -> addAmbientMethods prog_parsed
+                        Export -> prog_parsed
+            prog <- processImports prog_empty_imports
+
+            exports <- case compileMode of
+                Normal -> return Nothing
+                Export -> case runExcept (extractExports prog) of
+                    Right es -> return (Just (es))
+                    Left s -> die s
+
+            when verbose $ do
+                printSep "SYNTAX"
+                putStrLn (showIndent 2 prog)
+
+            --------------------------------------------------
+            prog' <- case runExcept (C.trans compileMode (AF.visitProg prog)) of
+                Right p -> return p
+                Left s -> die s
+            when verbose $ do
+                printSep "PATTERN MATCH ELIMINATION"
+                writeFileD "out/out.nopats" (showIndent 2 prog')
+            --------------------------------------------------
+            let lowered = Core.lowerProg prog'
+            when verbose $ do
+                printSep "LOWERING FUNS AND LETS"
+                writeFileD "out/out.lowered" (showIndent 2 lowered)
+            --------------------------------------------------
+            let renamed = Core.renameProg lowered
+            when verbose $ do
+                printSep "α RENAMING"
+                writeFileD "out/out.alpha" (showIndent 2 renamed)
+            --------------------------------------------------
+            let cpsed = RetDFCPS.transProg renamed
+            when verbose $ do
+                printSep "CPSED"
+                writeFileD "out/out.cps" (showIndent 2 cpsed)
+            --------------------------------------------------
+            let rwcps = CPSOpt.rewrite cpsed -- Rewrite.rewrite cpsed
+            when verbose $ do
+                printSep "REWRITING CPS"
+                writeFileD "out/out.cpsopt" (showIndent 2 rwcps)
+            --------------------------------------------------
+            ir <- case runExcept (CC.closureConvert compileMode rwcps) of
+                Right ir -> return ir
+                Left s -> die $ "troupec: " ++ s
+
+            when verbose $ writeFileD "out/out.ir" (show ir)
+
+            let iropt = IROpt.iropt ir
+            when verbose $ writeFileD "out/out.iropt" (show iropt)
+
+            --------------------------------------------------
+            let debugOut = elem Debug flags
+
+            ------ RAW -----------------------------------------
+            let raw = IR2Raw.prog2raw iropt
+            when verbose $ printSep "GENERATING RAW"
+            when verbose $ writeFileD "out/out.rawout" (show raw)
+
+            ----- RAW OPT --------------------------------------
+
+            rawopt <- do
+                if noRawOpt
+                    then return raw
+                    else do
+                        let opt = RawOpt.rawopt raw
+                        when verbose $ printSep "OPTIMIZING RAW OPT"
+                        when verbose $ writeFileD "out/out.rawopt" (show opt)
+                        return opt
+
+            ----- STACK ----------------------------------------
+            let stack = Raw2Stack.rawProg2Stack rawopt
+            when verbose $ printSep "GENARTING STACK"
+            when verbose $ writeFileD "out/out.stack" (show stack)
+            let stackjs = Stack2JS.irProg2JSString compileMode debugOut stack
+            let jsFile = outFile flags (fromJust fname)
+            writeFile jsFile stackjs
+
+            case exports of
+                Nothing -> return ()
+                Just es -> writeExports jsFile es
+            when verbose printHr
+
+            exitSuccess
 
 writeExports jsF exports =
-  let exF' = if takeExtension jsF == ".js" then dropExtension jsF else jsF
-  in writeFileD (exF' ++ ".exports") (intercalate "\n" exports)
-
-
+    let exF' = if takeExtension jsF == ".js" then dropExtension jsF else jsF
+     in writeFileD (exF' ++ ".exports") (intercalate "\n" exports)
 
 defaultName f =
-   let ext = ".trp"
-   in concat [ takeDirectory f
-             ,  "/out/"
-             , if takeExtension f == ext then takeBaseName f else takeFileName f
-             ]
-
+    let ext = ".trp"
+     in concat
+            [ takeDirectory f
+            , "/out/"
+            , if takeExtension f == ext then takeBaseName f else takeFileName f
+            ]
 
 isOutFlag (OutputFile _) = True
 isOutFlag _ = False
 
 outFile :: [Flag] -> String -> String
 outFile flags fname | LibMode `elem` flags =
-                        case List.find isOutFlag flags of
-                          Just (OutputFile s) -> s
-                          _ -> defaultName fname ++ ".js"
+    case List.find isOutFlag flags of
+        Just (OutputFile s) -> s
+        _ -> defaultName fname ++ ".js"
 outFile flags _ =
-  case List.find isOutFlag flags of
-    Just (OutputFile s) -> s
-    _ -> "out/out.stack.js"
-
+    case List.find isOutFlag flags of
+        Just (OutputFile s) -> s
+        _ -> "out/out.stack.js"
 
 -- AA: 2018-07-15: consider timestamping these entries
 debugOut s =
-  appendFile "/tmp/debug" (s ++ "\n")
-
+    appendFile "/tmp/debug" (s ++ "\n")
 
 fromStdinIR = do
-  eof <- isEOF
-  if eof then exitSuccess else do
-    input <- BS.getLine
-    if BS.isPrefixOf "!ECHO " input
-    then let response = BS.drop 6 input
-          in do BSChar8.putStrLn response
---                  debugOut "echo"
-    else
-      case decode input of
-        Right bs ->
-           case CCIR.deserialize bs
-              of Right x -> do putStrLn (IR2JS.irToJSString x)
---                                 debugOut "deserialization OK"
-
-                 Left s -> do putStrLn "ERROR in deserialization"
-                              debugOut $ "deserialization error" ++ s
-        Left s -> do putStrLn "ERROR in B64 decoding"
-                     debugOut $ "decoding error" ++s
-    putStrLn "" -- magic marker to be recognized by the JS runtime; 2018-03-04; aa
-    hFlush stdout
-    fromStdinIR
-
+    eof <- isEOF
+    if eof
+        then exitSuccess
+        else do
+            input <- BS.getLine
+            if BS.isPrefixOf "!ECHO " input
+                then
+                    let response = BS.drop 6 input
+                     in do BSChar8.putStrLn response
+                --                  debugOut "echo"
+                else case decode input of
+                    Right bs ->
+                        case CCIR.deserialize bs of
+                            Right x -> do putStrLn (IR2JS.irToJSString x)
+                            --                                 debugOut "deserialization OK"
+
+                            Left s -> do
+                                putStrLn "ERROR in deserialization"
+                                debugOut $ "deserialization error" ++ s
+                    Left s -> do
+                        putStrLn "ERROR in B64 decoding"
+                        debugOut $ "decoding error" ++ s
+            putStrLn "" -- magic marker to be recognized by the JS runtime; 2018-03-04; aa
+            hFlush stdout
+            fromStdinIR
 
 fromStdinIRJson = do
-  eof <- isEOF
-  if eof then exitSuccess else do
-    input <- BS.getLine
-    if BS.isPrefixOf "!ECHO " input
-    then let response = BS.drop 6 input
-          in BSChar8.putStrLn response
-    else
-      case decode input of
-        Right bs ->
-           case CCIR.deserialize bs
-              of Right x -> BSLazyChar8.putStrLn (IR2JS.irToJSON x)
-                 Left s -> do putStrLn "ERROR in deserialization"
-                              debugOut $ "deserialization error" ++ s
-        Left s -> do putStrLn "ERROR in B64 decoding"
-                     debugOut $ "decoding error" ++s
-    putStrLn "" -- magic marker to be recognized by the JS runtime; 2018-03-04; aa
-    hFlush stdout
-    fromStdinIRJson
+    eof <- isEOF
+    if eof
+        then exitSuccess
+        else do
+            input <- BS.getLine
+            if BS.isPrefixOf "!ECHO " input
+                then
+                    let response = BS.drop 6 input
+                     in BSChar8.putStrLn response
+                else case decode input of
+                    Right bs ->
+                        case CCIR.deserialize bs of
+                            Right x -> BSLazyChar8.putStrLn (IR2JS.irToJSON x)
+                            Left s -> do
+                                putStrLn "ERROR in deserialization"
+                                debugOut $ "deserialization error" ++ s
+                    Left s -> do
+                        putStrLn "ERROR in B64 decoding"
+                        debugOut $ "decoding error" ++ s
+            putStrLn "" -- magic marker to be recognized by the JS runtime; 2018-03-04; aa
+            hFlush stdout
+            fromStdinIRJson
 
 main :: IO ExitCode
 main = do
-  args <- getArgs
-  case getOpt Permute options args of
-
--- AA: 2018-07-15: disabling REPL as it is pretty useless for now
---    ([],[],[]) -> repl
-
-    ([Help], [], []) -> do
-      putStrLn compilerUsage
-      exitSuccess
-
-    ([JSONIRMode], [], []) -> fromStdinIRJson   
-
-    ([IRMode], [], []) -> do
-      fromStdinIR
-      -- hSetBuffering stdout NoBuffering
-
-    (o, [file], []) | optionsOK o ->
-      fromFile o file
-
-
-    (_,_, errs) -> die $ concat errs ++ compilerUsage
- where
-   compilerUsage = usageInfo header options
-     where header = "Usage: <compiler> [OPTION...] file"
-
-
-   -- Check options for consistency
-   optionsOK :: [Flag] -> Bool
-   optionsOK o | length o >=2 =
-                -- certain options must not be combined
-                not.or $ map (`elem` o) [IRMode, Help]
-   optionsOK _ = True
-
-
+    args <- getArgs
+    case getOpt Permute options args of
+        -- AA: 2018-07-15: disabling REPL as it is pretty useless for now
+        --    ([],[],[]) -> repl
+
+        ([Help], [], []) -> do
+            putStrLn compilerUsage
+            exitSuccess
+        ([JSONIRMode], [], []) -> fromStdinIRJson
+        ([IRMode], [], []) -> do
+            fromStdinIR
+        -- hSetBuffering stdout NoBuffering
+
+        (o, [file], [])
+            | optionsOK o ->
+                fromFile o file
+        (_, _, errs) -> die $ concat errs ++ compilerUsage
+  where
+    compilerUsage = usageInfo header options
+      where
+        header = "Usage: <compiler> [OPTION...] file"
+
+    -- Check options for consistency
+    optionsOK :: [Flag] -> Bool
+    optionsOK o
+        | length o >= 2 =
+            -- certain options must not be combined
+            not . or $ map (`elem` o) [IRMode, Help]
+    optionsOK _ = True
 
 fromFile :: [Flag] -> String -> IO ExitCode
 fromFile flags fname = do
-  input <- readFile fname
-  process flags (Just fname) input
-
+    input <- readFile fname
+    process flags (Just fname) input
 
 -- utility functions for printing things out
 
@@ -307,11 +303,10 @@ hrWidth = 70
 
 printSep :: String -> IO ()
 printSep s = do
-  let prefix = replicate 5 '-'
-      suffix = replicate (hrWidth - length s - 5 - 2) '-'
-      s' = prefix ++ " " ++ s ++ " " ++ suffix
-  putStrLn s'
-
+    let prefix = replicate 5 '-'
+        suffix = replicate (hrWidth - length s - 5 - 2) '-'
+        s' = prefix ++ " " ++ s ++ " " ++ suffix
+    putStrLn s'
 
 printHr :: IO ()
 printHr = putStrLn (replicate hrWidth '-')
diff --git a/compiler/dev-test/DCTest.hs b/compiler/dev-test/DCTest.hs
index 0aaba181..d2106839 100644
--- a/compiler/dev-test/DCTest.hs
+++ b/compiler/dev-test/DCTest.hs
@@ -1,6 +1,7 @@
 -- A standalone executable for testing the dc label and other integrity
 -- related components of Troupe 2, 2025-05-13
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
 {-# HLINT ignore "Redundant bracket" #-}
 
 import DCLabels
@@ -11,18 +12,14 @@ import DCLabels
 t = TagExp
 
 labexp01 :: LabelExp
-labexp01 = (t "alice") \/  ( (t "bob") /\ t "dorothy" ) \/ (t "charlie")
+labexp01 = (t "alice") \/ ((t "bob") /\ t "dorothy") \/ (t "charlie")
 labexp02 = (t "alice") /\ (t "bob") /\ (t "charlie")
 labexp03 = (t "alice") /\ ((t "bob") \/ (t "charlie"))
 
-
-
-
-
 main = do
-  print (labexp01)
-  print (labelExpToCNF labexp01)
-  print (labexp02)
-  print (labelExpToCNF labexp02)
-  print (labexp03)
-  print (labelExpToCNF labexp03)
\ No newline at end of file
+    print (labexp01)
+    print (labelExpToCNF labexp01)
+    print (labexp02)
+    print (labelExpToCNF labexp02)
+    print (labexp03)
+    print (labelExpToCNF labexp03)
diff --git a/compiler/fourmolu.yaml b/compiler/fourmolu.yaml
new file mode 100644
index 00000000..76c87aca
--- /dev/null
+++ b/compiler/fourmolu.yaml
@@ -0,0 +1,75 @@
+# Number of spaces per indentation step
+indentation: 4
+
+# Max line length for automatic line breaking
+column-limit: none
+
+# Styling of arrows in type signatures (choices: trailing, leading, or leading-args)
+function-arrows: trailing
+
+# How to place commas in multi-line lists, records, etc. (choices: leading or trailing)
+comma-style: leading
+
+# Styling of import/export lists (choices: leading, trailing, or diff-friendly)
+import-export-style: diff-friendly
+
+# Rules for grouping import declarations
+import-grouping: legacy
+
+# Whether to full-indent or half-indent 'where' bindings past the preceding body
+indent-wheres: false
+
+# Whether to leave a space before an opening record brace
+record-brace-space: false
+
+# Number of spaces between top-level declarations
+newlines-between-decls: 1
+
+# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact)
+haddock-style: multi-line
+
+# How to print module docstring
+haddock-style-module: null
+
+# Styling of let blocks (choices: auto, inline, newline, or mixed)
+let-style: inline
+
+# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space)
+in-style: right-align
+
+# Whether keywords then and else should be indented or hanging off the current indentation.
+if-style: hanging
+
+# Whether to put parentheses around a single constraint (choices: auto, always, or never)
+single-constraint-parens: always
+
+# Whether to put parentheses around a single deriving class (choices: auto, always, or never)
+single-deriving-parens: always
+
+# Whether to sort constraints
+sort-constraints: true
+
+# Whether to sort derived classes
+sort-derived-classes: true
+
+# Whether to sort deriving clauses
+sort-deriving-clauses: true
+
+# Whether to place section operators (those that are infixr 0, such as $) in trailing position, continuing the expression indented below
+trailing-section-operators: true
+
+# Output Unicode syntax (choices: detect, always, or never)
+unicode: never
+
+# Give the programmer more choice on where to insert blank lines
+respectful: true
+
+# Fixity information for operators
+fixities: []
+
+# Module reexports Fourmolu should know about
+reexports: []
+
+# Modules defined by the current Cabal package for import grouping
+local-modules: []
+
diff --git a/compiler/irtester/IRExamples.hs b/compiler/irtester/IRExamples.hs
index 89b414d2..fad41ce8 100644
--- a/compiler/irtester/IRExamples.hs
+++ b/compiler/irtester/IRExamples.hs
@@ -1,12 +1,10 @@
-module IRExamples where 
+module IRExamples where
 
--- import IR 
+-- import IR
 
+{-- 2018-12-20: AA
 
-{-- 2018-12-20: AA 
-
-The idea is that here we just put together a few example IR programs (just constructed 
-directly using the AST) and then test running them. 
+The idea is that here we just put together a few example IR programs (just constructed
+directly using the AST) and then test running them.
 
 --}
-
diff --git a/compiler/irtester/Main.hs b/compiler/irtester/Main.hs
index c86c68f7..03005b59 100644
--- a/compiler/irtester/Main.hs
+++ b/compiler/irtester/Main.hs
@@ -1,5 +1,5 @@
-module Main(main) where 
+module Main (main) where
 
 import IRExamples
 
-main = putStrLn "Not implemented"
\ No newline at end of file
+main = putStrLn "Not implemented"
diff --git a/compiler/src/AddAmbientMethods.hs b/compiler/src/AddAmbientMethods.hs
index a88d67ac..511eb22b 100644
--- a/compiler/src/AddAmbientMethods.hs
+++ b/compiler/src/AddAmbientMethods.hs
@@ -1,47 +1,56 @@
 -- 2020-05-17, AA
 
 -- HACK
--- This module add a number of standard 
--- ambient methods such as `print` to the 
+-- This module add a number of standard
+-- ambient methods such as `print` to the
 -- beginning of the file. This provides some
 -- backward compatibility with prior test cases
 -- as well as minimizes some clutter
 
--- If these methods are unused they are 
--- eliminated by the optimization passes in 
+-- If these methods are unused they are
+-- eliminated by the optimization passes in
 -- the further passes.
 
-module AddAmbientMethods(addAmbientMethods) where 
+module AddAmbientMethods (addAmbientMethods) where
 
 import Basics
-import Direct  
+import Direct
 import TroupePositionInfo
 
-printDecl :: FunDecl 
-printDecl = FunDecl "print"  
-    [Lambda [VarPattern "x"] $
-        Let [ValDecl (VarPattern "out") (App (Var "getStdout") [Var "authority"]) NoPos]
-            (App (Var "fprintln") [Tuple [Var "out", Var "x"]])
-    ] NoPos
-
-printWithLabelsDecl :: FunDecl 
-printWithLabelsDecl = FunDecl "printWithLabels" 
-    [Lambda [VarPattern "x"] $
-        Let [ValDecl (VarPattern "out") (App (Var "getStdout") [Var "authority"]) NoPos]
-            (App (Var "fprintlnWithLabels") [Tuple [Var "out", Var "x"]])
-    ] NoPos
-
-
-printStringDecl :: FunDecl 
-printStringDecl = FunDecl "printString"
-    [Lambda [VarPattern "x"] $
-        Let [ValDecl (VarPattern "out") (App (Var "getStdout") [Var "authority"]) NoPos]
-            (App (Var "fwrite") [Tuple [Var "out", Bin Concat (Var "x") (Lit (LString "\\n"))]])
-    ] NoPos
-
-
-
-addAmbientMethods :: Prog -> Prog 
-addAmbientMethods (Prog imports atoms t) = 
-    let t' = Let [FunDecs [printDecl,printWithLabelsDecl,printStringDecl]] t
-    in Prog imports atoms t'
\ No newline at end of file
+printDecl :: FunDecl
+printDecl =
+    FunDecl
+        "print"
+        [ Lambda [VarPattern "x"] $
+            Let
+                [ValDecl (VarPattern "out") (App (Var "getStdout") [Var "authority"]) NoPos]
+                (App (Var "fprintln") [Tuple [Var "out", Var "x"]])
+        ]
+        NoPos
+
+printWithLabelsDecl :: FunDecl
+printWithLabelsDecl =
+    FunDecl
+        "printWithLabels"
+        [ Lambda [VarPattern "x"] $
+            Let
+                [ValDecl (VarPattern "out") (App (Var "getStdout") [Var "authority"]) NoPos]
+                (App (Var "fprintlnWithLabels") [Tuple [Var "out", Var "x"]])
+        ]
+        NoPos
+
+printStringDecl :: FunDecl
+printStringDecl =
+    FunDecl
+        "printString"
+        [ Lambda [VarPattern "x"] $
+            Let
+                [ValDecl (VarPattern "out") (App (Var "getStdout") [Var "authority"]) NoPos]
+                (App (Var "fwrite") [Tuple [Var "out", Bin Concat (Var "x") (Lit (LString "\\n"))]])
+        ]
+        NoPos
+
+addAmbientMethods :: Prog -> Prog
+addAmbientMethods (Prog imports atoms t) =
+    let t' = Let [FunDecs [printDecl, printWithLabelsDecl, printStringDecl]] t
+     in Prog imports atoms t'
diff --git a/compiler/src/AtomFolding.hs b/compiler/src/AtomFolding.hs
index 1aad7ba8..29dd7e3a 100644
--- a/compiler/src/AtomFolding.hs
+++ b/compiler/src/AtomFolding.hs
@@ -1,73 +1,78 @@
-module AtomFolding ( visitProg )
+module AtomFolding (visitProg)
 where
+
 import Basics
-import Direct
-import Data.Maybe
 import Control.Monad
+import Data.Maybe
+import Direct
 
 visitProg :: Prog -> Prog
 visitProg (Prog imports (Atoms atms) tm) =
-  Prog imports (Atoms atms) (visitTerm atms tm)
+    Prog imports (Atoms atms) (visitTerm atms tm)
 
 visitTerm :: [AtomName] -> Term -> Term
 visitTerm atms (Lit lit) = Lit lit
 visitTerm atms (Var nm) =
-  if (elem nm atms)
-  then Lit (LAtom nm)
-  else Var nm
+    if (elem nm atms)
+        then Lit (LAtom nm)
+        else Var nm
 visitTerm atms (Abs lam) =
-  Abs (visitLambda atms lam)
+    Abs (visitLambda atms lam)
 visitTerm atms (Hnd (Handler pat maybePat maybeTerm term)) =
-  Hnd (Handler (visitPattern atms pat)
-       (liftM (visitPattern atms) maybePat)
-       (liftM (visitTerm atms) maybeTerm)
-       (visitTerm atms term))
+    Hnd
+        ( Handler
+            (visitPattern atms pat)
+            (liftM (visitPattern atms) maybePat)
+            (liftM (visitTerm atms) maybeTerm)
+            (visitTerm atms term)
+        )
 visitTerm atms (App t1 ts) =
-  App (visitTerm atms t1) (map (visitTerm atms) ts)
+    App (visitTerm atms t1) (map (visitTerm atms) ts)
 visitTerm atms (Let decls term) =
-  Let (map visitDecl decls) (visitTerm atms term)
+    Let (map visitDecl decls) (visitTerm atms term)
   where
     visitDecl (ValDecl pat t pos) = ValDecl (visitPattern atms pat) (visitTerm atms t) pos
     visitDecl (FunDecs decs) =
-      FunDecs (map (\(FunDecl nm lams pos) -> (FunDecl nm (map (visitLambda atms) lams) pos)) decs)
+        FunDecs (map (\(FunDecl nm lams pos) -> (FunDecl nm (map (visitLambda atms) lams) pos)) decs)
 visitTerm atms (Case t declTermList p) =
-  Case (visitTerm atms t)
-  (map (\(pat, term) -> ((visitPattern atms pat), (visitTerm atms term))) declTermList)
-  p
+    Case
+        (visitTerm atms t)
+        (map (\(pat, term) -> ((visitPattern atms pat), (visitTerm atms term))) declTermList)
+        p
 visitTerm atms (If t1 t2 t3) =
-  If (visitTerm atms t1) (visitTerm atms t2) (visitTerm atms t3)
+    If (visitTerm atms t1) (visitTerm atms t2) (visitTerm atms t3)
 visitTerm atms (Tuple terms) =
-  Tuple (map (visitTerm atms) terms)
-visitTerm atms (Record fields) =  Record (visitFields atms fields)    
-visitTerm atms (WithRecord e fields) = 
+    Tuple (map (visitTerm atms) terms)
+visitTerm atms (Record fields) = Record (visitFields atms fields)
+visitTerm atms (WithRecord e fields) =
     WithRecord (visitTerm atms e) (visitFields atms fields)
 visitTerm atms (ProjField t f) =
     ProjField (visitTerm atms t) f
 visitTerm atms (ProjIdx t idx) =
     ProjIdx (visitTerm atms t) idx
 visitTerm atms (List terms) =
-  List (map (visitTerm atms) terms)
+    List (map (visitTerm atms) terms)
 visitTerm atms (ListCons t1 t2) =
-  ListCons (visitTerm atms t1) (visitTerm atms t2)
+    ListCons (visitTerm atms t1) (visitTerm atms t2)
 visitTerm atms (Bin op t1 t2) =
-  Bin op (visitTerm atms t1) (visitTerm atms t2)
+    Bin op (visitTerm atms t1) (visitTerm atms t2)
 visitTerm atms (Un op t) =
-  Un op (visitTerm atms t)
-visitTerm atms (Seq ts)   = 
-  Seq $ map (visitTerm atms) ts
+    Un op (visitTerm atms t)
+visitTerm atms (Seq ts) =
+    Seq $ map (visitTerm atms) ts
 visitTerm atms (Error t) =
-  Error (visitTerm atms t)
-
+    Error (visitTerm atms t)
 
-visitFields atms fs  =  map visitField fs   
-    where visitField (f, Nothing) = (f, Nothing) 
-          visitField (f, Just t) = (f, Just (visitTerm atms t))
+visitFields atms fs = map visitField fs
+  where
+    visitField (f, Nothing) = (f, Nothing)
+    visitField (f, Just t) = (f, Just (visitTerm atms t))
 
 visitPattern :: [AtomName] -> DeclPattern -> DeclPattern
 visitPattern atms pat@(VarPattern nm) =
-  if (elem nm atms)
-  then ValPattern (LAtom nm)
-  else pat
+    if (elem nm atms)
+        then ValPattern (LAtom nm)
+        else pat
 visitPattern _ pat@(ValPattern _) = pat
 visitPattern atms (AtPattern p l) = AtPattern (visitPattern atms p) l
 visitPattern _ pat@Wildcard = pat
@@ -75,9 +80,10 @@ visitPattern atms (TuplePattern pats) = TuplePattern (map (visitPattern atms) pa
 visitPattern atms (ConsPattern p1 p2) = ConsPattern (visitPattern atms p1) (visitPattern atms p2)
 visitPattern atms (ListPattern pats) = ListPattern (map (visitPattern atms) pats)
 visitPattern atms (RecordPattern fields mode) = RecordPattern (map visitField fields) mode
-      where visitField pat@(_, Nothing) = pat 
-            visitField (f, Just p) = (f, Just (visitPattern atms p))
+  where
+    visitField pat@(_, Nothing) = pat
+    visitField (f, Just p) = (f, Just (visitPattern atms p))
 
 visitLambda :: [AtomName] -> Lambda -> Lambda
 visitLambda atms (Lambda pats term) =
-  (Lambda (map (visitPattern atms) pats) (visitTerm atms term))
+    (Lambda (map (visitPattern atms) pats) (visitTerm atms term))
diff --git a/compiler/src/Basics.hs b/compiler/src/Basics.hs
index 622e31a0..67ee71c2 100644
--- a/compiler/src/Basics.hs
+++ b/compiler/src/Basics.hs
@@ -1,121 +1,109 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
 
 module Basics
 where
 
-import GHC.Generics(Generic)
 import Data.Serialize (Serialize)
+import GHC.Generics (Generic)
 
 type VarName = String
 type AtomName = String
 type FieldName = String
 
 -- | Eq and Neq: deep equality check on the two parameters, including the types (any type inequality results in false being returned).
-data BinOp = Plus | Minus | Mult | Div | Mod |  Eq | Neq | Le | Lt | Ge | Gt | And | Or | RaisedTo | FlowsTo | Concat| IntDiv | BinAnd | BinOr | BinXor | BinShiftLeft | BinShiftRight | BinZeroShiftRight | HasField | LatticeJoin | LatticeMeet
-  deriving (Eq,Generic, Ord)
+data BinOp = Plus | Minus | Mult | Div | Mod | Eq | Neq | Le | Lt | Ge | Gt | And | Or | RaisedTo | FlowsTo | Concat | IntDiv | BinAnd | BinOr | BinXor | BinShiftLeft | BinShiftRight | BinZeroShiftRight | HasField | LatticeJoin | LatticeMeet
+    deriving (Eq, Generic, Ord)
+
 instance Serialize BinOp
 data UnaryOp = IsList | IsTuple | IsRecord | Head | Tail | Fst | Snd | ListLength | TupleLength | RecordSize | LevelOf | UnMinus
-  deriving (Eq, Generic, Ord)
+    deriving (Eq, Generic, Ord)
 instance Serialize UnaryOp
 
 instance Show BinOp where
-  show Plus  = "+"
-  show Minus = "-"
-  show Mult  = "*"
-  show Div   = "/"
-  show IntDiv = "div"
-  show Mod   = "mod"
-  show Eq    = "="
-  show Neq   = "<>"
-  show Le    = "<="
-  show Lt    = "<"
-  show Ge    = ">="
-  show Gt    = ">"  
-  show And   = "&&"
-  show Or    = "||"
-  show RaisedTo = "raisedTo"
-  show FlowsTo  = "flowsTo"
-  show Concat   = "^"
-  show BinAnd = "andb" 
-  show BinOr =  "orb" 
-  show BinXor = "xorb" 
-  show BinShiftLeft = "<<"
-  show BinShiftRight = ">>" 
-  show BinZeroShiftRight = "~>>"
-  show HasField = "hasField"
-  show LatticeJoin = "join"
-  show LatticeMeet = "meet"
+    show Plus = "+"
+    show Minus = "-"
+    show Mult = "*"
+    show Div = "/"
+    show IntDiv = "div"
+    show Mod = "mod"
+    show Eq = "="
+    show Neq = "<>"
+    show Le = "<="
+    show Lt = "<"
+    show Ge = ">="
+    show Gt = ">"
+    show And = "&&"
+    show Or = "||"
+    show RaisedTo = "raisedTo"
+    show FlowsTo = "flowsTo"
+    show Concat = "^"
+    show BinAnd = "andb"
+    show BinOr = "orb"
+    show BinXor = "xorb"
+    show BinShiftLeft = "<<"
+    show BinShiftRight = ">>"
+    show BinZeroShiftRight = "~>>"
+    show HasField = "hasField"
+    show LatticeJoin = "join"
+    show LatticeMeet = "meet"
 
 instance Show UnaryOp where
-  show IsList = "is-list"
-  show IsTuple = "is-tuple"
-  show Head = "list-head"
-  show Tail = "list-tail"
-  show Fst = "fst"
-  show Snd = "snd"
-  show ListLength = "list-length"
-  show TupleLength = "tuple-length"
-  show RecordSize = "record-size"
-  show LevelOf = "levelOf"
-  show UnMinus = "un-minus"
-  show IsRecord = "is-record"
-
+    show IsList = "is-list"
+    show IsTuple = "is-tuple"
+    show Head = "list-head"
+    show Tail = "list-tail"
+    show Fst = "fst"
+    show Snd = "snd"
+    show ListLength = "list-length"
+    show TupleLength = "tuple-length"
+    show RecordSize = "record-size"
+    show LevelOf = "levelOf"
+    show UnMinus = "un-minus"
+    show IsRecord = "is-record"
 
 type Precedence = Integer
 
 opPrec :: BinOp -> Precedence
-
 opPrec LatticeJoin = 300
 opPrec LatticeMeet = 300
-
-opPrec Mult   = 200
+opPrec Mult = 200
 opPrec IntDiv = 200
-opPrec Div    = 200
-opPrec Mod    = 200
-
-opPrec Plus   = 100
-opPrec Minus  = 100
+opPrec Div = 200
+opPrec Mod = 200
+opPrec Plus = 100
+opPrec Minus = 100
 opPrec Concat = 100
-
-opPrec BinShiftLeft      = 70
-opPrec BinShiftRight     = 70
+opPrec BinShiftLeft = 70
+opPrec BinShiftRight = 70
 opPrec BinZeroShiftRight = 70
-
 opPrec BinAnd = 60
-opPrec BinOr  = 60
+opPrec BinOr = 60
 opPrec BinXor = 60
-
-opPrec Eq    = 50
-opPrec Neq   = 50
-opPrec Le    = 50
-opPrec Lt    = 50
-opPrec Ge    = 50
-opPrec Gt    = 50
-opPrec And   = 50
-opPrec Or    = 50
-opPrec FlowsTo    = 50
-opPrec RaisedTo   = 50
-opPrec HasField   = 50
-
-newtype LibName = LibName String deriving (Eq, Show, Generic, Ord)
+opPrec Eq = 50
+opPrec Neq = 50
+opPrec Le = 50
+opPrec Lt = 50
+opPrec Ge = 50
+opPrec Gt = 50
+opPrec And = 50
+opPrec Or = 50
+opPrec FlowsTo = 50
+opPrec RaisedTo = 50
+opPrec HasField = 50
+
+newtype LibName = LibName String deriving (Eq, Generic, Ord, Show)
 instance Serialize LibName
 
-
-
 -- 2018-07-02; AA: note on the data structure that we use for imports:
 -- For each `import` declaration, the parser returns the name of the
 -- library that is imported together with a Nothing value. After
 -- parsing we produce a version where we replace the Nothing value
 -- with the list of names that are exported from the library.
 
-
 data Imports = Imports [(LibName, Maybe [VarName])]
-  deriving (Eq, Show, Ord)
-
-
-
+    deriving (Eq, Ord, Show)
 
 op1Prec :: UnaryOp -> Precedence
 op1Prec x = 50
@@ -132,5 +120,5 @@ maxPrec = 100000
 consPrec :: Precedence
 consPrec = 6000
 
-projPrec :: Precedence 
+projPrec :: Precedence
 projPrec = 6100
diff --git a/compiler/src/CPSOpt.hs b/compiler/src/CPSOpt.hs
index de68c0d8..e1731d8a 100644
--- a/compiler/src/CPSOpt.hs
+++ b/compiler/src/CPSOpt.hs
@@ -1,37 +1,37 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
 {-- Obs: 2018-02-16: beacuse of the RetCPS representation, we currently
 have very few rewrites that actually kick-in; we should be able to
 rectify them with some more work, but that's postponed for now; AA
 --}
 
-
 module CPSOpt (rewrite) where
 
 -- todo: consider renaming this to CPSRewrite
 
-import Debug.Trace
 import qualified Basics
-import RetCPS as CPS
-import qualified Core as C
 import Control.Monad.RWS
+import Control.Monad.Reader
 import Control.Monad.State
 import Control.Monad.Writer
-import Control.Monad.Reader
+import qualified Core as C
 import Data.List
+import Debug.Trace
+import RetCPS as CPS
 
-import Data.Map.Lazy(Map)
+import Data.Map.Lazy (Map)
 
 import qualified Data.Map.Lazy as Map
 
-import Control.Monad.Trans.Maybe
 import Control.Monad.Identity ()
+import Control.Monad.Trans.Maybe
 
 import Data.Set (Set)
 
-import qualified Data.List 
-import qualified Data.Maybe 
+import qualified Data.List
+import qualified Data.Maybe
 
 import qualified Data.Set as Set
 import RetFreeVars as FreeVars
@@ -43,507 +43,487 @@ import TroupePositionInfo
 -- In Troupe, record field semantics follow "last assignment wins" (e.g., {x=100, x=200}.x should return 200),
 -- but Haskell's standard 'lookup' returns the first match. This function ensures we get the last match
 -- by reversing the list before lookup, which gives us the rightmost (last) field value.
-lookupLast :: Eq a => a -> [(a, b)] -> Maybe b
+lookupLast :: (Eq a) => a -> [(a, b)] -> Maybe b
 lookupLast key pairs = lookup key (reverse pairs)
 
-
-
 newtype Subst = Subst (Map VarName VarName)
 
 class Substitutable a where
-  apply :: Subst -> a -> a
+    apply :: Subst -> a -> a
 
 idSubst :: Subst
 idSubst = Subst (Map.empty)
 
 instance Substitutable KLambda where
-  apply subst@(Subst varmap) kl =
-    case kl of
-      Unary vn kt ->
-        let subst' = Subst (Map.delete vn varmap)
-        in  Unary vn (apply subst' kt)
-      Nullary kt ->
-        let subst' = Subst (varmap)
-        in Nullary (apply subst' kt)
-
+    apply subst@(Subst varmap) kl =
+        case kl of
+            Unary vn kt ->
+                let subst' = Subst (Map.delete vn varmap)
+                 in Unary vn (apply subst' kt)
+            Nullary kt ->
+                let subst' = Subst (varmap)
+                 in Nullary (apply subst' kt)
 
 instance Substitutable SVal where
-  apply _ (Lit lit) = Lit lit
-  apply subst (KAbs klambda) = KAbs (apply subst klambda)
-
+    apply _ (Lit lit) = Lit lit
+    apply subst (KAbs klambda) = KAbs (apply subst klambda)
 
 instance Substitutable SimpleTerm where
-  apply subst@(Subst varmap) simpleTerm =
-    case simpleTerm of
-      Bin op v1 v2 -> Bin op (fwd v1) (fwd v2)
-      Un op v -> Un op (fwd v)
-      Tuple vs -> Tuple (map fwd vs)
-      Record fields -> Record $ fwdFields fields
-      WithRecord x fields -> WithRecord (fwd x) $ fwdFields fields
-      ProjField x f -> ProjField (fwd x) f
-      ProjIdx x idx -> ProjIdx (fwd x) idx
-      List vs -> List (map fwd vs)
-      ListCons v v' -> ListCons (fwd v) (fwd v')
-      ValSimpleTerm sv -> ValSimpleTerm (apply subst sv)
-      Base v -> Base v
-      Lib l v -> Lib l v 
-    where fwd x = Map.findWithDefault x x varmap
-          fwdFields fields = map (\(f, x) -> (f, fwd x)) fields
+    apply subst@(Subst varmap) simpleTerm =
+        case simpleTerm of
+            Bin op v1 v2 -> Bin op (fwd v1) (fwd v2)
+            Un op v -> Un op (fwd v)
+            Tuple vs -> Tuple (map fwd vs)
+            Record fields -> Record $ fwdFields fields
+            WithRecord x fields -> WithRecord (fwd x) $ fwdFields fields
+            ProjField x f -> ProjField (fwd x) f
+            ProjIdx x idx -> ProjIdx (fwd x) idx
+            List vs -> List (map fwd vs)
+            ListCons v v' -> ListCons (fwd v) (fwd v')
+            ValSimpleTerm sv -> ValSimpleTerm (apply subst sv)
+            Base v -> Base v
+            Lib l v -> Lib l v
+      where
+        fwd x = Map.findWithDefault x x varmap
+        fwdFields fields = map (\(f, x) -> (f, fwd x)) fields
 
 instance Substitutable ContDef where
-  apply subst@(Subst varmap) (Cont vn kt) =
-     let subst' = Subst (Map.delete vn varmap)
-     in Cont vn (apply subst' kt)
+    apply subst@(Subst varmap) (Cont vn kt) =
+        let subst' = Subst (Map.delete vn varmap)
+         in Cont vn (apply subst' kt)
 
 instance Substitutable FunDef where
-  apply subst@(Subst varmap) (Fun vn klam) =
-    let subst' = Subst (Map.delete vn varmap)
-    in Fun vn (apply subst' klam)
+    apply subst@(Subst varmap) (Fun vn klam) =
+        let subst' = Subst (Map.delete vn varmap)
+         in Fun vn (apply subst' klam)
 
 instance Substitutable KTerm where
-  apply subst@(Subst varmap) kontTerm =
-    case kontTerm of
-      LetSimple x st kt ->
-        LetSimple (vfwd x) (apply subst st) (apply subst kt)
-      LetRet kdef@(Cont _ _) kt ->
-        let kdef' = apply subst kdef
-            kt'   = apply subst kt
-        in LetRet kdef' kt'
-      LetFun fdefs kt ->
-         let fnames = map (\(Fun v _) -> v) fdefs
-             subst' = Subst ( foldl (\m v -> Map.delete v m) varmap fnames)
-             kt' = apply subst' kt
-             fdefs' = map (apply subst') fdefs
-         in LetFun fdefs' kt'
-      Halt v -> Halt (vfwd v)
-      KontReturn v  -> KontReturn (vfwd v)
-      ApplyFun fn argn -> ApplyFun (vfwd fn) (vfwd argn)
-      If v k1 k2 -> If (vfwd v) (apply subst k1) (apply subst k2)
-      AssertElseError v k1 z p -> AssertElseError (vfwd v) (apply subst k1) (vfwd z) p
-      Error x p -> Error (vfwd x) p
-   where vfwd x = Map.findWithDefault x x varmap
-
+    apply subst@(Subst varmap) kontTerm =
+        case kontTerm of
+            LetSimple x st kt ->
+                LetSimple (vfwd x) (apply subst st) (apply subst kt)
+            LetRet kdef@(Cont _ _) kt ->
+                let kdef' = apply subst kdef
+                    kt' = apply subst kt
+                 in LetRet kdef' kt'
+            LetFun fdefs kt ->
+                let fnames = map (\(Fun v _) -> v) fdefs
+                    subst' = Subst (foldl (\m v -> Map.delete v m) varmap fnames)
+                    kt' = apply subst' kt
+                    fdefs' = map (apply subst') fdefs
+                 in LetFun fdefs' kt'
+            Halt v -> Halt (vfwd v)
+            KontReturn v -> KontReturn (vfwd v)
+            ApplyFun fn argn -> ApplyFun (vfwd fn) (vfwd argn)
+            If v k1 k2 -> If (vfwd v) (apply subst k1) (apply subst k2)
+            AssertElseError v k1 z p -> AssertElseError (vfwd v) (apply subst k1) (vfwd z) p
+            Error x p -> Error (vfwd x) p
+      where
+        vfwd x = Map.findWithDefault x x varmap
 
 type Census = Map VarName Integer
 
-type CensusCollector = State Census 
+type CensusCollector = State Census
 
-class CensusCollectible a 
-  where updateCensus :: a -> CensusCollector ()
+class CensusCollectible a where
+    updateCensus :: a -> CensusCollector ()
 
 incUse :: VarName -> CensusCollector ()
-incUse x = modify $ Map.insertWith (+) x 1 
+incUse x = modify $ Map.insertWith (+) x 1
 
 instance CensusCollectible VarName where
-  updateCensus = incUse 
-
-instance CensusCollectible a => CensusCollectible [a] where 
-  updateCensus = mapM_ updateCensus
-
-instance CensusCollectible SimpleTerm where 
-  updateCensus t = case t of 
-      Bin _ v1 v2 -> updateCensus [v1,v2]
-      Un _ v -> updateCensus v 
-      ValSimpleTerm sv -> updateCensus sv 
-      Tuple vs -> updateCensus vs 
-      Record fs -> let (_,vs) = unzip fs in updateCensus vs 
-      WithRecord v fs -> updateCensus v >> (let (_,vs) = unzip fs in updateCensus vs )
-      ProjField v _ -> updateCensus v
-      ProjIdx v _ -> updateCensus v
-      List vs -> updateCensus vs
-      ListCons v vs -> updateCensus v >> updateCensus vs
-      Base _ -> return () 
-      Lib _ _ -> return ()
-
-instance CensusCollectible KLambda where   
-  updateCensus kl = case kl of 
-      Unary _ kt -> updateCensus kt 
-      Nullary kt -> updateCensus kt 
-
-instance CensusCollectible SVal where 
-  updateCensus sv = case sv of 
-    KAbs kl -> updateCensus kl 
-    Lit _ -> return ()
-
-instance CensusCollectible ContDef where 
-  updateCensus (Cont _ kt) = updateCensus kt 
-
-instance CensusCollectible FunDef where 
-  updateCensus (Fun _ kl) = updateCensus kl 
-
-instance CensusCollectible KTerm where 
-  updateCensus t = case t of 
-    LetSimple _ st kt -> updateCensus st >> updateCensus kt 
-    LetFun fs kt -> updateCensus fs >> updateCensus kt 
-    LetRet ct kt -> updateCensus ct >> updateCensus kt 
-    KontReturn x -> updateCensus x
-    ApplyFun v u -> updateCensus [v,u]
-    If v k1 k2 -> updateCensus v >> updateCensus [k1,k2]
-    AssertElseError v k u _ -> updateCensus [v,u] >> updateCensus k 
-    Error v _ -> updateCensus v 
-    Halt v -> updateCensus v
-
-  
-getCensus :: KTerm -> Census 
+    updateCensus = incUse
+
+instance (CensusCollectible a) => CensusCollectible [a] where
+    updateCensus = mapM_ updateCensus
+
+instance CensusCollectible SimpleTerm where
+    updateCensus t = case t of
+        Bin _ v1 v2 -> updateCensus [v1, v2]
+        Un _ v -> updateCensus v
+        ValSimpleTerm sv -> updateCensus sv
+        Tuple vs -> updateCensus vs
+        Record fs -> let (_, vs) = unzip fs in updateCensus vs
+        WithRecord v fs -> updateCensus v >> (let (_, vs) = unzip fs in updateCensus vs)
+        ProjField v _ -> updateCensus v
+        ProjIdx v _ -> updateCensus v
+        List vs -> updateCensus vs
+        ListCons v vs -> updateCensus v >> updateCensus vs
+        Base _ -> return ()
+        Lib _ _ -> return ()
+
+instance CensusCollectible KLambda where
+    updateCensus kl = case kl of
+        Unary _ kt -> updateCensus kt
+        Nullary kt -> updateCensus kt
+
+instance CensusCollectible SVal where
+    updateCensus sv = case sv of
+        KAbs kl -> updateCensus kl
+        Lit _ -> return ()
+
+instance CensusCollectible ContDef where
+    updateCensus (Cont _ kt) = updateCensus kt
+
+instance CensusCollectible FunDef where
+    updateCensus (Fun _ kl) = updateCensus kl
+
+instance CensusCollectible KTerm where
+    updateCensus t = case t of
+        LetSimple _ st kt -> updateCensus st >> updateCensus kt
+        LetFun fs kt -> updateCensus fs >> updateCensus kt
+        LetRet ct kt -> updateCensus ct >> updateCensus kt
+        KontReturn x -> updateCensus x
+        ApplyFun v u -> updateCensus [v, u]
+        If v k1 k2 -> updateCensus v >> updateCensus [k1, k2]
+        AssertElseError v k u _ -> updateCensus [v, u] >> updateCensus k
+        Error v _ -> updateCensus v
+        Halt v -> updateCensus v
+
+getCensus :: KTerm -> Census
 getCensus k = execState (updateCensus k) Map.empty
 
-
-
 ---------------------------
 
-data Term = St SimpleTerm | Unknown deriving (Eq,Show) 
+data Term = St SimpleTerm | Unknown deriving (Eq, Show)
 type Env = Map VarName Term
 
-
-class BindableDef a where 
-  binddef::a -> Opt () 
-
+class BindableDef a where
+    binddef :: a -> Opt ()
 
 bindenv :: VarName -> Term -> Opt ()
-bindenv x t = 
- modify (\s -> s { __env_of_state = Map.insert x t (__env_of_state s) })
+bindenv x t =
+    modify (\s -> s{__env_of_state = Map.insert x t (__env_of_state s)})
 
--- instance BindableDef FunDef where 
+-- instance BindableDef FunDef where
 --   binddef (Fun v kl) = bindenv v (Fn kl)
 
-instance BindableDef a => BindableDef [a] where 
-  binddef = mapM_ binddef 
+instance (BindableDef a) => BindableDef [a] where
+    binddef = mapM_ binddef
 
 --------------------
 
 type CSEMap = Map SimpleTerm VarName
 
-data OptState = OptState {
-      __env_of_state :: Env
+data OptState = OptState
+    { __env_of_state :: Env
     }
 
-data OptReader = OptReader {
-      __census_of_reader :: Census ,
-      __rewrite_ret_of_reader :: Maybe ContDef ,
-      __cse_map_of_reader :: CSEMap
-    }    
+data OptReader = OptReader
+    { __census_of_reader :: Census
+    , __rewrite_ret_of_reader :: Maybe ContDef
+    , __cse_map_of_reader :: CSEMap
+    }
 
 type Opt = RWS OptReader () OptState
-class Simplifiable a where 
-  simpl :: a -> Opt a
-
-instance Simplifiable a => Simplifiable [a] where 
-  simpl = mapM simpl
-
-instance Simplifiable FunDef where 
-  simpl (Fun arg kl) = simpl kl  >>= return . Fun arg
+class Simplifiable a where
+    simpl :: a -> Opt a
 
-instance Simplifiable ContDef where 
-  simpl (Cont v kt) = simpl kt >>= return . Cont v
-    
-instance Simplifiable KLambda where 
-  simpl (Unary v k) = simpl k >>= return . Unary v 
-  simpl (Nullary k) = simpl k >>= return . Nullary
+instance (Simplifiable a) => Simplifiable [a] where
+    simpl = mapM simpl
 
-look :: VarName -> Opt Term 
-look x = do 
-  m <- __env_of_state <$> get 
-  return $ Map.findWithDefault Unknown
-              -- (error $ "cannot find binding for name" ++ (show x)) 
-              x m
-
-censusInfo :: VarName -> Opt Integer
-censusInfo x = do 
-  census <- __census_of_reader <$> ask 
-  return $ Map.findWithDefault 0 x census
+instance Simplifiable FunDef where
+    simpl (Fun arg kl) = simpl kl >>= return . Fun arg
 
+instance Simplifiable ContDef where
+    simpl (Cont v kt) = simpl kt >>= return . Cont v
 
-fields x = do 
-    w <- look x 
-    case w of 
-      St (Record xs) -> return xs 
-      St (WithRecord y ys) ->  do
-        xs <- fields y 
-        return $ xs ++ ys 
-      _ -> return []
+instance Simplifiable KLambda where
+    simpl (Unary v k) = simpl k >>= return . Unary v
+    simpl (Nullary k) = simpl k >>= return . Nullary
 
+look :: VarName -> Opt Term
+look x = do
+    m <- __env_of_state <$> get
+    return $
+        Map.findWithDefault
+            Unknown
+            -- (error $ "cannot find binding for name" ++ (show x))
+            x
+            m
 
-isRecordTerm (St (Record _)) = True 
-isRecordTerm (St (WithRecord _ _ )) = True 
+censusInfo :: VarName -> Opt Integer
+censusInfo x = do
+    census <- __census_of_reader <$> ask
+    return $ Map.findWithDefault 0 x census
+
+fields x = do
+    w <- look x
+    case w of
+        St (Record xs) -> return xs
+        St (WithRecord y ys) -> do
+            xs <- fields y
+            return $ xs ++ ys
+        _ -> return []
+
+isRecordTerm (St (Record _)) = True
+isRecordTerm (St (WithRecord _ _)) = True
 isRecordTerm _ = False
 
-recordEquiv r1 r2 = do 
-  f1 <- fields r1 
-  f2 <- fields r2 
-  let f1' = sort f1 
-      f2' = sort f2 
-  return (f1' == f2')
-
+recordEquiv r1 r2 = do
+    f1 <- fields r1
+    f2 <- fields r2
+    let f1' = sort f1
+        f2' = sort f2
+    return (f1' == f2')
 
-
-data ResOrSubst a = ResultSimplified a | ResultSubst VarName 
+data ResOrSubst a = ResultSimplified a | ResultSubst VarName
 simplifySimpleTerm :: SimpleTerm -> Opt (ResOrSubst SimpleTerm)
-simplifySimpleTerm t = 
-  let _ret = return. ResultSimplified 
-      _subst = return . ResultSubst 
-      _nochange = _ret t
-  in case t of     
-  Bin op oper1 oper2 -> do 
-    u <- look oper1 
-    v <- look oper2
-    case op of 
-      Basics.HasField -> case v of 
-           St (ValSimpleTerm  (Lit (C.LString s))) -> do 
-             fs <- fields oper1 
-             case lookup s fs of 
-               Just _ -> _ret $ __trueLit 
-               Nothing -> _nochange
-           _ -> _nochange
-
-      -- Basics.Eq | (isLit u && isLit v) -> 
+simplifySimpleTerm t =
+    let _ret = return . ResultSimplified
+        _subst = return . ResultSubst
+        _nochange = _ret t
+     in case t of
+            Bin op oper1 oper2 -> do
+                u <- look oper1
+                v <- look oper2
+                case op of
+                    Basics.HasField -> case v of
+                        St (ValSimpleTerm (Lit (C.LString s))) -> do
+                            fs <- fields oper1
+                            case lookup s fs of
+                                Just _ -> _ret $ __trueLit
+                                Nothing -> _nochange
+                        _ -> _nochange
+                    -- Basics.Eq | (isLit u && isLit v) ->
                     -- _ret $ lit $ C.LBool (litVal u == litVal v) -- slightly more general case
-      Basics.Eq | u == v  && (u /= Unknown) -> _ret $ __trueLit 
-      Basics.Eq | (isLit u && isLit v) -> _ret $ lit $ C.LBool (litVal u == litVal v) 
-      Basics.Eq | isRecordTerm u -> do 
-            e <- recordEquiv oper1 oper2 
-            if e then _ret $ __trueLit 
-                 else _nochange
-      Basics.Neq | isLit u && isLit v -> _ret $ lit $ C.LBool (litVal u /= litVal v)
-      
-      _ -> case (u, v) of 
-              (St (ValSimpleTerm (Lit (C.LInt n1 _))), 
-               St (ValSimpleTerm (Lit (C.LInt n2 _)))) ->
-                    let ii f = _ret $ lit (C.LInt (f n1 n2) NoPos )
-                        bb f = _ret $ lit (C.LBool (f n1 n2)) 
-                      in case op of 
-                            Basics.Plus  -> ii (+)
-                            Basics.Minus -> ii (-)
-                            Basics.Mult  -> ii (*)
-                            Basics.Le -> bb (<=)
-                            Basics.Lt -> bb (<)
-                            Basics.Ge -> bb (>=)
-                            Basics.Gt -> bb (>)
-                            _ -> _nochange 
-
-        
-              _ -> _nochange 
-  Un op operand -> do
-    v <- look operand 
-    -- TODO should write out all cases
-    case (op,v) of 
-        (Basics.IsTuple, St (Tuple _))          -> _ret __trueLit 
-        (Basics.IsTuple, St (Record _))         -> _ret __falseLit
-        (Basics.IsTuple, St (WithRecord _ _))   -> _ret __falseLit
-        (Basics.IsTuple, St (List _))           -> _ret __falseLit
-        (Basics.IsTuple, St (ListCons _ _))     -> _ret __falseLit
-        (Basics.IsTuple, St (ValSimpleTerm _))  -> _ret __falseLit
-
-
-        (Basics.IsRecord, St (Record _))        -> _ret __trueLit
-        (Basics.IsRecord, St (WithRecord _ _))  -> _ret __trueLit 
-        (Basics.IsRecord, St (Tuple _))         -> _ret __falseLit
-        (Basics.IsRecord, St (List _))          -> _ret __falseLit
-        (Basics.IsRecord, St (ListCons _ _))    -> _ret __falseLit
-        (Basics.IsRecord, St (ValSimpleTerm _)) -> _ret __falseLit
-
-
-        (Basics.IsList, St (List _))          -> _ret __trueLit
-        (Basics.IsList, St (ListCons _ _))    -> _ret __trueLit
-        (Basics.IsList, St (Record _))        -> _ret __falseLit
-        (Basics.IsList, St (WithRecord _ _))  -> _ret __falseLit 
-        (Basics.IsList, St (Tuple _))         -> _ret __falseLit
-        (Basics.IsList, St (ValSimpleTerm _)) -> _ret __falseLit
-
-        (Basics.TupleLength, St (Tuple xs)) -> 
-            _ret $ lit (C.LInt (fromIntegral (length xs)) NoPos)
-        -- 2023-08 Revision: Added this case
-        (Basics.ListLength, St (List xs)) -> 
-            _ret $ lit (C.LInt (fromIntegral (length xs)) NoPos)
-            
-   
-       
-        _ -> _nochange
-  ProjField x s ->  do 
-    fs <- fields x
-    case lookupLast s fs of 
-      Just y -> _subst y 
-      Nothing -> _nochange
-  ProjIdx x idx -> do
-    t <- look x
-    case t of
-      St (Tuple vs) | fromIntegral (length vs) > idx ->
-        _subst (vs !! fromIntegral idx)
-      _ -> _nochange
-
-
-  ValSimpleTerm (KAbs klam) -> do
-        klam' <- withResetRetState $ simpl klam
-        _ret $ ValSimpleTerm $ KAbs klam'
-{--
-  List _ -> _nochange 
-  ListCons _ _ -> _nochange
-  Base _ -> _nochange
-  Lib _ _ -> _nochange 
-        --}
-  _ -> _nochange
-
-  where 
-    lit l = ValSimpleTerm  (Lit l)
-    isLit (St (ValSimpleTerm (Lit _))) = True 
-    isLit _ = False 
+                    Basics.Eq | u == v && (u /= Unknown) -> _ret $ __trueLit
+                    Basics.Eq | (isLit u && isLit v) -> _ret $ lit $ C.LBool (litVal u == litVal v)
+                    Basics.Eq | isRecordTerm u -> do
+                        e <- recordEquiv oper1 oper2
+                        if e
+                            then _ret $ __trueLit
+                            else _nochange
+                    Basics.Neq | isLit u && isLit v -> _ret $ lit $ C.LBool (litVal u /= litVal v)
+                    _ -> case (u, v) of
+                        ( St (ValSimpleTerm (Lit (C.LInt n1 _)))
+                            , St (ValSimpleTerm (Lit (C.LInt n2 _)))
+                            ) ->
+                                let ii f = _ret $ lit (C.LInt (f n1 n2) NoPos)
+                                    bb f = _ret $ lit (C.LBool (f n1 n2))
+                                 in case op of
+                                        Basics.Plus -> ii (+)
+                                        Basics.Minus -> ii (-)
+                                        Basics.Mult -> ii (*)
+                                        Basics.Le -> bb (<=)
+                                        Basics.Lt -> bb (<)
+                                        Basics.Ge -> bb (>=)
+                                        Basics.Gt -> bb (>)
+                                        _ -> _nochange
+                        _ -> _nochange
+            Un op operand -> do
+                v <- look operand
+                -- TODO should write out all cases
+                case (op, v) of
+                    (Basics.IsTuple, St (Tuple _)) -> _ret __trueLit
+                    (Basics.IsTuple, St (Record _)) -> _ret __falseLit
+                    (Basics.IsTuple, St (WithRecord _ _)) -> _ret __falseLit
+                    (Basics.IsTuple, St (List _)) -> _ret __falseLit
+                    (Basics.IsTuple, St (ListCons _ _)) -> _ret __falseLit
+                    (Basics.IsTuple, St (ValSimpleTerm _)) -> _ret __falseLit
+                    (Basics.IsRecord, St (Record _)) -> _ret __trueLit
+                    (Basics.IsRecord, St (WithRecord _ _)) -> _ret __trueLit
+                    (Basics.IsRecord, St (Tuple _)) -> _ret __falseLit
+                    (Basics.IsRecord, St (List _)) -> _ret __falseLit
+                    (Basics.IsRecord, St (ListCons _ _)) -> _ret __falseLit
+                    (Basics.IsRecord, St (ValSimpleTerm _)) -> _ret __falseLit
+                    (Basics.IsList, St (List _)) -> _ret __trueLit
+                    (Basics.IsList, St (ListCons _ _)) -> _ret __trueLit
+                    (Basics.IsList, St (Record _)) -> _ret __falseLit
+                    (Basics.IsList, St (WithRecord _ _)) -> _ret __falseLit
+                    (Basics.IsList, St (Tuple _)) -> _ret __falseLit
+                    (Basics.IsList, St (ValSimpleTerm _)) -> _ret __falseLit
+                    (Basics.TupleLength, St (Tuple xs)) ->
+                        _ret $ lit (C.LInt (fromIntegral (length xs)) NoPos)
+                    -- 2023-08 Revision: Added this case
+                    (Basics.ListLength, St (List xs)) ->
+                        _ret $ lit (C.LInt (fromIntegral (length xs)) NoPos)
+                    _ -> _nochange
+            ProjField x s -> do
+                fs <- fields x
+                case lookupLast s fs of
+                    Just y -> _subst y
+                    Nothing -> _nochange
+            ProjIdx x idx -> do
+                t <- look x
+                case t of
+                    St (Tuple vs)
+                        | fromIntegral (length vs) > idx ->
+                            _subst (vs !! fromIntegral idx)
+                    _ -> _nochange
+            ValSimpleTerm (KAbs klam) -> do
+                klam' <- withResetRetState $ simpl klam
+                _ret $ ValSimpleTerm $ KAbs klam'
+            {--
+              List _ -> _nochange
+              ListCons _ _ -> _nochange
+              Base _ -> _nochange
+              Lib _ _ -> _nochange
+                    --}
+            _ -> _nochange
+  where
+    lit l = ValSimpleTerm (Lit l)
+    isLit (St (ValSimpleTerm (Lit _))) = True
+    isLit _ = False
     litVal (St (ValSimpleTerm (Lit (C.LInt i _)))) = (C.LInt i NoPos)
     litVal (St (ValSimpleTerm (Lit x))) = x
     litVal _ = error "incorrect application of litVal"
     __trueLit = lit (C.LBool True)
     __falseLit = lit (C.LBool False)
 
-
-subst x v t = apply (Subst (Map.singleton  x v )) t
-
-withResetRetState = local (\r -> r {__rewrite_ret_of_reader = Nothing}) 
-withRetState st = local (\r -> r {__rewrite_ret_of_reader = Just st})
-
-state_info :: Opt String 
-state_info = do 
-  r <- __rewrite_ret_of_reader <$> ask 
-  return $ "ret\n"  ++ (show r)
-
-
-failFree :: SimpleTerm -> Bool -- 2021-05-19; AA; hack  
-failFree st = case st of 
-  Bin op _ _ ->  op `elem` [Basics.Eq, Basics.Neq] -- Equality comparisons are safe (return boolean)
-  Un _ _ -> False  -- Unary operations can fail (e.g., head on empty list, arithmetic on non-numbers)
-  ValSimpleTerm _ -> True 
-  Tuple _ -> True 
-  Record _ -> True 
-  WithRecord _ _ -> True 
-  ProjField _ _ -> False  -- Field projection can fail if field doesn't exist
-  ProjIdx _ _ -> False    -- Index projection can fail if index out of bounds
-  List _ -> True 
-  ListCons _ _ -> False   -- List cons can fail if second arg is not a list
-  Base _ -> False         -- Base function calls can have side effects or fail
-  Lib _ _ -> False        -- Library function calls can have side effects or fail 
-
-instance Simplifiable KTerm where 
-  simpl k = do 
-    --s <- state_info     
-    -- trace ("simpl-kterm\n" ++ (s) ++ "\n" ++ "~~~\n" ++(show k)++ ("\n----"))  $ 
-    case k of 
-      LetSimple x st kt -> do 
-        _cse <- __cse_map_of_reader <$> ask 
-        case Map.lookup st _cse of 
-          Just w -> simpl $ subst x w kt 
-          Nothing -> do 
-            x_uses <- censusInfo x 
-            case (x_uses, st) of 
-              (0, _) | failFree st  -> simpl kt 
-              (1, ValSimpleTerm (KAbs klambda@(Unary _ _ ))) 
-                | isApplied x kt ->  do
-                      bindenv x (St st)
-                      simpl kt          -- remove the let-declaration
-                                        -- expecting the substitution down the 
-                                        -- road in the application case 
-                                        -- 2021-05-17; AA
-              _  -> do      
-                w <- simplifySimpleTerm st 
-                case w of 
-                  ResultSimplified st' -> do
-                      bindenv x (St st')
-                      kt' <- local (\r -> r { __cse_map_of_reader = Map.insert st' x _cse } ) (simpl kt)
-                      return $ LetSimple x st' kt' 
-                  ResultSubst w ->                 
-                      simpl $ subst x w kt 
-      LetFun fdefs kt -> do 
-        -- binddef fdefs 
-        fdefs' <- withResetRetState $ simpl fdefs 
-        kt' <- simpl kt 
-        return $ LetFun fdefs' kt' 
-      LetRet ret kt -> do 
-        ret_now <- __rewrite_ret_of_reader <$> ask 
-        ret' <- simpl ret 
-        if hasUniqueReturn kt 
-          then withRetState ret' (simpl kt)
-          else do           
-            kt' <- withResetRetState (simpl kt)
-            return $ LetRet ret' kt' 
-      KontReturn x -> do
-        ret <- __rewrite_ret_of_reader <$> ask 
-        case ret of 
-          Nothing -> return $ KontReturn x
-          Just (Cont y kt) -> return $ subst y x kt 
-      ApplyFun x y -> do 
-        x_uses <- censusInfo x
-        case x_uses of 
-          1 -> do v <- look x
-                  case v of 
-                    (St (ValSimpleTerm (KAbs (Unary arg body)))) -> do 
-                      simpl $ subst arg y body
+subst x v t = apply (Subst (Map.singleton x v)) t
+
+withResetRetState = local (\r -> r{__rewrite_ret_of_reader = Nothing})
+withRetState st = local (\r -> r{__rewrite_ret_of_reader = Just st})
+
+state_info :: Opt String
+state_info = do
+    r <- __rewrite_ret_of_reader <$> ask
+    return $ "ret\n" ++ (show r)
+
+failFree :: SimpleTerm -> Bool -- 2021-05-19; AA; hack
+failFree st = case st of
+    Bin op _ _ -> op `elem` [Basics.Eq, Basics.Neq] -- Equality comparisons are safe (return boolean)
+    Un _ _ -> False -- Unary operations can fail (e.g., head on empty list, arithmetic on non-numbers)
+    ValSimpleTerm _ -> True
+    Tuple _ -> True
+    Record _ -> True
+    WithRecord _ _ -> True
+    ProjField _ _ -> False -- Field projection can fail if field doesn't exist
+    ProjIdx _ _ -> False -- Index projection can fail if index out of bounds
+    List _ -> True
+    ListCons _ _ -> False -- List cons can fail if second arg is not a list
+    Base _ -> False -- Base function calls can have side effects or fail
+    Lib _ _ -> False -- Library function calls can have side effects or fail
+
+instance Simplifiable KTerm where
+    simpl k = do
+        -- s <- state_info
+        -- trace ("simpl-kterm\n" ++ (s) ++ "\n" ++ "~~~\n" ++(show k)++ ("\n----"))  $
+        case k of
+            LetSimple x st kt -> do
+                _cse <- __cse_map_of_reader <$> ask
+                case Map.lookup st _cse of
+                    Just w -> simpl $ subst x w kt
+                    Nothing -> do
+                        x_uses <- censusInfo x
+                        case (x_uses, st) of
+                            (0, _) | failFree st -> simpl kt
+                            (1, ValSimpleTerm (KAbs klambda@(Unary _ _)))
+                                | isApplied x kt -> do
+                                    bindenv x (St st)
+                                    simpl kt -- remove the let-declaration
+                                    -- expecting the substitution down the
+                                    -- road in the application case
+                                    -- 2021-05-17; AA
+                            _ -> do
+                                w <- simplifySimpleTerm st
+                                case w of
+                                    ResultSimplified st' -> do
+                                        bindenv x (St st')
+                                        kt' <- local (\r -> r{__cse_map_of_reader = Map.insert st' x _cse}) (simpl kt)
+                                        return $ LetSimple x st' kt'
+                                    ResultSubst w ->
+                                        simpl $ subst x w kt
+            LetFun fdefs kt -> do
+                -- binddef fdefs
+                fdefs' <- withResetRetState $ simpl fdefs
+                kt' <- simpl kt
+                return $ LetFun fdefs' kt'
+            LetRet ret kt -> do
+                ret_now <- __rewrite_ret_of_reader <$> ask
+                ret' <- simpl ret
+                if hasUniqueReturn kt
+                    then withRetState ret' (simpl kt)
+                    else do
+                        kt' <- withResetRetState (simpl kt)
+                        return $ LetRet ret' kt'
+            KontReturn x -> do
+                ret <- __rewrite_ret_of_reader <$> ask
+                case ret of
+                    Nothing -> return $ KontReturn x
+                    Just (Cont y kt) -> return $ subst y x kt
+            ApplyFun x y -> do
+                x_uses <- censusInfo x
+                case x_uses of
+                    1 -> do
+                        v <- look x
+                        case v of
+                            (St (ValSimpleTerm (KAbs (Unary arg body)))) -> do
+                                simpl $ subst arg y body
+                            _ -> return k
                     _ -> return k
-          _ -> return k
-      If x k1 k2 -> do 
-        v <- look x
-        case v of 
-          St (ValSimpleTerm (Lit (C.LBool b))) -> 
-            simpl (if b then k1 else k2)
-          _ -> do 
-            k1' <- withResetRetState $ simpl k1 
-            k2' <- withResetRetState $ simpl k2 
-            return $ If x k1' k2'
-      AssertElseError x kt y pos -> do
-        v <- look x 
-        case v of 
-          St (ValSimpleTerm (Lit (C.LBool b)))->
-            simpl (if b then kt else (Error y pos))
-          _ -> do
-              k' <- simpl kt 
-              return $ AssertElseError x k' y pos 
-      Error _  _ -> return k 
-      Halt _ -> return k 
-
-
-
-hasUniqueReturn :: KTerm -> Bool 
-hasUniqueReturn k = 
-  case k of 
-    KontReturn _              -> True 
-    LetSimple _ _ k'          -> hasUniqueReturn k' 
-    LetFun _ k'               -> hasUniqueReturn k'
-    ApplyFun _ _              -> False 
-    If _ _ _                  -> False
-    AssertElseError _ k _ _   -> hasUniqueReturn k 
-    Halt _                    -> True 
-    Error _ _                 -> True     
-    LetRet (Cont _ k') _      -> hasUniqueReturn k'
-
-isApplied :: VarName -> KTerm -> Bool 
-isApplied f k = 
-  case k of 
-    KontReturn _ -> False 
-    LetSimple _  _ k' -> isApplied f k' 
-    LetFun fdefs k' -> 
-       or $ (isApplied f k') :
-            [ isApplied f k | Fun _ kl <- fdefs, let k = kTermOfLambda kl]
-    ApplyFun g _ -> g == f 
-    If _ k1 k2 -> isApplied f k1 || isApplied f k2
-    AssertElseError  _ k _ _ -> isApplied f k 
-    Halt _ -> False 
-    Error _ _ -> False 
-    LetRet (Cont _ k') k'' -> isApplied f k' || isApplied f k'' 
-   where kTermOfLambda (Unary _ k) = k
-         kTermOfLambda (Nullary k) = k
-    
+            If x k1 k2 -> do
+                v <- look x
+                case v of
+                    St (ValSimpleTerm (Lit (C.LBool b))) ->
+                        simpl (if b then k1 else k2)
+                    _ -> do
+                        k1' <- withResetRetState $ simpl k1
+                        k2' <- withResetRetState $ simpl k2
+                        return $ If x k1' k2'
+            AssertElseError x kt y pos -> do
+                v <- look x
+                case v of
+                    St (ValSimpleTerm (Lit (C.LBool b))) ->
+                        simpl (if b then kt else (Error y pos))
+                    _ -> do
+                        k' <- simpl kt
+                        return $ AssertElseError x k' y pos
+            Error _ _ -> return k
+            Halt _ -> return k
+
+hasUniqueReturn :: KTerm -> Bool
+hasUniqueReturn k =
+    case k of
+        KontReturn _ -> True
+        LetSimple _ _ k' -> hasUniqueReturn k'
+        LetFun _ k' -> hasUniqueReturn k'
+        ApplyFun _ _ -> False
+        If _ _ _ -> False
+        AssertElseError _ k _ _ -> hasUniqueReturn k
+        Halt _ -> True
+        Error _ _ -> True
+        LetRet (Cont _ k') _ -> hasUniqueReturn k'
+
+isApplied :: VarName -> KTerm -> Bool
+isApplied f k =
+    case k of
+        KontReturn _ -> False
+        LetSimple _ _ k' -> isApplied f k'
+        LetFun fdefs k' ->
+            or $
+                (isApplied f k')
+                    : [isApplied f k | Fun _ kl <- fdefs, let k = kTermOfLambda kl]
+        ApplyFun g _ -> g == f
+        If _ k1 k2 -> isApplied f k1 || isApplied f k2
+        AssertElseError _ k _ _ -> isApplied f k
+        Halt _ -> False
+        Error _ _ -> False
+        LetRet (Cont _ k') k'' -> isApplied f k' || isApplied f k''
+  where
+    kTermOfLambda (Unary _ k) = k
+    kTermOfLambda (Nullary k) = k
 
 iter :: KTerm -> KTerm
-iter kt = 
-      let census = getCensus kt
-          (kt', _, _) = runRWS (simpl kt) 
-                          OptReader {
-                             __census_of_reader = census,
-                             __rewrite_ret_of_reader = Nothing,
-                             __cse_map_of_reader = Map.empty 
-
-                          }
-                          OptState { __env_of_state = Map.empty
-                          }
-      in if kt == kt' then kt
-                      else -- trace ((show kt) ++ ("\n------\n") ++ (show kt') ++ "\n========\n") 
-                           iter kt' 
+iter kt =
+    let census = getCensus kt
+        (kt', _, _) =
+            runRWS
+                (simpl kt)
+                OptReader
+                    { __census_of_reader = census
+                    , __rewrite_ret_of_reader = Nothing
+                    , __cse_map_of_reader = Map.empty
+                    }
+                OptState
+                    { __env_of_state = Map.empty
+                    }
+     in if kt == kt'
+            then kt
+            else -- trace ((show kt) ++ ("\n------\n") ++ (show kt') ++ "\n========\n")
+                iter kt'
 
 rewrite :: Prog -> Prog
-rewrite (Prog atoms kterm) = 
- Prog atoms (iter kterm)
\ No newline at end of file
+rewrite (Prog atoms kterm) =
+    Prog atoms (iter kterm)
diff --git a/compiler/src/CaseElimination.hs b/compiler/src/CaseElimination.hs
index a50c1547..3f3236c6 100644
--- a/compiler/src/CaseElimination.hs
+++ b/compiler/src/CaseElimination.hs
@@ -1,65 +1,65 @@
-{-# LANGUAGE  FlexibleContexts  #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
 {-# HLINT ignore "Use camelCase" #-}
 {-# HLINT ignore "Redundant bracket" #-}
-module CaseElimination ( trans )
+module CaseElimination (trans)
 where
 
 import Basics
+import CompileMode
+import Direct (RecordPatternMode (..))
 import qualified Direct as S
-import Direct (RecordPatternMode(..))
 import DirectWOPats as T
-import CompileMode
 import TroupePositionInfo
 
-import Control.Monad.Reader
-import Control.Monad.Except
 import Control.Monad (foldM)
+import Control.Monad.Except
+import Control.Monad.Reader
 import Data.List (nub, (\\))
 
 type Trans = Except String
 
 trans :: CompileMode -> S.Prog -> Trans T.Prog
 trans mode (S.Prog imports atms tm) = do
-  let tm' = case mode of
-              Normal ->
-                  S.Let [ S.ValDecl (S.VarPattern "authority") (S.Var "$$authorityarg") _srcRT ]
-                        tm
-              Export -> tm
-  atms' <- transAtoms atms
-  tm'' <- transTerm tm'
-  return (T.Prog imports atms' tm'')
+    let tm' = case mode of
+            Normal ->
+                S.Let
+                    [S.ValDecl (S.VarPattern "authority") (S.Var "$$authorityarg") _srcRT]
+                    tm
+            Export -> tm
+    atms' <- transAtoms atms
+    tm'' <- transTerm tm'
+    return (T.Prog imports atms' tm'')
 
 transAtoms :: S.Atoms -> Trans T.Atoms
 transAtoms (S.Atoms atms) = return (T.Atoms atms)
 
 transLit :: S.Lit -> T.Lit
-transLit (S.LInt n pi)    = T.LInt n pi
+transLit (S.LInt n pi) = T.LInt n pi
 transLit (S.LString s) = T.LString s
-transLit (S.LLabel s)  = T.LLabel s
-transLit (S.LDCLabel dc)  = T.LDCLabel dc
-transLit (S.LUnit)     = T.LUnit
-transLit (S.LBool b)   = T.LBool b
-transLit (S.LAtom a)   = T.LAtom a
-
+transLit (S.LLabel s) = T.LLabel s
+transLit (S.LDCLabel dc) = T.LDCLabel dc
+transLit (S.LUnit) = T.LUnit
+transLit (S.LBool b) = T.LBool b
+transLit (S.LAtom a) = T.LAtom a
 
 transLambda_aux :: S.Lambda -> ReaderT T.Term Trans Lambda
 transLambda_aux (S.Lambda pats t) = do
-  let args = map (("$arg" ++) . show) [1..(length pats)]
-      argPat = zip (map Var args) pats
-  t' <- lift (transTerm t)
-  result <- foldM compilePattern t' (reverse argPat)
-  return (Lambda args result)
+    let args = map (("$arg" ++) . show) [1 .. (length pats)]
+        argPat = zip (map Var args) pats
+    t' <- lift (transTerm t)
+    result <- foldM compilePattern t' (reverse argPat)
+    return (Lambda args result)
 
 transLambdaWithError :: S.Lambda -> T.Term -> Trans Lambda
-transLambdaWithError lam errorTerm = 
-  runReaderT (transLambda_aux lam) errorTerm
+transLambdaWithError lam errorTerm =
+    runReaderT (transLambda_aux lam) errorTerm
 
 transLambda :: S.Lambda -> Trans Lambda
-transLambda lam = 
-  transLambdaWithError lam (Error (Lit (LString "pattern match failed") ) NoPos)
-
+transLambda lam =
+    transLambdaWithError lam (Error (Lit (LString "pattern match failed")) NoPos)
 
 {-- 2019-01-31 desugaring handlers; AA
 
@@ -69,8 +69,8 @@ transLambda lam =
 
 Given `hn pat1 | pat2 when e1 => e2`, we desugar it to
 
-fn (input) => 
-  case input of 
+fn (input) =>
+  case input of
       (pat1, pat2) => if e1 then (0, fn _ => e2)
                             else (1, ())
       _ => HNPATFAIL (1, ())
@@ -78,228 +78,240 @@ fn (input) =>
 .
 Here, HNPATSUCC and HNPATFAIL are two runtime functions. The semantics
 is that before the handler is called, the runtime sets the thread
-flag to the "HANDLER MODE" that will prevent side effects (including 
+flag to the "HANDLER MODE" that will prevent side effects (including
 picking messages from the mailbox and sending messages to other threads).
-Calling PATSUCC will bring the thread back to normal mode. 
-
+Calling PATSUCC will bring the thread back to normal mode.
 
 --}
 
-
 _srcRT = RTGen "CaseElimination"
 
 transHandler :: S.Handler -> Trans Lambda
 transHandler (S.Handler pat1 mbpat2 guard body) = do
-  let argInput  = "$input"
-      pat2 = case mbpat2 of
-              Just pat2 -> pat2
-              Nothing   -> S.Wildcard      
-      lambdaPats = [S.VarPattern argInput] 
-      callFailure = S.Tuple [S.Lit (S.LInt 1 _srcRT), S.Lit S.LUnit ]  
-      body' =  S.Tuple[ S.Lit (S.LInt 0 _srcRT), S.Abs ( S.Lambda [S.Wildcard] body )  ]
-      guardCheck = case guard of
-         Nothing -> body'
-         Just g -> S.If g body' callFailure
-      lamBody = S.Case (S.Var argInput) [( S.TuplePattern [pat1, pat2], guardCheck), (S.Wildcard, callFailure)] _srcRT
-      lambda = S.Lambda lambdaPats lamBody
-  transLambda lambda
-  
+    let argInput = "$input"
+        pat2 = case mbpat2 of
+            Just pat2 -> pat2
+            Nothing -> S.Wildcard
+        lambdaPats = [S.VarPattern argInput]
+        callFailure = S.Tuple [S.Lit (S.LInt 1 _srcRT), S.Lit S.LUnit]
+        body' = S.Tuple [S.Lit (S.LInt 0 _srcRT), S.Abs (S.Lambda [S.Wildcard] body)]
+        guardCheck = case guard of
+            Nothing -> body'
+            Just g -> S.If g body' callFailure
+        lamBody = S.Case (S.Var argInput) [(S.TuplePattern [pat1, pat2], guardCheck), (S.Wildcard, callFailure)] _srcRT
+        lambda = S.Lambda lambdaPats lamBody
+    transLambda lambda
 
 -- 2018-09-28: AA: a bit of a hack: making sure that the last pattern is
 -- compiled into an assertion instead of an ifthenelse
-ifpat t1 t2 t3 = 
-  case t3 of 
-    Error t3' pos -> AssertElseError t1 t2 t3' pos
-    _ -> If t1 t2 t3
-  
-  
+ifpat t1 t2 t3 =
+    case t3 of
+        Error t3' pos -> AssertElseError t1 t2 t3' pos
+        _ -> If t1 t2 t3
+
 -- 2023-06-21: FW: an alternative would be to add a pseudo pattern at the end of each pattern list,
 -- which includes the error message and always compiles to an error term.
--- | Compile pattern matching to conditionals and assertions.
--- succ: term corresponding to a successful match
--- v: the term to be assigned to the pattern
--- The Reader monad stores the error term.
+
+{- | Compile pattern matching to conditionals and assertions.
+succ: term corresponding to a successful match
+v: the term to be assigned to the pattern
+The Reader monad stores the error term.
+-}
 compilePattern :: T.Term -> (T.Term, S.DeclPattern) -> ReaderT T.Term Trans T.Term
-compilePattern succ (v, (S.AtPattern p l))  = do
-  fail <- ask
-  succ' <- compilePattern succ (v, p)
-  return $ ifpat (Bin Eq (Un LevelOf v) (Lit (LLabel l))) succ' fail
+compilePattern succ (v, (S.AtPattern p l)) = do
+    fail <- ask
+    succ' <- compilePattern succ (v, p)
+    return $ ifpat (Bin Eq (Un LevelOf v) (Lit (LLabel l))) succ' fail
 compilePattern succ (v, (S.VarPattern var)) = return $ Let [T.ValDecl var v] succ
 compilePattern succ (v, (S.ValPattern lit)) = do
-  fail <- ask
-  return $ ifpat (Bin Eq v (Lit (transLit lit))) succ fail
+    fail <- ask
+    return $ ifpat (Bin Eq v (Lit (transLit lit))) succ fail
 compilePattern succ (v, S.Wildcard) = return $ Let [T.ValDecl "$wildcard" v] succ
 compilePattern succ (v, S.TuplePattern pats) = do
-  fail <- ask
-  -- Accessors for the value to be assigned to the patterns.
-  let accessors = map (ProjIdx v) [0..(fromIntegral (length pats) - 1)]
-  -- Compile the nested patterns, combining the resulting terms for the respective patterns so that the left-most is evaluated first.
-  succ' <- foldM compilePattern succ (reverse (zip accessors pats))
-  -- The expression for the tuple pattern checks whether the to-be-assigned value is a tuple with the correct length,
-  -- and then executes the expression succ' which checks the nested patterns.
-  return $ ifpat (Bin And (Un IsTuple v) (Bin Eq (Un TupleLength v) (Lit (LInt (toInteger (length pats)) _srcRT)))) succ' fail
+    fail <- ask
+    -- Accessors for the value to be assigned to the patterns.
+    let accessors = map (ProjIdx v) [0 .. (fromIntegral (length pats) - 1)]
+    -- Compile the nested patterns, combining the resulting terms for the respective patterns so that the left-most is evaluated first.
+    succ' <- foldM compilePattern succ (reverse (zip accessors pats))
+    -- The expression for the tuple pattern checks whether the to-be-assigned value is a tuple with the correct length,
+    -- and then executes the expression succ' which checks the nested patterns.
+    return $ ifpat (Bin And (Un IsTuple v) (Bin Eq (Un TupleLength v) (Lit (LInt (toInteger (length pats)) _srcRT)))) succ' fail
 -- TODO Generate more efficient code:
 -- Decompose the list v according to the pattern with a DFS pass.
 -- This would benefit from an "is empty" operation (to not having to use the RT-dispatched equals).
 -- A potentially expensive length calculation is then unnecessary.
 -- However, this is more complicated, as would need unique name generation, also for potentially nested list patterns.
 compilePattern succ (v, S.ListPattern pats) = do
-  fail <- ask
-  -- Accessors for the value to be assigned to the patterns.
-  let accessors = map (Un Head) $ iterate (Un Tail) v
-  -- Compile the nested patterns, combining the resulting terms for the respective patterns so that the left-most is evaluated first.
-  succ' <- foldM compilePattern succ (reverse (zip accessors pats)) -- pairs of pattern (the nested ones in the list) and term accessing the value at the corresponding index in the list term
-  -- The expression for the list pattern checks whether the to-be-assigned value is a list with the correct length,
-  -- and then executes the expression succ' which checks the nested patterns.
-  return $ ifpat (Bin And (Un IsList v) (Bin Eq (Un ListLength v) (Lit (LInt (toInteger (length pats)) _srcRT)))) succ' fail
+    fail <- ask
+    -- Accessors for the value to be assigned to the patterns.
+    let accessors = map (Un Head) $ iterate (Un Tail) v
+    -- Compile the nested patterns, combining the resulting terms for the respective patterns so that the left-most is evaluated first.
+    succ' <- foldM compilePattern succ (reverse (zip accessors pats)) -- pairs of pattern (the nested ones in the list) and term accessing the value at the corresponding index in the list term
+    -- The expression for the list pattern checks whether the to-be-assigned value is a list with the correct length,
+    -- and then executes the expression succ' which checks the nested patterns.
+    return $ ifpat (Bin And (Un IsList v) (Bin Eq (Un ListLength v) (Lit (LInt (toInteger (length pats)) _srcRT)))) succ' fail
 compilePattern succ (v, S.ConsPattern p1 p2) = do
-  fail <- ask
-  succ' <- compilePattern succ (Un Head v, p1)
-  succ'' <- compilePattern succ' (Un Tail v, p2)
-  -- TODO Avoid list length (potentially expensive). Implement similarly to the improved list pattern (see above).
-  return $ ifpat (Bin And (Un IsList v) (Bin Gt (Un ListLength v) (Lit (LInt 0 _srcRT) ))) succ'' fail
+    fail <- ask
+    succ' <- compilePattern succ (Un Head v, p1)
+    succ'' <- compilePattern succ' (Un Tail v, p2)
+    -- TODO Avoid list length (potentially expensive). Implement similarly to the improved list pattern (see above).
+    return $ ifpat (Bin And (Un IsList v) (Bin Gt (Un ListLength v) (Lit (LInt 0 _srcRT)))) succ'' fail
 compilePattern succ (v, S.RecordPattern fieldPatterns mode) = do
-  fail <- ask
-  -- Check for duplicate field names
-  let fieldNames = map fst fieldPatterns
-  let duplicates = fieldNames \\ nub fieldNames
-  if not (null duplicates)
-    then lift $ throwError $ "Duplicate field names in record pattern: " ++ show duplicates
-    else do
-      succ' <- foldM compileField succ (reverse fieldPatterns)
-      case mode of
-        WildcardMatch -> 
-          -- Current behavior - just check it's a record and has the specified fields
-          return $ ifpat (Un IsRecord v) succ' fail
-        ExactMatch ->
-          -- Check that the record has exactly the specified number of fields
-          let expectedSize = length fieldPatterns
-              sizeCheck = Bin Eq (Un RecordSize v) (Lit (LInt (fromIntegral expectedSize) _srcRT))
-              recordCheck = Bin And (Un IsRecord v) sizeCheck
-          in return $ ifpat recordCheck succ' fail
-    where ifHasField f k = do 
-              succ' <- k 
-              fail <- ask 
-              let f' = Lit (LString f )
-              return $ ifpat (Bin HasField v  f' ) succ' fail 
-
-          compileField succ (f, Just p) = do 
-              ifHasField f $ compilePattern succ (T.ProjField v f, p)
-              
-          compileField succ (f, Nothing) = do 
-              ifHasField f $ compilePattern succ (T.ProjField v f, S.VarPattern f)
-  
+    fail <- ask
+    -- Check for duplicate field names
+    let fieldNames = map fst fieldPatterns
+    let duplicates = fieldNames \\ nub fieldNames
+    if not (null duplicates)
+        then lift $ throwError $ "Duplicate field names in record pattern: " ++ show duplicates
+        else do
+            succ' <- foldM compileField succ (reverse fieldPatterns)
+            case mode of
+                WildcardMatch ->
+                    -- Current behavior - just check it's a record and has the specified fields
+                    return $ ifpat (Un IsRecord v) succ' fail
+                ExactMatch ->
+                    -- Check that the record has exactly the specified number of fields
+                    let expectedSize = length fieldPatterns
+                        sizeCheck = Bin Eq (Un RecordSize v) (Lit (LInt (fromIntegral expectedSize) _srcRT))
+                        recordCheck = Bin And (Un IsRecord v) sizeCheck
+                     in return $ ifpat recordCheck succ' fail
+  where
+    ifHasField f k = do
+        succ' <- k
+        fail <- ask
+        let f' = Lit (LString f)
+        return $ ifpat (Bin HasField v f') succ' fail
 
+    compileField succ (f, Just p) = do
+        ifHasField f $ compilePattern succ (T.ProjField v f, p)
+    compileField succ (f, Nothing) = do
+        ifHasField f $ compilePattern succ (T.ProjField v f, S.VarPattern f)
 
--- | Tranform a declaration, compiling patterns into terms.
--- When there are multiple patterns like in functions or a case expression,
--- they are folded into a nested term, with an error expression innermost (after the last check).
--- The error expression is therefore passed as state of a Reader monad.
+{- | Tranform a declaration, compiling patterns into terms.
+When there are multiple patterns like in functions or a case expression,
+they are folded into a nested term, with an error expression innermost (after the last check).
+The error expression is therefore passed as state of a Reader monad.
+-}
 transDecl :: S.Decl -> Term -> Trans Term
 transDecl (S.ValDecl pat t pos) succ = do
-  let temp = "$decltemp$"
-  t' <- transTerm t
-  result <- runReaderT (compilePattern succ ((Var temp ), pat)) (Error (Lit (LString "pattern match failure in let declaration")) pos)
-  return $ Let [ValDecl temp t'] result
+    let temp = "$decltemp$"
+    t' <- transTerm t
+    result <- runReaderT (compilePattern succ ((Var temp), pat)) (Error (Lit (LString "pattern match failure in let declaration")) pos)
+    return $ Let [ValDecl temp t'] result
 transDecl (S.FunDecs fundecs) succ = do
-  fundecs' <- mapM transFunDecl fundecs
-  return (Let [FunDecs fundecs'] succ)
+    fundecs' <- mapM transFunDecl fundecs
+    return (Let [FunDecs fundecs'] succ)
   where
-    argLength ((S.Lambda args _):_) = length args
+    argLength ((S.Lambda args _) : _) = length args
     argLength [] = 0
     transFunDecl (S.FunDecl f lams pos) = do
-      let lams' = map (transLambda_aux . (\(S.Lambda args e) -> S.Lambda [S.TuplePattern args] e)) lams
-          names = map (((f ++ "_pat") ++) . show) [1..(length lams)]
-          args =  map (((f ++ "_arg") ++) . show) [1..(argLength lams)]
-          args' =  Tuple (map Var args)
-          errorMsg = Error (Lit (LString $ "pattern match failure in function " ++ f)) pos
-      (fst, decls) <- foldr (\(n, l) acc -> do
-            (fail, decls) <- acc
-            lam <- runReaderT l fail
-            return ( (App (Var n) [args'])
-                   , (ValDecl n (Abs lam)) : decls)
-          ) (return (errorMsg, [])) (zip names lams')
-      return (FunDecl f (Lambda args (Let (reverse decls) fst)))
+        let lams' = map (transLambda_aux . (\(S.Lambda args e) -> S.Lambda [S.TuplePattern args] e)) lams
+            names = map (((f ++ "_pat") ++) . show) [1 .. (length lams)]
+            args = map (((f ++ "_arg") ++) . show) [1 .. (argLength lams)]
+            args' = Tuple (map Var args)
+            errorMsg = Error (Lit (LString $ "pattern match failure in function " ++ f)) pos
+        (fst, decls) <-
+            foldr
+                ( \(n, l) acc -> do
+                    (fail, decls) <- acc
+                    lam <- runReaderT l fail
+                    return
+                        ( (App (Var n) [args'])
+                        , (ValDecl n (Abs lam)) : decls
+                        )
+                )
+                (return (errorMsg, []))
+                (zip names lams')
+        return (FunDecl f (Lambda args (Let (reverse decls) fst)))
 
 transTerm :: S.Term -> Trans Term
 transTerm (S.Lit lit) = return (T.Lit (transLit lit))
 transTerm (S.Var v) = return (T.Var v)
 transTerm (S.Abs l) = do
-  l' <- transLambda l
-  return (T.Abs l')
+    l' <- transLambda l
+    return (T.Abs l')
 transTerm (S.Hnd h) = do
-  h' <- transHandler h
-  return (T.Abs h')
+    h' <- transHandler h
+    return (T.Abs h')
 transTerm (S.App t1 args) = do
-  t1' <- transTerm t1
-  args' <- mapM transTerm args
-  return (T.App t1' args')
+    t1' <- transTerm t1
+    args' <- mapM transTerm args
+    return (T.App t1' args')
 transTerm (S.Let decls t) = do
-  t' <- transTerm t
-  foldr (\decl acc -> do
-          acc' <- acc
-          transDecl decl acc'
-        ) (return t') decls
+    t' <- transTerm t
+    foldr
+        ( \decl acc -> do
+            acc' <- acc
+            transDecl decl acc'
+        )
+        (return t')
+        decls
 transTerm (S.Case t cases pos) = do
-  t' <- transTerm t
-  cases' <- mapM (\(pat, succ) -> do
-                    succ' <- transTerm succ
-                    return (pat, succ')
-                  ) cases
-  let e = foldr (\(pat, succ') fail ->
-            case runExcept (runReaderT (compilePattern succ' (Var "casevar", pat)) fail) of
-              Right result -> result
-              Left err -> error err
-          ) (Error (Lit (LString "pattern match failure in case expression")) pos) cases'
-  return (Let [ValDecl "casevar" t'] e)
+    t' <- transTerm t
+    cases' <-
+        mapM
+            ( \(pat, succ) -> do
+                succ' <- transTerm succ
+                return (pat, succ')
+            )
+            cases
+    let e =
+            foldr
+                ( \(pat, succ') fail ->
+                    case runExcept (runReaderT (compilePattern succ' (Var "casevar", pat)) fail) of
+                        Right result -> result
+                        Left err -> error err
+                )
+                (Error (Lit (LString "pattern match failure in case expression")) pos)
+                cases'
+    return (Let [ValDecl "casevar" t'] e)
 transTerm (S.If t1 t2 t3) = do
-  t1' <- transTerm t1
-  t2' <- transTerm t2
-  t3' <- transTerm t3
-  return (If t1' t2' t3')
+    t1' <- transTerm t1
+    t2' <- transTerm t2
+    t3' <- transTerm t3
+    return (If t1' t2' t3')
 transTerm (S.Tuple tms) = do
-  tms' <- mapM transTerm tms
-  return (T.Tuple tms')
+    tms' <- mapM transTerm tms
+    return (T.Tuple tms')
 transTerm (S.Record fields) = do
-  fields' <- transFields fields
-  return (T.Record fields')
+    fields' <- transFields fields
+    return (T.Record fields')
 transTerm (S.WithRecord e fields) = do
-  e' <- transTerm e
-  fields' <- transFields fields
-  return (T.WithRecord e' fields')
+    e' <- transTerm e
+    fields' <- transFields fields
+    return (T.WithRecord e' fields')
 transTerm (S.ProjField t f) = do
-  t' <- transTerm t
-  return (T.ProjField t' f)
+    t' <- transTerm t
+    return (T.ProjField t' f)
 transTerm (S.ProjIdx t idx) = do
-  t' <- transTerm t
-  return (T.ProjIdx t' idx)
+    t' <- transTerm t
+    return (T.ProjIdx t' idx)
 transTerm (S.List tms) = do
-  tms' <- mapM transTerm tms
-  return (T.List tms')
+    tms' <- mapM transTerm tms
+    return (T.List tms')
 transTerm (S.ListCons t1 t2) = do
-  t1' <- transTerm t1
-  t2' <- transTerm t2
-  return (T.ListCons t1' t2')
+    t1' <- transTerm t1
+    t2' <- transTerm t2
+    return (T.ListCons t1' t2')
 transTerm (S.Bin op t1 t2) = do
-  t1' <- transTerm t1
-  t2' <- transTerm t2
-  return (Bin op t1' t2')
+    t1' <- transTerm t1
+    t2' <- transTerm t2
+    return (Bin op t1' t2')
 transTerm (S.Un op t) = do
-  t' <- transTerm t
-  return (Un op t')
-transTerm (S.Seq ts) = 
+    t' <- transTerm t
+    return (Un op t')
+transTerm (S.Seq ts) =
     case reverse ts of
         [t] -> transTerm t
-        body:ts_rev -> do
-          let decls = map (\t -> S.ValDecl S.Wildcard t NoPos) (reverse ts_rev)
-          transTerm (S.Let decls body)
-        []  -> throwError "impossible case: sequence of empty terms"
-
+        body : ts_rev -> do
+            let decls = map (\t -> S.ValDecl S.Wildcard t NoPos) (reverse ts_rev)
+            transTerm (S.Let decls body)
+        [] -> throwError "impossible case: sequence of empty terms"
 transTerm (S.Error _) = throwError "impossible case: error"
 
 transFields :: [(String, Maybe S.Term)] -> Trans [(String, T.Term)]
 transFields = mapM $ \case
-  (f, Nothing) -> return (f, T.Var f)
-  (f, Just t) -> do
-    t' <- transTerm t
-    return (f, t')
\ No newline at end of file
+    (f, Nothing) -> return (f, T.Var f)
+    (f, Just t) -> do
+        t' <- transTerm t
+        return (f, t')
diff --git a/compiler/src/ClosureConv.hs b/compiler/src/ClosureConv.hs
index d92d4024..296cb9af 100644
--- a/compiler/src/ClosureConv.hs
+++ b/compiler/src/ClosureConv.hs
@@ -1,33 +1,31 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
 
-
-module ClosureConv where 
+module ClosureConv where
 
 import qualified Basics
-import RetCPS(VarName(..))
-import qualified RetCPS as CPS
-import qualified Core as C
+import CompileMode
 import Control.Monad.RWS
-import Data.Map.Lazy(Map)
-import qualified Data.Map.Lazy as Map
-import Data.Serialize(Serialize)
-import GHC.Generics
+import Control.Monad.Reader
 import Control.Monad.State
 import Control.Monad.Writer
-import Control.Monad.Reader
+import qualified Core as C
 import Data.List
-import CompileMode
+import Data.Map.Lazy (Map)
+import qualified Data.Map.Lazy as Map
+import Data.Serialize (Serialize)
+import GHC.Generics
+import RetCPS (VarName (..))
+import qualified RetCPS as CPS
 
-import           Control.Monad.Except
+import Control.Monad.Except
 import IR as CCIR
 
 import Control.Monad.Identity
 
 data VarLevel = VarNested Integer
-                deriving (Eq, Ord, Show)
-
+    deriving (Eq, Ord, Show)
 
 type FreshCounter = Integer
 type NestingLevel = Integer
@@ -39,24 +37,23 @@ type NestingLevel = Integer
 ------------------------------------------------------------
 -- The main translation takes place in RWS monad
 
-type CC = RWS
-            CCEnv                         -- reader: the translation environment
-            (FunDefs, Frees, ConstTracking)      -- writer: hoisted funs and free variables 
-            FreshCounter                  -- state:  the counter for fresh name generation
-
+type CC =
+    RWS
+        CCEnv -- reader: the translation environment
+        (FunDefs, Frees, ConstTracking) -- writer: hoisted funs and free variables
+        FreshCounter -- state:  the counter for fresh name generation
 
-type CCEnv   = (CompileMode, C.Atoms, NestingLevel, Map VarName VarLevel, Maybe VarName)
-type Frees   = [(VarName, NestingLevel)]
+type CCEnv = (CompileMode, C.Atoms, NestingLevel, Map VarName VarLevel, Maybe VarName)
+type Frees = [(VarName, NestingLevel)]
 type FunDefs = [CCIR.FunDef]
 type ConstEntry = (VarName, C.Lit)
 type ConstTracking = [(ConstEntry, NestingLevel)]
 
-
 ------------------------------------------------------------
 -- Auxiliary functions
 ------------------------------------------------------------
-consBB:: CCIR.IRInst -> CCIR.IRBBTree -> CCIR.IRBBTree
-consBB i (BB insts t) = BB (i:insts) t
+consBB :: CCIR.IRInst -> CCIR.IRBBTree -> CCIR.IRBBTree
+consBB i (BB insts t) = BB (i : insts) t
 
 insVar :: VarName -> CCEnv -> CCEnv
 insVar vn (compileMode, atms, lev, vmap, fname) =
@@ -71,147 +68,144 @@ insVars :: [VarName] -> CCEnv -> CCEnv
 insVars vars ccenv =
     foldl (flip insVar) ccenv vars
 
-
 askLev = do
-  (_, _, lev, _, _) <- ask
-  return lev
-
+    (_, _, lev, _, _) <- ask
+    return lev
 
 incLev fname (compileMode, atms, lev, vmap, _) =
     (compileMode, atms, lev + 1, vmap, (Just fname))
 
-
--- this helper function looks up the variable name 
+-- this helper function looks up the variable name
 -- in the enviroment and checks if it should be declared as free
 -- or local
 
 transVar :: VarName -> CC VarAccess
-transVar v@(VN vname) = do 
-  (_, C.Atoms atms, lev, vmap, maybe_fname) <- ask
-  case maybe_fname of 
-    Just fname | fname == v  -> return $ VarFunSelfRef
-    _ -> 
-      case Map.lookup v vmap of 
-        Just (VarNested lev') -> 
-          if lev' < lev 
-          then do 
-            tell $ ([], [(v, lev')], []) -- collecting info about free vars 
-            return $ VarEnv v 
-          else 
-            return $ VarLocal v 
-        Nothing -> 
-          if vname `elem` atms
-            then return $ VarLocal v 
-            else error $ "undeclared variable: " ++ (show v)
-
-
-transVars = mapM transVar         
-
-isDeclaredEarlierThan lev (_, l)  = l < lev
-
-transFunDec f@(VN fname) (CPS.Unary var kt) = do   
-  lev <- askLev
-  let filt = isDeclaredEarlierThan lev
-  (bb, (_, frees, consts_wo_levs)) <- 
-      censor (\(a,b,c ) -> (a, filter filt b, filter (\(_, l) -> l == lev ) c))
-     $ listen 
-        $ local ((insVar var) . (incLev f))
-           $ cpsToIR kt
-  let consts = (fst.unzip) consts_wo_levs
-  tell ([FunDef (HFN fname) var consts bb], [], [])
-  return (nub frees)
-
+transVar v@(VN vname) = do
+    (_, C.Atoms atms, lev, vmap, maybe_fname) <- ask
+    case maybe_fname of
+        Just fname | fname == v -> return $ VarFunSelfRef
+        _ ->
+            case Map.lookup v vmap of
+                Just (VarNested lev') ->
+                    if lev' < lev
+                        then do
+                            tell $ ([], [(v, lev')], []) -- collecting info about free vars
+                            return $ VarEnv v
+                        else
+                            return $ VarLocal v
+                Nothing ->
+                    if vname `elem` atms
+                        then return $ VarLocal v
+                        else error $ "undeclared variable: " ++ (show v)
+
+transVars = mapM transVar
+
+isDeclaredEarlierThan lev (_, l) = l < lev
+
+transFunDec f@(VN fname) (CPS.Unary var kt) = do
+    lev <- askLev
+    let filt = isDeclaredEarlierThan lev
+    (bb, (_, frees, consts_wo_levs)) <-
+        censor (\(a, b, c) -> (a, filter filt b, filter (\(_, l) -> l == lev) c)) $
+            listen $
+                local ((insVar var) . (incLev f)) $
+                    cpsToIR kt
+    let consts = (fst . unzip) consts_wo_levs
+    tell ([FunDef (HFN fname) var consts bb], [], [])
+    return (nub frees)
 transFunDec (VN _) (CPS.Nullary _) = error "not implemented"
 
 -- state accessors
 
 incState :: CC Integer
 incState = do
-  x <- get
-  put (x + 1)
-  return x
-
+    x <- get
+    put (x + 1)
+    return x
 
 mkEnvBindings fv = do
-  lev <- askLev
-  let (freeVars', boundVars) = Data.List.partition (\(_, l) -> l <= lev - 1 ) fv
-  let envVars = (map (\(v,_) -> (v, VarLocal v)) boundVars)
-                      ++ (map (\(v,_) -> (v, VarEnv v)) freeVars')
-  return envVars
+    lev <- askLev
+    let (freeVars', boundVars) = Data.List.partition (\(_, l) -> l <= lev - 1) fv
+    let envVars =
+            (map (\(v, _) -> (v, VarLocal v)) boundVars)
+                ++ (map (\(v, _) -> (v, VarEnv v)) freeVars')
+    return envVars
 
 ------------------------------------------------------------
 -- Main translation
 ------------------------------------------------------------
 
-transFields fields = do 
-          let (ff, vv) = unzip fields 
-          lst' <- transVars vv 
-          return $ zip ff lst'
+transFields fields = do
+    let (ff, vv) = unzip fields
+    lst' <- transVars vv
+    return $ zip ff lst'
 
 cpsToIR :: CPS.KTerm -> CC CCIR.IRBBTree
-cpsToIR (CPS.LetSimple vname@(VN ident) st kt) = do 
+cpsToIR (CPS.LetSimple vname@(VN ident) st kt) = do
     i <-
-      let _assign arg = return $ Just $ CCIR.Assign vname arg in
-      case st of 
-        CPS.Base base -> _assign  $ Base base
-        CPS.Lib lib base -> _assign (Lib lib base)
-        CPS.Bin binop v1 v2 -> do
-          v1' <- transVar v1 
-          v2' <- transVar v2
-          _assign (Bin binop v1' v2')
-        CPS.Un unop v -> do 
-          v' <- transVar v
-          _assign (Un unop v')
-        CPS.Tuple lst -> do 
-          lst' <- transVars lst 
-          _assign (Tuple lst')
-        CPS.Record fields -> do
-          fields' <- transFields fields
-          _assign (Record fields')
-        CPS.WithRecord x fields -> do
-          x' <- transVar x 
-          fields' <- transFields fields
-          _assign $ WithRecord x' fields'
-        CPS.ProjField x f -> do
-          x' <- transVar x 
-          _assign (ProjField x' f)
-        CPS.ProjIdx x idx -> do
-          x' <- transVar x 
-          _assign (ProjIdx x' idx)
-        CPS.List lst -> do 
-          lst' <- transVars lst 
-          _assign (List lst')
-        CPS.ListCons v1 v2 -> do 
-          v1' <- transVar v1 
-          v2' <- transVar v2 
-          _assign (ListCons v1' v2')
-        CPS.ValSimpleTerm (CPS.Lit lit) -> do lev <- askLev  
-                                              tell ([],[],[((vname, lit), lev)])
-                                              return Nothing 
-        CPS.ValSimpleTerm (CPS.KAbs klam) -> do 
-          freeVars <- transFunDec vname klam          
-          envBindings <- mkEnvBindings freeVars
-          return $ Just $ CCIR.MkFunClosures envBindings [(vname, HFN ident)]          
-        
-    t <- local (insVar vname) (cpsToIR kt)   
-    return $ case i of 
-      Just i' -> i' `consBB` t
-      Nothing -> t 
-
+        let _assign arg = return $ Just $ CCIR.Assign vname arg
+         in case st of
+                CPS.Base base -> _assign $ Base base
+                CPS.Lib lib base -> _assign (Lib lib base)
+                CPS.Bin binop v1 v2 -> do
+                    v1' <- transVar v1
+                    v2' <- transVar v2
+                    _assign (Bin binop v1' v2')
+                CPS.Un unop v -> do
+                    v' <- transVar v
+                    _assign (Un unop v')
+                CPS.Tuple lst -> do
+                    lst' <- transVars lst
+                    _assign (Tuple lst')
+                CPS.Record fields -> do
+                    fields' <- transFields fields
+                    _assign (Record fields')
+                CPS.WithRecord x fields -> do
+                    x' <- transVar x
+                    fields' <- transFields fields
+                    _assign $ WithRecord x' fields'
+                CPS.ProjField x f -> do
+                    x' <- transVar x
+                    _assign (ProjField x' f)
+                CPS.ProjIdx x idx -> do
+                    x' <- transVar x
+                    _assign (ProjIdx x' idx)
+                CPS.List lst -> do
+                    lst' <- transVars lst
+                    _assign (List lst')
+                CPS.ListCons v1 v2 -> do
+                    v1' <- transVar v1
+                    v2' <- transVar v2
+                    _assign (ListCons v1' v2')
+                CPS.ValSimpleTerm (CPS.Lit lit) -> do
+                    lev <- askLev
+                    tell ([], [], [((vname, lit), lev)])
+                    return Nothing
+                CPS.ValSimpleTerm (CPS.KAbs klam) -> do
+                    freeVars <- transFunDec vname klam
+                    envBindings <- mkEnvBindings freeVars
+                    return $ Just $ CCIR.MkFunClosures envBindings [(vname, HFN ident)]
+
+    t <- local (insVar vname) (cpsToIR kt)
+    return $ case i of
+        Just i' -> i' `consBB` t
+        Nothing -> t
 cpsToIR (CPS.LetRet (CPS.Cont arg kt') kt) = do
-    t  <- cpsToIR kt
+    t <- cpsToIR kt
     t' <- local (insVar arg) (cpsToIR kt')
     return $ CCIR.BB [] $ Call arg t t'
-cpsToIR (CPS.LetFun fdefs kt) = do 
+cpsToIR (CPS.LetFun fdefs kt) = do
     let vnames_orig = map (\(CPS.Fun fname _) -> fname) fdefs
     let localExt = local (insVars vnames_orig)
     t <- localExt (cpsToIR kt) -- translate the body
-
-    frees <- mapM (\(CPS.Fun fname klam) -> 
-                        localExt (transFunDec fname klam)) 
-                fdefs
-
-    let freeVars = (nub.concat) frees 
+    frees <-
+        mapM
+            ( \(CPS.Fun fname klam) ->
+                localExt (transFunDec fname klam)
+            )
+            fdefs
+
+    let freeVars = (nub . concat) frees
     lev <- askLev
     let vnames_orig' = map (\x -> (x, lev)) vnames_orig
     envBindings <- mkEnvBindings (freeVars \\ vnames_orig')
@@ -219,44 +213,36 @@ cpsToIR (CPS.LetFun fdefs kt) = do
     return $ (CCIR.MkFunClosures envBindings fnBindings) `consBB` t
 
 -- Special Halt continuation, for exiting program
-cpsToIR (CPS.Halt v) = do 
+cpsToIR (CPS.Halt v) = do
     v' <- transVar v
-    (compileMode,_ , _ , _, _ ) <- ask 
+    (compileMode, _, _, _, _) <- ask
     let constructor =
-          case compileMode of
-              Normal -> CCIR.Ret
-              -- Compiling library, then generate export instruction
-              Export -> CCIR.LibExport
+            case compileMode of
+                Normal -> CCIR.Ret
+                -- Compiling library, then generate export instruction
+                Export -> CCIR.LibExport
 
     return $ CCIR.BB [] $ constructor v'
-
-cpsToIR (CPS.KontReturn v) = do 
-  v' <- transVar v 
-  return $ CCIR.BB [] $ CCIR.Ret v'
-
-cpsToIR (CPS.ApplyFun fname v) = do 
-  fname' <- transVar fname 
-  v'     <- transVar v 
-  return $ CCIR.BB [] $ CCIR.TailCall fname' v'
-
-cpsToIR (CPS.If v kt1 kt2) = do 
-  v' <- transVar v 
-  bb1 <- cpsToIR kt1 
-  bb2 <- cpsToIR kt2 
-  return $ CCIR.BB [] $ CCIR.If v' bb1 bb2
-
-cpsToIR (CPS.AssertElseError v kt1 z p) = do 
-  v' <- transVar v 
-  z' <- transVar z 
-  bb <- cpsToIR kt1 
-  return $ CCIR.BB [] $ CCIR.AssertElseError v' bb z' p
-
-cpsToIR (CPS.Error v p) = do 
-  v' <- transVar v 
-  return $ CCIR.BB [] $ CCIR.Error v' p
-  
-
-
+cpsToIR (CPS.KontReturn v) = do
+    v' <- transVar v
+    return $ CCIR.BB [] $ CCIR.Ret v'
+cpsToIR (CPS.ApplyFun fname v) = do
+    fname' <- transVar fname
+    v' <- transVar v
+    return $ CCIR.BB [] $ CCIR.TailCall fname' v'
+cpsToIR (CPS.If v kt1 kt2) = do
+    v' <- transVar v
+    bb1 <- cpsToIR kt1
+    bb2 <- cpsToIR kt2
+    return $ CCIR.BB [] $ CCIR.If v' bb1 bb2
+cpsToIR (CPS.AssertElseError v kt1 z p) = do
+    v' <- transVar v
+    z' <- transVar z
+    bb <- cpsToIR kt1
+    return $ CCIR.BB [] $ CCIR.AssertElseError v' bb z' p
+cpsToIR (CPS.Error v p) = do
+    v' <- transVar v
+    return $ CCIR.BB [] $ CCIR.Error v' p
 
 ------------------------------------------------------------
 -- Top-level function
@@ -264,30 +250,29 @@ cpsToIR (CPS.Error v p) = do
 
 closureConvert :: CompileMode -> CPS.Prog -> Except String CCIR.IRProgram
 closureConvert compileMode (CPS.Prog (C.Atoms atms) t) =
-  let atms' = C.Atoms atms
-      initEnv = ( compileMode
-                , atms'
-                , 0 -- initial nesting counter
-                , Map.empty
-                , Nothing -- top level code has no function name 
-                )
-      initState = 0
-      (bb, (fdefs, _, consts_wo_levs)) = evalRWS (cpsToIR t) initEnv initState
-      (argumentName, toplevel) =
-         case compileMode of
-           Normal -> ("$$authorityarg", "main") -- passing authority through the argument to main 
-           Export -> ("$$dummy", "export")
-
-      -- obs that our 'main' may have two names depending on the compilation mode; 2018-07-02; AA
-      consts = (fst.unzip) consts_wo_levs
-      main = FunDef (HFN toplevel) (VN argumentName) consts bb
-
-      irProg = CCIR.IRProgram (C.Atoms atms) $ fdefs++[main]
-    in do CCIR.wfIRProg irProg 
-          return irProg
-    -- then irProg
-    --                       else error "the generated IR is not well-formed"
-
-               
-  
-  
+    let atms' = C.Atoms atms
+        initEnv =
+            ( compileMode
+            , atms'
+            , 0 -- initial nesting counter
+            , Map.empty
+            , Nothing -- top level code has no function name
+            )
+        initState = 0
+        (bb, (fdefs, _, consts_wo_levs)) = evalRWS (cpsToIR t) initEnv initState
+        (argumentName, toplevel) =
+            case compileMode of
+                Normal -> ("$$authorityarg", "main") -- passing authority through the argument to main
+                Export -> ("$$dummy", "export")
+
+        -- obs that our 'main' may have two names depending on the compilation mode; 2018-07-02; AA
+        consts = (fst . unzip) consts_wo_levs
+        main = FunDef (HFN toplevel) (VN argumentName) consts bb
+
+        irProg = CCIR.IRProgram (C.Atoms atms) $ fdefs ++ [main]
+     in do
+            CCIR.wfIRProg irProg
+            return irProg
+
+-- then irProg
+--                       else error "the generated IR is not well-formed"
diff --git a/compiler/src/CompileMode.hs b/compiler/src/CompileMode.hs
index e5de67a6..5f31aed3 100644
--- a/compiler/src/CompileMode.hs
+++ b/compiler/src/CompileMode.hs
@@ -1,4 +1,4 @@
 module CompileMode
-  where
+where
 
 data CompileMode = Normal | Export
diff --git a/compiler/src/Consts.hs b/compiler/src/Consts.hs
index a0a3f456..6a92aef5 100644
--- a/compiler/src/Consts.hs
+++ b/compiler/src/Consts.hs
@@ -4,7 +4,7 @@ module Consts where
 
 -- | 2^31-1
 llvm_i32_maxBound :: Int
-llvm_i32_maxBound = 2147483647 
+llvm_i32_maxBound = 2147483647
 
 llvm_maxIndex :: Int
-llvm_maxIndex = llvm_i32_maxBound
\ No newline at end of file
+llvm_maxIndex = llvm_i32_maxBound
diff --git a/compiler/src/Core.hs b/compiler/src/Core.hs
index 72af085f..643312d3 100644
--- a/compiler/src/Core.hs
+++ b/compiler/src/Core.hs
@@ -1,54 +1,62 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveGeneric #-}
 
-
-module Core (   Lambda (..)
-              , Term (..)
-              , Decl (..)
-              , FunDecl (..)
-              , Lit(..)
-              , AtomName
-              , Atoms(..)
-              , Prog(..)
-              , VarAccess(..)
-              , lowerProg
-              , renameProg
-              , ppLit
-              )
+module Core (
+    Lambda (..),
+    Term (..),
+    Decl (..),
+    FunDecl (..),
+    Lit (..),
+    AtomName,
+    Atoms (..),
+    Prog (..),
+    VarAccess (..),
+    lowerProg,
+    renameProg,
+    ppLit,
+)
 where
-import GHC.Generics(Generic)
+
 import Data.Serialize (Serialize)
+import GHC.Generics (Generic)
 
-import qualified Data.Ord 
-import           Basics
-import qualified DirectWOPats as D
+import Basics
+import Control.Monad
+import Control.Monad.RWS
+import Control.Monad.State.Lazy as State
 import qualified Data.Map.Strict as Map
-import           Control.Monad
-import           Control.Monad.State.Lazy as State
-import           Control.Monad.RWS
+import qualified Data.Ord
+import qualified DirectWOPats as D
 
+import ShowIndent
+import Text.PrettyPrint.HughesPJ (
+    hsep,
+    nest,
+    text,
+    vcat,
+    ($$),
+    (<+>),
+ )
 import qualified Text.PrettyPrint.HughesPJ as PP
-import           Text.PrettyPrint.HughesPJ (
-   (<+>), ($$), text, hsep, vcat, nest, nest)
-import           ShowIndent
 
-import           TroupePositionInfo
-import           DCLabels
+import DCLabels
+import TroupePositionInfo
 
 --------------------------------------------------
 -- AST is the same as Direct, but lambda are unary (or nullary)
 
-data Lambda = Unary VarName Term
-            | Nullary Term
-  deriving (Eq)
+data Lambda
+    = Unary VarName Term
+    | Nullary Term
+    deriving (Eq)
 
 data Decl
     = ValDecl VarName Term
     | FunDecs [FunDecl]
-  deriving (Eq )
+    deriving (Eq)
 
 data FunDecl = FunDecl VarName Lambda
-  deriving (Eq)
+    deriving (Eq)
 
 data Lit
     = LInt Integer PosInf
@@ -58,47 +66,47 @@ data Lit
     | LUnit
     | LBool Bool
     | LAtom AtomName
-  deriving (Show, Generic)
+    deriving (Generic, Show)
 instance Serialize Lit
-instance Eq Lit where 
-  (LInt x _) == (LInt y _) = x == y
-  (LString s) == (LString s') = s == s' 
-  (LLabel l) == (LLabel l') = l == l' 
-  LUnit == LUnit = True 
-  (LBool x) == (LBool y) = x == y 
-  (LAtom x) == (LAtom y) = x == y
-  (LDCLabel dc) == (LDCLabel dc') = dc == dc' 
-  _ == _ = False
-instance Ord Lit where 
-  (LInt x _)   <= (LInt y _)   = x <= y
-  (LString x ) <= (LString y)  = x <=y
-  (LLabel x)   <= (LLabel y)   = x <=y
-  (LUnit)      <= (LUnit)      = True 
-  (LBool x)    <= (LBool y)    = x <=y
-  (LAtom x)    <= (LAtom y)    = x <=y
-  (LDCLabel x) <= (LDCLabel y) = x <= y
-  (LInt _ _)   <= (LString _)  = True 
-  (LString _)  <= (LLabel _)   = True 
-  (LLabel _)   <= (LUnit)      = True 
-  (LUnit)      <= (LBool _)    = True 
-  (LBool _)    <= (LAtom _)    = True 
-  (LAtom _)    <= (LDCLabel _) = True
-  _ <= _                       = False 
+instance Eq Lit where
+    (LInt x _) == (LInt y _) = x == y
+    (LString s) == (LString s') = s == s'
+    (LLabel l) == (LLabel l') = l == l'
+    LUnit == LUnit = True
+    (LBool x) == (LBool y) = x == y
+    (LAtom x) == (LAtom y) = x == y
+    (LDCLabel dc) == (LDCLabel dc') = dc == dc'
+    _ == _ = False
+instance Ord Lit where
+    (LInt x _) <= (LInt y _) = x <= y
+    (LString x) <= (LString y) = x <= y
+    (LLabel x) <= (LLabel y) = x <= y
+    (LUnit) <= (LUnit) = True
+    (LBool x) <= (LBool y) = x <= y
+    (LAtom x) <= (LAtom y) = x <= y
+    (LDCLabel x) <= (LDCLabel y) = x <= y
+    (LInt _ _) <= (LString _) = True
+    (LString _) <= (LLabel _) = True
+    (LLabel _) <= (LUnit) = True
+    (LUnit) <= (LBool _) = True
+    (LBool _) <= (LAtom _) = True
+    (LAtom _) <= (LDCLabel _) = True
+    _ <= _ = False
 
 instance GetPosInfo Lit where
-  posInfo (LInt _ p) = p
-  posInfo _ = NoPos
+    posInfo (LInt _ p) = p
+    posInfo _ = NoPos
 
 type Fields = [(FieldName, Term)]
 
 data VarAccess
-    -- | A normal variable
-    = RegVar VarName
-    -- | Referring to a definition from a library
-    | LibVar LibName VarName
-    -- | A predefined name (e.g. send, receive)
-    | BaseName VarName
- deriving (Eq)
+    = -- | A normal variable
+      RegVar VarName
+    | -- | Referring to a definition from a library
+      LibVar LibName VarName
+    | -- | A predefined name (e.g. send, receive)
+      BaseName VarName
+    deriving (Eq)
 data Term
     = Lit Lit
     | Var VarAccess
@@ -108,28 +116,25 @@ data Term
     | If Term Term Term
     | AssertElseError Term Term Term PosInf
     | Tuple [Term]
-    | Record Fields 
+    | Record Fields
     | WithRecord Term Fields
-    | ProjField Term FieldName 
+    | ProjField Term FieldName
     | ProjIdx Term Word
     | List [Term]
     | ListCons Term Term
     | Bin BinOp Term Term
     | Un UnaryOp Term
     | Error Term PosInf
-  deriving (Eq)
-
+    deriving (Eq)
 
 data Atoms = Atoms [AtomName]
-  deriving (Eq, Show, Generic)
+    deriving (Eq, Generic, Show)
 instance Serialize Atoms
 
-
 data Prog = Prog Imports Atoms Term
-  deriving (Eq, Show)
-
+    deriving (Eq, Show)
 
-{-- 
+{--
 
 This module defines the Core front-level intermediate representation,
 and includes two phases of the compilation pipeline that involve that
@@ -143,28 +148,23 @@ representation.
 
 The module also contains pretty printing for the Core representation.
 
-
 --}
 
-
 --------------------------------------------------
--- 1. Lowering 
+-- 1. Lowering
 --------------------------------------------------
 
 lowerProg (D.Prog imports atms term) = Prog imports (trans atms) (lower term)
 
-
-
 -- the rest of the declarations in this part are not exported
 
 trans :: D.Atoms -> Atoms
 trans (D.Atoms atms) = Atoms atms
 
 lowerLam (D.Lambda vs t) =
-  case vs of
-    [] -> Unary "$unit" (lower t)
-    x:xs -> Unary x (foldr (\x b -> (Abs (Unary x b))) (lower t) xs)
-
+    case vs of
+        [] -> Unary "$unit" (lower t)
+        x : xs -> Unary x (foldr (\x b -> (Abs (Unary x b))) (lower t) xs)
 
 lowerLit (D.LInt n pi) = LInt n pi
 lowerLit (D.LString s) = LString s
@@ -178,56 +178,53 @@ lower :: D.Term -> Core.Term
 lower (D.Lit l) = Lit (lowerLit l)
 lower (D.Error t p) = Error (lower t) p
 lower (D.Var v) = Var (RegVar v)
-  -- 2018-07-01: AA: note that we are mapping all vars to RegVar at
-  -- this stage. This is a bit of a hack. A cleaner apporach is to
-  -- have a separate intermediate representation. For now we save on
-  -- the engineering effort and proceed like this, because at the
-  -- subsequent phase (renaming) we resolve which names are base
-  -- names, which are lib names, and which are actually just regular
-  -- variables.
+-- 2018-07-01: AA: note that we are mapping all vars to RegVar at
+-- this stage. This is a bit of a hack. A cleaner apporach is to
+-- have a separate intermediate representation. For now we save on
+-- the engineering effort and proceed like this, because at the
+-- subsequent phase (renaming) we resolve which names are base
+-- names, which are lib names, and which are actually just regular
+-- variables.
 
 lower (D.Abs lam) = Abs (lowerLam lam)
-
 lower (D.App e []) = Core.App (lower e) (Lit LUnit) -- does this form even exist?
 lower (D.App e es) = foldl Core.App (lower e) (map lower es)
 lower (D.Let decls e) =
-  foldr (\ decl t -> Let (lowerDecl decl) t) (lower e) decls
-  where lowerDecl (D.ValDecl vname e) = ValDecl vname (lower e)
-        lowerDecl (D.FunDecs decs) = FunDecs (map lowerFun decs)
-        lowerFun  (D.FunDecl v lam) = FunDecl v (lowerLam lam)
+    foldr (\decl t -> Let (lowerDecl decl) t) (lower e) decls
+  where
+    lowerDecl (D.ValDecl vname e) = ValDecl vname (lower e)
+    lowerDecl (D.FunDecs decs) = FunDecs (map lowerFun decs)
+    lowerFun (D.FunDecl v lam) = FunDecl v (lowerLam lam)
 -- lower (D.Case t patTermLst) = Case (lower t) (map (\(p,t) -> (lowerDeclPat p, lower t)) patTermLst)
 lower (D.If e1 e2 e3) = If (lower e1) (lower e2) (lower e3)
-lower (D.AssertElseError e1 e2 e3 p) = AssertElseError (lower e1 ) (lower e2) (lower e3) p
+lower (D.AssertElseError e1 e2 e3 p) = AssertElseError (lower e1) (lower e2) (lower e3) p
 lower (D.Tuple terms) = Tuple (map lower terms)
 lower (D.Record fields) = Record (map (\(f, t) -> (f, lower t)) fields)
-lower (D.WithRecord  e fields) = WithRecord (lower e) (map (\(f, t) -> (f, lower t)) fields)
+lower (D.WithRecord e fields) = WithRecord (lower e) (map (\(f, t) -> (f, lower t)) fields)
 lower (D.ProjField t f) = ProjField (lower t) f
 lower (D.ProjIdx t idx) = ProjIdx (lower t) idx
 lower (D.List terms) = List (map lower terms)
 lower (D.ListCons t1 t2) = ListCons (lower t1) (lower t2)
-
 -- special casing shortcutting semantics; 2018-03-06;
 lower (D.Bin And e1 e2) = lower (D.If e1 e2 (D.Lit (D.LBool False)))
 lower (D.Bin Or e1 e2) = lower (D.If e1 (D.Lit (D.LBool True)) e2)
 lower (D.Bin op e1 e2) = Bin op (lower e1) (lower e2)
 lower (D.Un op e) = Un op (lower e)
 
-
 --------------------------------------------------
 -- 2. α-RENAMING
 --------------------------------------------------
 
-
 -- This is the only function that is exported here
 
 renameProg :: Prog -> Prog
 renameProg (Prog imports (Atoms atms) term) =
-  let alist = map (\ a -> (a, a)) atms
-      initEnv    = Map.fromList alist
-      initReader = mapFromImports imports
-      initState  = 0
-      (term', _) = evalRWS (rename term initEnv) initReader initState
-  in Prog imports (Atoms atms) term'
+    let alist = map (\a -> (a, a)) atms
+        initEnv = Map.fromList alist
+        initReader = mapFromImports imports
+        initState = 0
+        (term', _) = evalRWS (rename term initEnv) initReader initState
+     in Prog imports (Atoms atms) term'
 
 -- The rest of the declarations here are not exported
 
@@ -235,336 +232,295 @@ renameProg (Prog imports (Atoms atms) term) =
 
 The renaming occurs in RWS monad that is instantiated as follows:
 
-* The reader is the library environment
-* The state is the unique variable counter
-* The output is not used so we instantiate it to a dummy unit type
+\* The reader is the library environment
+\* The state is the unique variable counter
+\* The output is not used so we instantiate it to a dummy unit type
 
 Note that the environment used for tracking α-substitutions is being
 threaded explicitly. That is encoded in the `Env` map.
 
 --}
 
-
 type S = RWS LibEnv () Integer
 
 type LibEnv = Map.Map VarName LibName
-type Env    = Map.Map VarName VarName
-
+type Env = Map.Map VarName VarName
 
 mapFromImports :: Imports -> LibEnv
 mapFromImports (Imports imports) =
-  foldl insLib Map.empty imports
-     where
-       insLib map (lib, Just defs) =
-             foldl (\map def -> Map.insert def lib map) map defs
-       insLib map (lib, Nothing) = error "malformed lib import data structure"
-           -- TODO: 2018-07-02; better error message for the above case
-           -- or even better: a data structure that avoids needing to make a check like that
-           -- (we should be in theory able to do that)
+    foldl insLib Map.empty imports
+  where
+    insLib map (lib, Just defs) =
+        foldl (\map def -> Map.insert def lib map) map defs
+    insLib map (lib, Nothing) = error "malformed lib import data structure"
 
+-- TODO: 2018-07-02; better error message for the above case
+-- or even better: a data structure that avoids needing to make a check like that
+-- (we should be in theory able to do that)
 
 -- | Sanitize variable names to be JavaScript-compatible identifiers
 sanitizeForJS :: VarName -> VarName
 sanitizeForJS = map sanitizeChar
   where
-    sanitizeChar '\'' = '_'  -- Replace single quotes with underscores
-    sanitizeChar c = c        -- Keep other characters as-is
+    sanitizeChar '\'' = '_' -- Replace single quotes with underscores
+    sanitizeChar c = c -- Keep other characters as-is
 
 unique :: VarName -> S VarName
 unique v = do
-  n <- State.get
-  put (n + 1)
-  return $ sanitizeForJS v ++ show n
-
+    n <- State.get
+    put (n + 1)
+    return $ sanitizeForJS v ++ show n
 
 lookforalpha :: VarName -> Env -> VarName
 lookforalpha v m = Map.findWithDefault v v m
 
-
 lookforgen :: VarName -> Env -> S VarAccess
 lookforgen v m =
     case Map.lookup v m of
-       Just v -> return $ RegVar v
-       Nothing -> do
-          libmap <- ask
-          case Map.lookup v libmap of
-            Just lib' -> return $ LibVar lib' v
-            Nothing -> return  $ BaseName v
-
+        Just v -> return $ RegVar v
+        Nothing -> do
+            libmap <- ask
+            case Map.lookup v libmap of
+                Just lib' -> return $ LibVar lib' v
+                Nothing -> return $ BaseName v
 
 extend :: VarName -> VarName -> Env -> Env
 extend v v' m = Map.insert v v' m
 
 rename :: Core.Term -> Env -> S Core.Term
 rename (Lit l) m = return (Lit l)
-rename (Error t p) m = do 
-      t' <- rename t m 
-      return $ Error t' p
+rename (Error t p) m = do
+    t' <- rename t m
+    return $ Error t' p
 rename (Var (RegVar v)) m = do
-  v <- lookforgen v m
-  return $ Var v
-
-
-rename (Var x) m  = return $ Var x
+    v <- lookforgen v m
+    return $ Var v
+rename (Var x) m = return $ Var x
 rename (Abs l) m =
-  liftM Abs $ renameLambda l m
+    liftM Abs $ renameLambda l m
 rename (App t1 t2) m = do
-  t1' <- rename t1 m
-  t2' <- rename t2 m
-  return $ App t1' t2'
+    t1' <- rename t1 m
+    t2' <- rename t2 m
+    return $ App t1' t2'
 rename (Let decl t) m = do
-  (m', decl') <- renameDecl decl m
-  t' <- rename t m'
-  return $ Let decl' t'
-
+    (m', decl') <- renameDecl decl m
+    t' <- rename t m'
+    return $ Let decl' t'
 rename (If t1 t2 t3) m = do
-  t1' <- rename t1 m
-  t2' <- rename t2 m
-  t3' <- rename t3 m
-  return $ If t1' t2' t3'
-
-rename (AssertElseError t1 t2 t3 p) m = do  
-  t1' <- rename t1 m
-  t2' <- rename t2 m
-  t3' <- rename t3 m
-  return $ AssertElseError t1' t2' t3' p
-
-
+    t1' <- rename t1 m
+    t2' <- rename t2 m
+    t3' <- rename t3 m
+    return $ If t1' t2' t3'
+rename (AssertElseError t1 t2 t3 p) m = do
+    t1' <- rename t1 m
+    t2' <- rename t2 m
+    t3' <- rename t3 m
+    return $ AssertElseError t1' t2' t3' p
 rename (Tuple terms) m =
-  Tuple <$> mapM (flip rename m) terms
-
-rename (Record fields) m = 
-  Record <$> mapM renameField fields 
-     where renameField (f, t) = do 
-                   t' <- rename t m 
-                   return (f, t')
-
-rename (WithRecord e fields) m = do 
-  t' <- rename e m 
-  fs <- mapM renameField fields 
-  return $ WithRecord  t' fs
-  where renameField (f, t) = do 
-                   t' <- rename t m 
-                   return (f, t')
-  
+    Tuple <$> mapM (flip rename m) terms
+rename (Record fields) m =
+    Record <$> mapM renameField fields
+  where
+    renameField (f, t) = do
+        t' <- rename t m
+        return (f, t')
+rename (WithRecord e fields) m = do
+    t' <- rename e m
+    fs <- mapM renameField fields
+    return $ WithRecord t' fs
+  where
+    renameField (f, t) = do
+        t' <- rename t m
+        return (f, t')
 rename (ProjField t f) m = do
-  t' <- rename t m
-  return $ ProjField t' f
+    t' <- rename t m
+    return $ ProjField t' f
 rename (ProjIdx t idx) m = do
-  t' <- rename t m
-  return $ ProjIdx t' idx
+    t' <- rename t m
+    return $ ProjIdx t' idx
 rename (List terms) m =
-  List <$> mapM (flip rename m) terms
+    List <$> mapM (flip rename m) terms
 rename (ListCons t1 t2) m = do
-  t1' <- rename t1 m
-  t2' <- rename t2 m
-  return $ ListCons  t1' t2'
+    t1' <- rename t1 m
+    t2' <- rename t2 m
+    return $ ListCons t1' t2'
 rename (Bin op t1 t2) m = do
-  t1' <- rename t1 m
-  t2' <- rename t2 m
-  return $ Bin op t1' t2'
+    t1' <- rename t1 m
+    t2' <- rename t2 m
+    return $ Bin op t1' t2'
 rename (Un op e) m = do
-  e' <- rename e m
-  return $ Un op e'
+    e' <- rename e m
+    return $ Un op e'
 
 renameLambda :: Core.Lambda -> Env -> S Core.Lambda
 renameLambda (Unary v t) m = do
-  v' <- unique v
-  t' <- rename t $ extend v v' m
-  return $ Unary v' t'
+    v' <- unique v
+    t' <- rename t $ extend v v' m
+    return $ Unary v' t'
 renameLambda (Nullary t) m = do
-  t' <- rename t m
-  return $ Nullary t'
-
+    t' <- rename t m
+    return $ Nullary t'
 
 renameDecl :: Decl -> (Map.Map VarName VarName) -> S (Map.Map VarName VarName, Decl)
 renameDecl (ValDecl v t) m = do
-  v' <- unique v
-  let m' = extend v v' m
-  t' <- rename t m
-  let decl' = (ValDecl v' t')
-  return (m', decl')
-
+    v' <- unique v
+    let m' = extend v v' m
+    t' <- rename t m
+    let decl' = (ValDecl v' t')
+    return (m', decl')
 renameDecl (FunDecs decs) m = do
-  m' <- foldM ext_funDecl m decs
-  decs' <- mapM (\(FunDecl v l) -> liftM (FunDecl (lookforalpha v m')) (renameLambda l m')) decs
-  let decl' = (FunDecs decs')
-  return (m', decl')
-  where ext_funDecl m (FunDecl v _) = do
-          v' <- unique v
-          return $ extend v v' m
-
-
+    m' <- foldM ext_funDecl m decs
+    decs' <- mapM (\(FunDecl v l) -> liftM (FunDecl (lookforalpha v m')) (renameLambda l m')) decs
+    let decl' = (FunDecs decs')
+    return (m', decl')
+  where
+    ext_funDecl m (FunDecl v _) = do
+        v' <- unique v
+        return $ extend v v' m
 
 --------------------------------------------------
 -- 3. Pretty printing
 --------------------------------------------------
 
-
 -- show is defined via pretty printing
-instance Show Term
-  where show t = PP.render (ppTerm 0 t)
+instance Show Term where
+    show t = PP.render (ppTerm 0 t)
 
 instance ShowIndent Prog where
-  showIndent k t = PP.render (nest k (ppProg t))
---------------------------------------------------
-
-
+    showIndent k t = PP.render (nest k (ppProg t))
 
+--------------------------------------------------
 
 ppProg :: Prog -> PP.Doc
 ppProg (Prog (Imports imports) (Atoms atoms) term) =
-  let ppAtoms =
-        if null atoms
-          then PP.empty
-          else (text "datatype Atoms = ") <+>
-               (hsep $ PP.punctuate (text " |") (map text atoms))
-
-      ppImports = if null imports then PP.empty else text "<<imports>>\n"
-  in ppImports $$ ppAtoms $$ ppTerm 0 term
+    let ppAtoms =
+            if null atoms
+                then PP.empty
+                else
+                    (text "datatype Atoms = ")
+                        <+> (hsep $ PP.punctuate (text " |") (map text atoms))
 
+        ppImports = if null imports then PP.empty else text "<<imports>>\n"
+     in ppImports $$ ppAtoms $$ ppTerm 0 term
 
 ppTerm :: Precedence -> Term -> PP.Doc
 ppTerm parentPrec t =
-   let thisTermPrec = termPrec t
-   in PP.maybeParens (thisTermPrec < parentPrec )
-      $ ppTerm' t
+    let thisTermPrec = termPrec t
+     in PP.maybeParens (thisTermPrec < parentPrec) $
+            ppTerm' t
 
-   -- uncomment to pretty print explicitly; 2017-10-14: AA
-   -- in PP.maybeParens (thisTermPrec < 10000)  $ ppTerm' t
+-- uncomment to pretty print explicitly; 2017-10-14: AA
+-- in PP.maybeParens (thisTermPrec < 10000)  $ ppTerm' t
 
 ppTerm' :: Term -> PP.Doc
 ppTerm' (Lit literal) = ppLit literal
-
 ppTerm' (Error t _) = text "error " PP.<> ppTerm' t
-
-ppTerm'  (Tuple ts) =
-  PP.parens $
-  PP.hcat $
-  PP.punctuate (text ",") (map (ppTerm 0) ts)
-
-ppTerm'  (List ts) =
-  PP.brackets $
-  PP.hcat $
-  PP.punctuate (text ",") (map (ppTerm 0) ts)
-
+ppTerm' (Tuple ts) =
+    PP.parens $
+        PP.hcat $
+            PP.punctuate (text ",") (map (ppTerm 0) ts)
+ppTerm' (List ts) =
+    PP.brackets $
+        PP.hcat $
+            PP.punctuate (text ",") (map (ppTerm 0) ts)
 ppTerm' (Record fs) = PP.braces $ qqFields fs
-
-ppTerm' (WithRecord e fs) = 
-    PP.braces $ PP.hsep [ ppTerm 0 e, text "with", qqFields fs]
-
+ppTerm' (WithRecord e fs) =
+    PP.braces $ PP.hsep [ppTerm 0 e, text "with", qqFields fs]
 ppTerm' (ProjField t fn) =
-  ppTerm projPrec t PP.<> text "." PP.<> PP.text fn
-
+    ppTerm projPrec t PP.<> text "." PP.<> PP.text fn
 ppTerm' (ProjIdx t idx) =
-  ppTerm projPrec t PP.<> text "." PP.<> PP.text (show idx)
-
-
+    ppTerm projPrec t PP.<> text "." PP.<> PP.text (show idx)
 ppTerm' (ListCons hd tl) =
-   ppTerm consPrec hd PP.<> text "::" PP.<> ppTerm consPrec tl
-
+    ppTerm consPrec hd PP.<> text "::" PP.<> ppTerm consPrec tl
 ppTerm' (Var (RegVar x)) = text x
 ppTerm' (Var (LibVar (LibName lib) var)) = text lib <+> text "." <+> text var
 ppTerm' (Var (BaseName v)) = text v
 ppTerm' (Abs lam) =
-  let (ppArgs, ppBody) = qqLambda lam
-  in text "fn" <+> ppArgs <+> text "=>" <+> ppBody
-
+    let (ppArgs, ppBody) = qqLambda lam
+     in text "fn" <+> ppArgs <+> text "=>" <+> ppBody
 ppTerm' (App t1 t2s) =
     ppTerm appPrec t1
-          <+> (ppTerm argPrec t2s)
-
+        <+> (ppTerm argPrec t2s)
 ppTerm' (Let dec body) =
-  text "let" <+>
-  nest 3 (ppDecl dec) $$
-  text "in" <+>
-  nest 3 (ppTerm 0 body) $$
-  text "end"
-
-
+    text "let"
+        <+> nest 3 (ppDecl dec)
+        $$ text "in"
+            <+> nest 3 (ppTerm 0 body)
+        $$ text "end"
 ppTerm' (If e0 e1 e2) =
-  text "if" <+>
-  ppTerm 0 e0 $$
-  text "then" <+>
-  ppTerm 0 e1 $$
-  text "else" <+>
-  ppTerm 0 e2
-
+    text "if"
+        <+> ppTerm 0 e0
+        $$ text "then"
+            <+> ppTerm 0 e1
+        $$ text "else"
+            <+> ppTerm 0 e2
 ppTerm' (AssertElseError e0 e1 e2 _) =
-  text "assert" <+>
-  ppTerm 0 e0 $$
-  text "then" <+>
-  ppTerm 0 e1 $$
-  text "elseError" <+>
-  ppTerm 0 e2
-
-
-
+    text "assert"
+        <+> ppTerm 0 e0
+        $$ text "then"
+            <+> ppTerm 0 e1
+        $$ text "elseError"
+            <+> ppTerm 0 e2
 ppTerm' (Bin op t1 t2) =
-  let binOpPrec = opPrec op
-  in
-     ppTerm binOpPrec t1 <+>
-     text (show op) <+>
-     ppTerm binOpPrec t2
-
+    let binOpPrec = opPrec op
+     in ppTerm binOpPrec t1
+            <+> text (show op)
+            <+> ppTerm binOpPrec t2
 ppTerm' (Un op t) =
-  let unOpPrec = op1Prec op
-  in
-     text (show op) <+>
-     ppTerm unOpPrec t
-
+    let unOpPrec = op1Prec op
+     in text (show op)
+            <+> ppTerm unOpPrec t
 
-qqFields fs = PP.hcat $
-    PP.punctuate (text ",") (map ppField fs)
-     where ppField (name, t)  = 
-              PP.hcat [PP.text name, PP.text "=", ppTerm 0 t ]
+qqFields fs =
+    PP.hcat $
+        PP.punctuate (text ",") (map ppField fs)
+  where
+    ppField (name, t) =
+        PP.hcat [PP.text name, PP.text "=", ppTerm 0 t]
 
 qqLambda :: Lambda -> (PP.Doc, PP.Doc)
 qqLambda (Unary arg body) =
-  ( text arg, ppTerm 0 body )
+    (text arg, ppTerm 0 body)
 qqLambda (Nullary body) =
-  ( text "()", ppTerm 0 body)
+    (text "()", ppTerm 0 body)
 
 ppDecl :: Decl -> PP.Doc
 ppDecl (ValDecl arg t) =
-  text "val" <+> text arg <+> text "="
-    <+> ppTerm 0 t
+    text "val"
+        <+> text arg
+        <+> text "="
+        <+> ppTerm 0 t
 ppDecl (FunDecs fs) = ppFuns fs
   where
     ppFunDecl prefix (FunDecl fname lam) =
-      ppFunOptions (prefix ++ " " ++ fname) lam
+        ppFunOptions (prefix ++ " " ++ fname) lam
 
     ppFunOptions prefix lam =
-        let (ppArgs, ppBody) = qqLambda lam in
-        text prefix <+> ppArgs <+> text "=" <+> nest 2 ppBody
-
-
-    ppFuns (doc:docs) =
-      let ppFirstFun = ppFunDecl "fun"
-          ppOtherFun = ppFunDecl "and"
-      in ppFirstFun doc $$ vcat (map ppOtherFun docs)
-
+        let (ppArgs, ppBody) = qqLambda lam
+         in text prefix <+> ppArgs <+> text "=" <+> nest 2 ppBody
 
+    ppFuns (doc : docs) =
+        let ppFirstFun = ppFunDecl "fun"
+            ppOtherFun = ppFunDecl "and"
+         in ppFirstFun doc $$ vcat (map ppOtherFun docs)
     ppFuns _ = PP.empty
 
-
 ppLit :: Lit -> PP.Doc
-ppLit (LInt i _)      = PP.integer i
-ppLit (LString s)   = PP.doubleQuotes (text s)
-ppLit (LLabel s)    = PP.braces (text s)
-ppLit LUnit         = text "()"
-ppLit (LBool True)  = text "true"
+ppLit (LInt i _) = PP.integer i
+ppLit (LString s) = PP.doubleQuotes (text s)
+ppLit (LLabel s) = PP.braces (text s)
+ppLit LUnit = text "()"
+ppLit (LBool True) = text "true"
 ppLit (LBool False) = text "false"
 ppLit (LAtom a) = text a
 ppLit (LDCLabel dc) = ppDCLabelExpLit dc
 
-
 termPrec :: Term -> Precedence
-termPrec (Lit _)         = maxPrec
-termPrec (Tuple _)       = maxPrec
-termPrec (List _ )       = maxPrec
-termPrec (Var _)         = maxPrec
-termPrec (App _ _)       = appPrec
-termPrec (Bin op _ _)    = opPrec op
-termPrec (ListCons _ _)  = 200
-termPrec _               = 0
+termPrec (Lit _) = maxPrec
+termPrec (Tuple _) = maxPrec
+termPrec (List _) = maxPrec
+termPrec (Var _) = maxPrec
+termPrec (App _ _) = appPrec
+termPrec (Bin op _ _) = opPrec op
+termPrec (ListCons _ _) = 200
+termPrec _ = 0
diff --git a/compiler/src/DCLabels.hs b/compiler/src/DCLabels.hs
index fbfd5aa4..9104e5de 100644
--- a/compiler/src/DCLabels.hs
+++ b/compiler/src/DCLabels.hs
@@ -1,94 +1,98 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
-
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
 {-# HLINT ignore "Use newtype instead of data" #-}
 
+module DCLabels (
+    DCLabelExp (..),
+    LabelExp (..),
+    LabelOp (..),
+    LabelConst (..),
+    ppDCLabelExp,
+    ppDCLabelExpLit,
+    labelExpToCNF,
+    dcLabelExpToDCLabel,
+) where
 
-module DCLabels 
-  ( DCLabelExp(..)
-  , LabelExp (..)
-  , LabelOp(..)
-  , LabelConst(..)
-  , ppDCLabelExp
-  , ppDCLabelExpLit
-  , labelExpToCNF
-  , dcLabelExpToDCLabel) where
-import GHC.Generics(Generic)
-import Data.Serialize (Serialize)
-import Data.List (sort, nub)
+import Data.Aeson
 import Data.Char (toLower)
-import qualified Text.PrettyPrint.HughesPJ as PP
+import Data.List (nub, sort)
+import Data.Serialize (Serialize)
+import GHC.Generics (Generic)
 import Text.PrettyPrint.HughesPJ (
-    (<+>), ($$), text, hsep, vcat, nest)
-import Data.Aeson
+    hsep,
+    nest,
+    text,
+    vcat,
+    ($$),
+    (<+>),
+ )
+import qualified Text.PrettyPrint.HughesPJ as PP
 
 type Tag = String
 data LabelOp = Conj | Disj
-     deriving (Eq, Generic, Ord)
+    deriving (Eq, Generic, Ord)
 
 data LabelExp
-     = TagExp Tag
-     | OpExp LabelOp LabelExp LabelExp
-     deriving (Eq, Generic, Ord)
-
-
-
-data LabelConst = LabelTrue | LabelFalse 
-     deriving (Eq, Generic, Ord)
+    = TagExp Tag
+    | OpExp LabelOp LabelExp LabelExp
+    deriving (Eq, Generic, Ord)
 
-instance Show LabelConst where 
-     show LabelTrue = "#true"
-     show LabelFalse = "#false"
+data LabelConst = LabelTrue | LabelFalse
+    deriving (Eq, Generic, Ord)
 
+instance Show LabelConst where
+    show LabelTrue = "#true"
+    show LabelFalse = "#false"
 
 newtype DisjTags = DisjTags [Tag]
-     deriving (Eq, Generic, Ord, Show)
+    deriving (Eq, Generic, Ord, Show)
 
 newtype CNF = CNF [DisjTags]
-     deriving (Eq, Generic, Ord, Show)
+    deriving (Eq, Generic, Ord, Show)
 
---- Normalization and conversion from labelExp to CNF 
---- 
+--- Normalization and conversion from labelExp to CNF
+---
 
---- Auxiliary functions 
+--- Auxiliary functions
 lowerString = map toLower
-snub = sort.nub
-
+snub = sort . nub
 
 --- Syntactic normalization of a list of disjunctions
 -- lowercases, sorts, and removes duplicates
 
 normDisj :: DisjTags -> DisjTags
 normDisj (DisjTags t) =
-   DisjTags $ snub (map lowerString t)
+    DisjTags $ snub (map lowerString t)
 
 --- Syntactic normalizsation of conjunctions
 --- (removes duplicates)
 syntaxNorm :: CNF -> CNF
 syntaxNorm (CNF c) = CNF $ nub (map normDisj c)
 
- 
---- Conversion from labelExps to CNF 
+--- Conversion from labelExps to CNF
 
 labelExpToCNF :: LabelExp -> CNF
 labelExpToCNF (TagExp t) = CNF [DisjTags [lowerString t]]
 labelExpToCNF (OpExp op e1 e2) =
     let CNF c1 = labelExpToCNF e1
         CNF c2 = labelExpToCNF e2
-    in CNF $ nub $
-         case op of
-           Conj -> c1 ++ c2
-           Disj ->
-             [DisjTags $ snub (d1 ++ d2)
-                 | DisjTags d1 <- c1, DisjTags d2 <- c2 ]
-
-newtype DCLabel = DCLabel (CNF,CNF)
-     deriving (Eq, Generic, Ord, Show)
-
+     in CNF $
+            nub $
+                case op of
+                    Conj -> c1 ++ c2
+                    Disj ->
+                        [ DisjTags $ snub (d1 ++ d2)
+                        | DisjTags d1 <- c1
+                        , DisjTags d2 <- c2
+                        ]
+
+newtype DCLabel = DCLabel (CNF, CNF)
+    deriving (Eq, Generic, Ord, Show)
 
 -- DCLabelExp corresponds to the label as it appears in the source; we
 -- therefore keep the string representation for potential use in error
@@ -96,29 +100,27 @@ newtype DCLabel = DCLabel (CNF,CNF)
 
 -- data DCLabelExp = DCLabelExp String (LabelExp, LabelExp)
 type DCLabOrConst = Either LabelExp LabelConst
-newtype DCLabelExp = 
-     DCLabelExp (DCLabOrConst, DCLabOrConst)
-        deriving (Eq, Generic, Ord)
+newtype DCLabelExp
+    = DCLabelExp (DCLabOrConst, DCLabOrConst)
+    deriving (Eq, Generic, Ord)
 
-labelConstToCNF :: LabelConst -> CNF 
+labelConstToCNF :: LabelConst -> CNF
 labelConstToCNF (LabelTrue) = CNF []
 labelConstToCNF (LabelFalse) = CNF [DisjTags []]
 
 dcLabelExpToDCLabel :: DCLabelExp -> DCLabel
-dcLabelExpToDCLabel (DCLabelExp (e1,e2)) =
-    let f e = case e of 
-                 Left le -> labelExpToCNF le
-                 Right lc -> labelConstToCNF lc 
-    in DCLabel(f e1, f e2)
+dcLabelExpToDCLabel (DCLabelExp (e1, e2)) =
+    let f e = case e of
+            Left le -> labelExpToCNF le
+            Right lc -> labelConstToCNF lc
+     in DCLabel (f e1, f e2)
 
-
--- instance Show DCLabelExp where 
---     show (DCLabelExp s ) = s 
+-- instance Show DCLabelExp where
+--     show (DCLabelExp s ) = s
 
 instance Show LabelOp where
-  show Conj = "&"
-  show Disj = "|"
-
+    show Conj = "&"
+    show Disj = "|"
 
 opPrec :: LabelOp -> Int
 opPrec Conj = 100
@@ -130,54 +132,55 @@ instance Serialize DisjTags
 instance Serialize CNF
 instance Serialize DCLabel
 instance Serialize LabelExp
-instance Serialize DCLabelExp 
+instance Serialize DCLabelExp
 
--- pretty printing 
+-- pretty printing
 --
 
-ppLabelExp' :: Int -> LabelExp -> PP.Doc 
-ppLabelExp' _ (TagExp t) = text t 
-ppLabelExp' parenPrec (OpExp o e1 e2) = 
-    let thisPrec = opPrec o 
-        thisTxt = (text.show) o 
-        p1 = ppLabelExp' thisPrec e1 
-        p2 = ppLabelExp' thisPrec e2 
-    in PP.maybeParens (thisPrec < parenPrec) $ 
-           hsep [ p1, thisTxt, p2 ]
-
-ppLabelExp :: LabelExp -> PP.Doc 
+ppLabelExp' :: Int -> LabelExp -> PP.Doc
+ppLabelExp' _ (TagExp t) = text t
+ppLabelExp' parenPrec (OpExp o e1 e2) =
+    let thisPrec = opPrec o
+        thisTxt = (text . show) o
+        p1 = ppLabelExp' thisPrec e1
+        p2 = ppLabelExp' thisPrec e2
+     in PP.maybeParens (thisPrec < parenPrec) $
+            hsep [p1, thisTxt, p2]
+
+ppLabelExp :: LabelExp -> PP.Doc
 ppLabelExp = ppLabelExp' 0
 
-
-ppDCLabelExp :: DCLabelExp -> PP.Doc 
-ppDCLabelExp (DCLabelExp (e1, e2))  = 
-     hsep [ text "<"
-          , ppMLabelExp e1
-          , text ";"
-          , ppMLabelExp e2
-          , text ">" 
-          ]
-        where 
-          ppMLabelExp (Left e) = ppLabelExp e 
-          ppMLabelExp (Right s) = text (show s)
-
-ppDCLabelExpLit e = 
-     text "`" PP.<> (ppDCLabelExp e) PP.<> text "`"
-
-
-instance Show LabelExp where 
-     show = PP.render. ppLabelExp
-
-instance Show DCLabelExp where 
-     show = PP.render . ppDCLabelExp
-
-instance ToJSON DisjTags where 
-     toJSON (DisjTags ts) = toJSON ts 
-instance ToJSON CNF where 
-     toJSON (CNF cats) = 
-          toJSON (map toJSON cats)
-
-instance ToJSON DCLabel where 
-     toJSON ( DCLabel (c, i)) = 
-          object [ "confidentiality" .= c
-                 , "integrity" .= i]
\ No newline at end of file
+ppDCLabelExp :: DCLabelExp -> PP.Doc
+ppDCLabelExp (DCLabelExp (e1, e2)) =
+    hsep
+        [ text "<"
+        , ppMLabelExp e1
+        , text ";"
+        , ppMLabelExp e2
+        , text ">"
+        ]
+  where
+    ppMLabelExp (Left e) = ppLabelExp e
+    ppMLabelExp (Right s) = text (show s)
+
+ppDCLabelExpLit e =
+    text "`" PP.<> (ppDCLabelExp e) PP.<> text "`"
+
+instance Show LabelExp where
+    show = PP.render . ppLabelExp
+
+instance Show DCLabelExp where
+    show = PP.render . ppDCLabelExp
+
+instance ToJSON DisjTags where
+    toJSON (DisjTags ts) = toJSON ts
+instance ToJSON CNF where
+    toJSON (CNF cats) =
+        toJSON (map toJSON cats)
+
+instance ToJSON DCLabel where
+    toJSON (DCLabel (c, i)) =
+        object
+            [ "confidentiality" .= c
+            , "integrity" .= i
+            ]
diff --git a/compiler/src/Direct.hs b/compiler/src/Direct.hs
index 6df77c46..c86fb4ee 100644
--- a/compiler/src/Direct.hs
+++ b/compiler/src/Direct.hs
@@ -1,34 +1,40 @@
-module Direct ( Lambda (..)
-              , Term (..)
-              , Decl (..)
-              , FunDecl (..)
-              , Lit(..)
-              , DeclPattern(..)
-              , RecordPatternMode(..)
-              , AtomName
-              , Atoms(..)
-              , Prog(..)
-              , Handler(..)
-              , FieldName
-              , ppLit
-              )
+module Direct (
+    Lambda (..),
+    Term (..),
+    Decl (..),
+    FunDecl (..),
+    Lit (..),
+    DeclPattern (..),
+    RecordPatternMode (..),
+    AtomName,
+    Atoms (..),
+    Prog (..),
+    Handler (..),
+    FieldName,
+    ppLit,
+)
 where
 
-import           Basics
-import qualified Text.PrettyPrint.HughesPJ as PP
-import DCLabels 
+import Basics
+import DCLabels
+import ShowIndent
 import Text.PrettyPrint.HughesPJ (
-    (<+>), ($$), text, hsep, vcat, nest)
-import           ShowIndent
-import           TroupePositionInfo
-
+    hsep,
+    nest,
+    text,
+    vcat,
+    ($$),
+    (<+>),
+ )
+import qualified Text.PrettyPrint.HughesPJ as PP
+import TroupePositionInfo
 
 data PrimType
     = TUnit
     | TInt
     | TBool
     | TString
-  deriving (Eq, Ord, Show)
+    deriving (Eq, Ord, Show)
 
 data Ty
     = TAny
@@ -37,64 +43,60 @@ data Ty
     | TFun Ty [Ty]
     | TTuple [Ty]
     | TList Ty
-  deriving (Eq)
-
+    deriving (Eq)
 
-
-data Lambda = Lambda [DeclPattern] Term --SrcPosInf
-  deriving (Eq)
+data Lambda = Lambda [DeclPattern] Term -- SrcPosInf
+    deriving (Eq)
 
 type Guard = Maybe Term
 data Handler = Handler DeclPattern (Maybe DeclPattern) Guard Term
-  deriving (Eq)
-
+    deriving (Eq)
 
 data DeclPattern
-    = VarPattern VarName --SrcPosInf
-    | ValPattern Lit 
-    | AtPattern DeclPattern String --SrcPosInf
-    | Wildcard --SrcPosInf
-    | TuplePattern [DeclPattern] --SrcPosInf
-    | ConsPattern DeclPattern DeclPattern --SrcPosInf
-    | ListPattern [DeclPattern] --SrcPosInf
+    = VarPattern VarName -- SrcPosInf
+    | ValPattern Lit
+    | AtPattern DeclPattern String -- SrcPosInf
+    | Wildcard -- SrcPosInf
+    | TuplePattern [DeclPattern] -- SrcPosInf
+    | ConsPattern DeclPattern DeclPattern -- SrcPosInf
+    | ListPattern [DeclPattern] -- SrcPosInf
     | RecordPattern [(FieldName, Maybe DeclPattern)] RecordPatternMode
-      deriving (Eq)
+    deriving (Eq)
 
 data RecordPatternMode = ExactMatch | WildcardMatch
-  deriving (Eq, Show)
+    deriving (Eq, Show)
 
 data Decl
     = ValDecl DeclPattern Term PosInf
     | FunDecs [FunDecl]
-  deriving (Eq)
+    deriving (Eq)
 
 data FunDecl = FunDecl VarName [Lambda] PosInf
-  deriving (Eq)
+    deriving (Eq)
 
 data Lit
     = LInt Integer PosInf
-    | LUnit --SrcPosInf
-    | LBool Bool --SrcPosInf
-    | LString String --SrcPosInf
-    | LLabel String --SrcPosInf
+    | LUnit -- SrcPosInf
+    | LBool Bool -- SrcPosInf
+    | LString String -- SrcPosInf
+    | LLabel String -- SrcPosInf
     | LDCLabel DCLabelExp
-    | LAtom AtomName --SrcPosInf
-  deriving (Eq, Show)
-
+    | LAtom AtomName -- SrcPosInf
+    deriving (Eq, Show)
 
 type Fields = [(FieldName, Maybe Term)]
 
 data Term
     = Lit Lit
-    | Var VarName --SrcPosInf
-    | Abs Lambda 
+    | Var VarName -- SrcPosInf
+    | Abs Lambda
     | Hnd Handler
     | App Term [Term]
     | Let [Decl] Term
     | Case Term [(DeclPattern, Term)] PosInf
     | If Term Term Term
     | Tuple [Term]
-    | Record Fields 
+    | Record Fields
     | WithRecord Term Fields
     | ProjField Term FieldName
     | ProjIdx Term Word
@@ -104,259 +106,232 @@ data Term
     | Un UnaryOp Term
     | Seq [Term]
     | Error Term
-          deriving (Eq)
+    deriving (Eq)
 
 data Atoms = Atoms [AtomName]
-      deriving (Eq, Show)
-
+    deriving (Eq, Show)
 
 data Prog = Prog Imports Atoms Term
-  deriving (Eq, Show)
-
+    deriving (Eq, Show)
 
 --------------------------------------------------
 -- show is defined via pretty printing
-instance Show Term
-  where show t = PP.render (ppTerm 0 t)
+instance Show Term where
+    show t = PP.render (ppTerm 0 t)
 
 instance ShowIndent Prog where
-  showIndent k t = PP.render (nest k (ppProg t))
+    showIndent k t = PP.render (nest k (ppProg t))
+
 --------------------------------------------------
 -- obs: these functions are not exported
 --
 
-
-
-
-
 ppProg :: Prog -> PP.Doc
 ppProg (Prog (Imports imports) (Atoms atoms) term) =
-  let ppAtoms =
-        if null atoms
-          then PP.empty
-          else (text "datatype Atoms = ") <+>
-               (hsep $ PP.punctuate (text " |") (map text atoms))
-
-      ppImports =
-        if null imports then PP.empty
-        else
-          let ppLibName ((LibName s, _)) = text "import" <+> text s
-          in
-            (vcat $ (map ppLibName imports)) $$ PP.text ""
-  in vcat [ ppImports
-          , ppAtoms
-          , ppTerm 0 term ]
-
+    let ppAtoms =
+            if null atoms
+                then PP.empty
+                else
+                    (text "datatype Atoms = ")
+                        <+> (hsep $ PP.punctuate (text " |") (map text atoms))
+
+        ppImports =
+            if null imports
+                then PP.empty
+                else
+                    let ppLibName ((LibName s, _)) = text "import" <+> text s
+                     in (vcat $ (map ppLibName imports)) $$ PP.text ""
+     in vcat
+            [ ppImports
+            , ppAtoms
+            , ppTerm 0 term
+            ]
 
 ppTerm :: Precedence -> Term -> PP.Doc
 ppTerm parentPrec t =
-   let thisTermPrec = termPrec t
-   in PP.maybeParens (thisTermPrec < parentPrec )
-      $ ppTerm' t
+    let thisTermPrec = termPrec t
+     in PP.maybeParens (thisTermPrec < parentPrec) $
+            ppTerm' t
 
-   -- uncomment to pretty print explicitly; 2017-10-14: AA
-   -- in PP.maybeParens (thisTermPrec < 10000)  $ ppTerm' t
+-- uncomment to pretty print explicitly; 2017-10-14: AA
+-- in PP.maybeParens (thisTermPrec < 10000)  $ ppTerm' t
 
 ppTerm' :: Term -> PP.Doc
 ppTerm' (Lit literal) = ppLit literal
-
 ppTerm' (Error t) = text "error " PP.<> ppTerm' t
-
-ppTerm'  (Tuple ts) =
-  PP.parens $
-  PP.hcat $
-  PP.punctuate (text ",") (map (ppTerm 0) ts)
-
-ppTerm' (Record fs) = 
-  PP.braces $ qqFields fs 
-
-ppTerm' (WithRecord t fs) = 
-  PP.braces $ PP.hsep [ppTerm 0 t, text "with", qqFields fs] 
-
-
+ppTerm' (Tuple ts) =
+    PP.parens $
+        PP.hcat $
+            PP.punctuate (text ",") (map (ppTerm 0) ts)
+ppTerm' (Record fs) =
+    PP.braces $ qqFields fs
+ppTerm' (WithRecord t fs) =
+    PP.braces $ PP.hsep [ppTerm 0 t, text "with", qqFields fs]
 ppTerm' (ProjField t fn) =
-  ppTerm projPrec t PP.<> text "." PP.<> PP.text fn
-
+    ppTerm projPrec t PP.<> text "." PP.<> PP.text fn
 ppTerm' (ProjIdx t idx) =
-  ppTerm projPrec t PP.<> text "." PP.<> PP.text (show idx)
-
-ppTerm'  (List ts) =
-  PP.brackets $
-  PP.hcat $
-  PP.punctuate (text ",") (map (ppTerm 0) ts)
-
+    ppTerm projPrec t PP.<> text "." PP.<> PP.text (show idx)
+ppTerm' (List ts) =
+    PP.brackets $
+        PP.hcat $
+            PP.punctuate (text ",") (map (ppTerm 0) ts)
 ppTerm' (ListCons hd tl) =
-   ppTerm consPrec hd PP.<> text "::" PP.<> ppTerm consPrec tl
-
+    ppTerm consPrec hd PP.<> text "::" PP.<> ppTerm consPrec tl
 ppTerm' (Var x) = text x
 ppTerm' (Abs lam) =
-  let (ppArgs, ppBody) = qqLambda lam
-  in text "fn" <+> ppArgs <+> text "=>" <+> ppBody
-
+    let (ppArgs, ppBody) = qqLambda lam
+     in text "fn" <+> ppArgs <+> text "=>" <+> ppBody
 ppTerm' (Hnd hnd) =
-  let (ppPat, ppSender, ppGuard, ppBody) = qqHandler hnd
-  in  text "hn" <+> ppPat <+>
-    (case ppSender of
-         Just p -> text "|" <+> p
-         Nothing -> PP.empty
-    ) <+>
-    (case ppGuard of
-           Just p -> text "when" <+> p
-           Nothing -> PP.empty)
-      <+> text "=>"   <+> ppBody
-
-
+    let (ppPat, ppSender, ppGuard, ppBody) = qqHandler hnd
+     in text "hn"
+            <+> ppPat
+            <+> ( case ppSender of
+                    Just p -> text "|" <+> p
+                    Nothing -> PP.empty
+                )
+            <+> ( case ppGuard of
+                    Just p -> text "when" <+> p
+                    Nothing -> PP.empty
+                )
+            <+> text "=>"
+            <+> ppBody
 ppTerm' (App t1 t2s) =
     ppTerm appPrec t1
-          <+> (hsep (map (ppTerm argPrec) t2s))
-
+        <+> (hsep (map (ppTerm argPrec) t2s))
 ppTerm' (Let decs body) =
-  text "let" <+>
-  nest 3 (vcat (map ppDecl decs)) $$
-  text "in" <+>
-  nest 3 (ppTerm 0 body) $$
-  text "end"
-
-
+    text "let"
+        <+> nest 3 (vcat (map ppDecl decs))
+        $$ text "in"
+            <+> nest 3 (ppTerm 0 body)
+        $$ text "end"
 ppTerm' (Case e cases _) =
-  text "case" <+>
-  ppTerm 0 e  $$
-  nest 2 (ppCases cases)
+    text "case"
+        <+> ppTerm 0 e
+        $$ nest 2 (ppCases cases)
   where
     ppCases [] = error "empty cases"
-    ppCases (first:rest) =
-      text "of" <+> ppCaseBody first $$
-      vcat (map ppNonFirst rest)
+    ppCases (first : rest) =
+        text "of" <+> ppCaseBody first
+            $$ vcat (map ppNonFirst rest)
 
     ppNonFirst second =
-      text " |" <+> ppCaseBody second
+        text " |" <+> ppCaseBody second
 
     ppCaseBody (decl, term) =
-      ppDeclPattern decl <+> text "=>" <+> ppTerm 0 term
-
-
-
+        ppDeclPattern decl <+> text "=>" <+> ppTerm 0 term
 ppTerm' (If e0 e1 e2) =
-  text "if" <+>
-  ppTerm 0 e0 $$
-  text "then" <+>
-  ppTerm 0 e1 $$
-  text "else" <+>
-  ppTerm 0 e2
-
+    text "if"
+        <+> ppTerm 0 e0
+        $$ text "then"
+            <+> ppTerm 0 e1
+        $$ text "else"
+            <+> ppTerm 0 e2
 ppTerm' (Bin op t1 t2) =
-  let binOpPrec = opPrec op
-  in
-     ppTerm binOpPrec t1 <+>
-     text (show op) <+>
-     ppTerm binOpPrec t2
-
+    let binOpPrec = opPrec op
+     in ppTerm binOpPrec t1
+            <+> text (show op)
+            <+> ppTerm binOpPrec t2
 ppTerm' (Un op t) =
-  text (show op) <+> ppTerm' t
-
-ppTerm' (Seq ts) = PP.hsep $
-  PP.punctuate (text ";") (map ppTerm' ts)
+    text (show op) <+> ppTerm' t
+ppTerm' (Seq ts) =
+    PP.hsep $
+        PP.punctuate (text ";") (map ppTerm' ts)
 
 qqLambda :: Lambda -> (PP.Doc, PP.Doc)
-qqLambda (Lambda args body ) =
-  let ppArgs' =
-        if null args then text "()"
-                     else hsep $ map ppDeclPattern args
-  in ( ppArgs', ppTerm 0 body)
-
-
-qqFields fs = PP.hcat $
-    PP.punctuate (text ",") (map ppField fs)
-     where ppField (name, Nothing) = PP.text name 
-           ppField (name, Just t)  = 
-              PP.hcat [PP.text name, PP.text "=", ppTerm 0 t ]
-
+qqLambda (Lambda args body) =
+    let ppArgs' =
+            if null args
+                then text "()"
+                else hsep $ map ppDeclPattern args
+     in (ppArgs', ppTerm 0 body)
+
+qqFields fs =
+    PP.hcat $
+        PP.punctuate (text ",") (map ppField fs)
+  where
+    ppField (name, Nothing) = PP.text name
+    ppField (name, Just t) =
+        PP.hcat [PP.text name, PP.text "=", ppTerm 0 t]
 
 qqHandler :: Handler -> (PP.Doc, Maybe PP.Doc, Maybe PP.Doc, PP.Doc)
 qqHandler (Handler pat Nothing Nothing e) =
-  (ppDeclPattern pat, Nothing, Nothing, ppTerm 0 e)
+    (ppDeclPattern pat, Nothing, Nothing, ppTerm 0 e)
 qqHandler (Handler pat Nothing (Just g) e) =
-  (ppDeclPattern pat, Nothing, (Just (ppTerm 0 g)), ppTerm 0 e)
+    (ppDeclPattern pat, Nothing, (Just (ppTerm 0 g)), ppTerm 0 e)
 qqHandler (Handler pat1 (Just pat2) Nothing e) =
-  (ppDeclPattern pat1, Just (ppDeclPattern pat2), Nothing, ppTerm 0 e)
+    (ppDeclPattern pat1, Just (ppDeclPattern pat2), Nothing, ppTerm 0 e)
 qqHandler (Handler pat1 (Just pat2) (Just g) e) =
-  (ppDeclPattern pat1, Just (ppDeclPattern pat2), (Just (ppTerm 0 g)), ppTerm 0 e)
-
+    (ppDeclPattern pat1, Just (ppDeclPattern pat2), (Just (ppTerm 0 g)), ppTerm 0 e)
 
 ppDecl :: Decl -> PP.Doc
 ppDecl (ValDecl pattern t _) =
-  text "val" <+> ppDeclPattern pattern <+> text "="
-    <+> ppTerm 0 t
+    text "val"
+        <+> ppDeclPattern pattern
+        <+> text "="
+        <+> ppTerm 0 t
 ppDecl (FunDecs fs) = ppFuns fs
   where
     ppFunDecl _ (FunDecl _ [] _) = error "empty fun list"
-    ppFunDecl prefix (FunDecl fname (first:rest) _) =
-      let ppFirstOption = ppFunOptions (prefix ++ " " ++ fname)
-          ppOtherOption = ppFunOptions ("  | " ++ fname)
-      in ppFirstOption first $$ vcat (map ppOtherOption rest)
-
+    ppFunDecl prefix (FunDecl fname (first : rest) _) =
+        let ppFirstOption = ppFunOptions (prefix ++ " " ++ fname)
+            ppOtherOption = ppFunOptions ("  | " ++ fname)
+         in ppFirstOption first $$ vcat (map ppOtherOption rest)
 
     ppFunOptions prefix lam =
-        let (ppArgs, ppBody) = qqLambda lam in
-        text prefix <+> ppArgs <+> text "=" <+> nest 2 ppBody
-
-
-    ppFuns (doc:docs) =
-      let ppFirstFun = ppFunDecl "fun"
-          ppOtherFun = ppFunDecl "and"
-      in ppFirstFun doc $$ vcat (map ppOtherFun docs)
-
+        let (ppArgs, ppBody) = qqLambda lam
+         in text prefix <+> ppArgs <+> text "=" <+> nest 2 ppBody
 
+    ppFuns (doc : docs) =
+        let ppFirstFun = ppFunDecl "fun"
+            ppOtherFun = ppFunDecl "and"
+         in ppFirstFun doc $$ vcat (map ppOtherFun docs)
     ppFuns _ = PP.empty
 
-
-
-
 ppDeclPattern :: DeclPattern -> PP.Doc
 ppDeclPattern (VarPattern x) = text x
-ppDeclPattern (Wildcard ) = text "_"
-ppDeclPattern (AtPattern p l ) = ppDeclPattern p PP.<> text ("@ " ++ l)
-ppDeclPattern (ValPattern literal ) = ppLit literal
-ppDeclPattern (TuplePattern patterns ) =
-  PP.parens $
-  PP.hsep $
-  PP.punctuate (text ",") (map ppDeclPattern patterns)
-ppDeclPattern (ListPattern pats ) =
-  PP.brackets $
-  PP.hsep $
-  PP.punctuate (text ",") (map ppDeclPattern pats)
-ppDeclPattern (ConsPattern headPattern tailPattern ) =
-  PP.parens $
-  ppDeclPattern headPattern PP.<> text "::" PP.<> ppDeclPattern tailPattern
-ppDeclPattern (RecordPattern fields mode) = 
-  PP.braces $ 
-    PP.hsep $ 
-      PP.punctuate (text ",") (map ppField fields ++ wildcard)
-        where ppField (f, Nothing) = text f 
-              ppField (f, Just pat) = PP.hsep[text f, text "=", ppDeclPattern pat]
-              wildcard = case mode of
-                ExactMatch -> []
-                WildcardMatch -> [text ".."]
+ppDeclPattern (Wildcard) = text "_"
+ppDeclPattern (AtPattern p l) = ppDeclPattern p PP.<> text ("@ " ++ l)
+ppDeclPattern (ValPattern literal) = ppLit literal
+ppDeclPattern (TuplePattern patterns) =
+    PP.parens $
+        PP.hsep $
+            PP.punctuate (text ",") (map ppDeclPattern patterns)
+ppDeclPattern (ListPattern pats) =
+    PP.brackets $
+        PP.hsep $
+            PP.punctuate (text ",") (map ppDeclPattern pats)
+ppDeclPattern (ConsPattern headPattern tailPattern) =
+    PP.parens $
+        ppDeclPattern headPattern PP.<> text "::" PP.<> ppDeclPattern tailPattern
+ppDeclPattern (RecordPattern fields mode) =
+    PP.braces $
+        PP.hsep $
+            PP.punctuate (text ",") (map ppField fields ++ wildcard)
+  where
+    ppField (f, Nothing) = text f
+    ppField (f, Just pat) = PP.hsep [text f, text "=", ppDeclPattern pat]
+    wildcard = case mode of
+        ExactMatch -> []
+        WildcardMatch -> [text ".."]
 
 ppLit :: Lit -> PP.Doc
-ppLit (LInt i _ )      = PP.integer i
-ppLit (LString s )   = PP.doubleQuotes (text s)
+ppLit (LInt i _) = PP.integer i
+ppLit (LString s) = PP.doubleQuotes (text s)
 ppLit (LDCLabel dc) = ppDCLabelExp dc
-ppLit (LUnit )       = text "()"
-ppLit (LBool True  )  = text "true"
+ppLit (LUnit) = text "()"
+ppLit (LBool True) = text "true"
 ppLit (LBool False) = text "false"
-ppLit (LLabel s ) = PP.braces (text s)
-ppLit (LAtom s) = text s 
-
+ppLit (LLabel s) = PP.braces (text s)
+ppLit (LAtom s) = text s
 
 termPrec :: Term -> Precedence
-termPrec (Lit _)         = maxPrec
-termPrec (Tuple _)       = maxPrec
-termPrec (List _ )       = maxPrec
-termPrec (Var _)         = maxPrec
-termPrec (App _ _)       = appPrec
-termPrec (Bin op _ _)    = opPrec op
-termPrec (ProjField _ _ ) = projPrec 
-termPrec (ProjIdx _ _ ) = projPrec 
-termPrec (ListCons _ _)  = 200
-termPrec _               = 0
+termPrec (Lit _) = maxPrec
+termPrec (Tuple _) = maxPrec
+termPrec (List _) = maxPrec
+termPrec (Var _) = maxPrec
+termPrec (App _ _) = appPrec
+termPrec (Bin op _ _) = opPrec op
+termPrec (ProjField _ _) = projPrec
+termPrec (ProjIdx _ _) = projPrec
+termPrec (ListCons _ _) = 200
+termPrec _ = 0
diff --git a/compiler/src/DirectWOPats.hs b/compiler/src/DirectWOPats.hs
index 3fd5e022..3cc28d79 100644
--- a/compiler/src/DirectWOPats.hs
+++ b/compiler/src/DirectWOPats.hs
@@ -1,29 +1,36 @@
-module DirectWOPats ( Lambda (..)
-              , Term (..)
-              , Decl (..)
-              , FunDecl (..)
-              , Lit(..)
-              , AtomName
-              , Atoms(..)
-              , Prog(..)            
-              )
+module DirectWOPats (
+    Lambda (..),
+    Term (..),
+    Decl (..),
+    FunDecl (..),
+    Lit (..),
+    AtomName,
+    Atoms (..),
+    Prog (..),
+)
 where
 
 import Basics
-import qualified Text.PrettyPrint.HughesPJ as PP
-import Text.PrettyPrint.HughesPJ (
-    (<+>), ($$), text, hsep, vcat, nest)
-import ShowIndent
 import DCLabels
+import ShowIndent
+import Text.PrettyPrint.HughesPJ (
+    hsep,
+    nest,
+    text,
+    vcat,
+    ($$),
+    (<+>),
+ )
+import qualified Text.PrettyPrint.HughesPJ as PP
 import TroupePositionInfo
 
 data Decl
     = ValDecl VarName Term
     | FunDecs [FunDecl]
-  deriving (Eq)
+    deriving (Eq)
 
 data FunDecl = FunDecl VarName Lambda
-  deriving (Eq)
+    deriving (Eq)
 
 data Lit
     = LInt Integer PosInf
@@ -33,12 +40,10 @@ data Lit
     | LUnit
     | LBool Bool
     | LAtom AtomName
-  deriving (Eq, Show)
-
-
+    deriving (Eq, Show)
 
 data Lambda = Lambda [VarName] Term
-  deriving (Eq)
+    deriving (Eq)
 
 type Fields = [(FieldName, Term)]
 
@@ -47,13 +52,13 @@ data Term
     | Var VarName
     | Abs Lambda
     | App Term [Term]
-    | Let [Decl] Term    
+    | Let [Decl] Term
     | If Term Term Term
     | AssertElseError Term Term Term PosInf
     | Tuple [Term]
-    | Record Fields 
+    | Record Fields
     | WithRecord Term Fields
-    | ProjField Term FieldName 
+    | ProjField Term FieldName
     | ProjIdx Term Word
     | List [Term]
     | ListCons Term Term
@@ -63,177 +68,145 @@ data Term
     deriving (Eq)
 
 data Atoms = Atoms [AtomName]
-      deriving (Eq, Show)
+    deriving (Eq, Show)
 
 data Prog = Prog Imports Atoms Term
-  deriving (Eq, Show)
-
-
-
-
-
+    deriving (Eq, Show)
 
 --------------------------------------------------
 -- show is defined via pretty printing
-instance Show Term
-  where show t = PP.render (ppTerm 0 t)
+instance Show Term where
+    show t = PP.render (ppTerm 0 t)
 
 instance ShowIndent Prog where
-  showIndent k t = PP.render (nest k (ppProg t))
+    showIndent k t = PP.render (nest k (ppProg t))
+
 --------------------------------------------------
 -- obs: these functions are not exported
 --
 
-
-
-
 ppProg :: Prog -> PP.Doc
 ppProg (Prog (Imports imports) (Atoms atoms) term) =
-  let ppAtoms =
-        if null atoms
-          then PP.empty
-          else (text "datatype Atoms = ") <+>
-               (hsep $ PP.punctuate (text " |") (map text atoms))
-      ppImports = if null imports then PP.empty else text "<<imports>>\n"
-  in ppImports $$ ppAtoms $$ ppTerm 0 term
-
+    let ppAtoms =
+            if null atoms
+                then PP.empty
+                else
+                    (text "datatype Atoms = ")
+                        <+> (hsep $ PP.punctuate (text " |") (map text atoms))
+        ppImports = if null imports then PP.empty else text "<<imports>>\n"
+     in ppImports $$ ppAtoms $$ ppTerm 0 term
 
 ppTerm :: Precedence -> Term -> PP.Doc
 ppTerm parentPrec t =
-   let thisTermPrec = termPrec t
-   in PP.maybeParens (thisTermPrec < parentPrec )
-      $ ppTerm' t
+    let thisTermPrec = termPrec t
+     in PP.maybeParens (thisTermPrec < parentPrec) $
+            ppTerm' t
 
-   -- uncomment to pretty print explicitly; 2017-10-14: AA
-   -- in PP.maybeParens (thisTermPrec < 10000)  $ ppTerm' t
+-- uncomment to pretty print explicitly; 2017-10-14: AA
+-- in PP.maybeParens (thisTermPrec < 10000)  $ ppTerm' t
 
 ppTerm' :: Term -> PP.Doc
 ppTerm' (Lit literal) = ppLit literal
-
 ppTerm' (Error t _) = text "error " PP.<> ppTerm' t
-
-ppTerm'  (Tuple ts) =
-  PP.parens $
-  PP.hcat $
-  PP.punctuate (text ",") (map (ppTerm 0) ts)
-
-ppTerm' (Record fs) = 
-    PP.braces $  qqFields fs
-
+ppTerm' (Tuple ts) =
+    PP.parens $
+        PP.hcat $
+            PP.punctuate (text ",") (map (ppTerm 0) ts)
+ppTerm' (Record fs) =
+    PP.braces $ qqFields fs
 ppTerm' (WithRecord e fs) =
-    PP.braces $ PP.hsep [ ppTerm 0 e, text "with", qqFields fs ]
-
+    PP.braces $ PP.hsep [ppTerm 0 e, text "with", qqFields fs]
 ppTerm' (ProjField t fn) =
-  ppTerm projPrec t PP.<> text "." PP.<> PP.text fn
-
+    ppTerm projPrec t PP.<> text "." PP.<> PP.text fn
 ppTerm' (ProjIdx t idx) =
-  ppTerm projPrec t PP.<> text "." PP.<> PP.text (show idx)
-
-
-ppTerm'  (List ts) =
-  PP.brackets $
-  PP.hcat $
-  PP.punctuate (text ",") (map (ppTerm 0) ts)
-
-
-
+    ppTerm projPrec t PP.<> text "." PP.<> PP.text (show idx)
+ppTerm' (List ts) =
+    PP.brackets $
+        PP.hcat $
+            PP.punctuate (text ",") (map (ppTerm 0) ts)
 ppTerm' (ListCons hd tl) =
-   ppTerm consPrec hd PP.<> text "::" PP.<> ppTerm consPrec tl
-
+    ppTerm consPrec hd PP.<> text "::" PP.<> ppTerm consPrec tl
 ppTerm' (Var x) = text x
 ppTerm' (Abs lam) =
-  let (ppArgs, ppBody) = qqLambda lam
-  in text "fn" <+> ppArgs <+> text "=>" <+> ppBody
-
+    let (ppArgs, ppBody) = qqLambda lam
+     in text "fn" <+> ppArgs <+> text "=>" <+> ppBody
 ppTerm' (App t1 t2s) =
     ppTerm appPrec t1
-          <+> (hsep (map (ppTerm argPrec) t2s))
-
+        <+> (hsep (map (ppTerm argPrec) t2s))
 ppTerm' (Let decs body) =
-  text "let" <+>
-  nest 3 (vcat (map ppDecl decs)) $$
-  text "in" <+>
-  nest 3 (ppTerm 0 body) $$
-  text "end"
-
-
+    text "let"
+        <+> nest 3 (vcat (map ppDecl decs))
+        $$ text "in"
+            <+> nest 3 (ppTerm 0 body)
+        $$ text "end"
 ppTerm' (If e0 e1 e2) =
-  text "if" <+>
-  ppTerm 0 e0 $$
-  text "then" <+>
-  ppTerm 0 e1 $$
-  text "else" <+>
-  ppTerm 0 e2
-
+    text "if"
+        <+> ppTerm 0 e0
+        $$ text "then"
+            <+> ppTerm 0 e1
+        $$ text "else"
+            <+> ppTerm 0 e2
 ppTerm' (AssertElseError e0 e1 e2 _) =
-  text "assert" <+>
-  ppTerm 0 e0 $$
-  text "then" <+>
-  ppTerm 0 e1 $$
-  text "elseError" <+>
-  ppTerm 0 e2
-  
-
+    text "assert"
+        <+> ppTerm 0 e0
+        $$ text "then"
+            <+> ppTerm 0 e1
+        $$ text "elseError"
+            <+> ppTerm 0 e2
 ppTerm' (Bin op t1 t2) =
-  let binOpPrec = opPrec op
-  in
-     ppTerm binOpPrec t1 <+>
-     text (show op) <+>
-     ppTerm binOpPrec t2
-
+    let binOpPrec = opPrec op
+     in ppTerm binOpPrec t1
+            <+> text (show op)
+            <+> ppTerm binOpPrec t2
 ppTerm' (Un op t) =
-  let unOpPrec = op1Prec op
-  in
-     text (show op) <+>
-     ppTerm unOpPrec t
-
-
-
-qqFields fs = PP.hcat $
-    PP.punctuate (text ",") (map ppField fs)
-     where ppField (name, t)  = 
-              PP.hcat [PP.text name, PP.text "=", ppTerm 0 t ]
+    let unOpPrec = op1Prec op
+     in text (show op)
+            <+> ppTerm unOpPrec t
 
+qqFields fs =
+    PP.hcat $
+        PP.punctuate (text ",") (map ppField fs)
+  where
+    ppField (name, t) =
+        PP.hcat [PP.text name, PP.text "=", ppTerm 0 t]
 
 qqLambda :: Lambda -> (PP.Doc, PP.Doc)
 qqLambda (Lambda args body) =
-  let ppArgs' =
-        if null args then text "()"
-                     else hsep $ map text args
-  in ( ppArgs', ppTerm 0 body)
+    let ppArgs' =
+            if null args
+                then text "()"
+                else hsep $ map text args
+     in (ppArgs', ppTerm 0 body)
 
 ppDecl (ValDecl x t) = text "val" <+> text x <+> text "=" <+> ppTerm 0 t
 ppDecl (FunDecs fs) = ppFuns (map ppFunDecl fs)
   where
-    ppFunDecl ( FunDecl fname (Lambda args body)) =
-      let ppArgs = if args == [] then text "()" else hsep ( map text args)
-      in (text fname <+> ppArgs <+> text "=" , ppTerm 0 body)
-    ppFuns (doc:docs) =
-      let pp' prefix (docHead,docBody) = text prefix  <+> docHead  $$ nest 2 docBody
-          ppFirstFun = pp' "fun"
-          ppOtherFun = pp' "and"
-      in ppFirstFun doc $$ vcat (map ppOtherFun docs)
+    ppFunDecl (FunDecl fname (Lambda args body)) =
+        let ppArgs = if args == [] then text "()" else hsep (map text args)
+         in (text fname <+> ppArgs <+> text "=", ppTerm 0 body)
+    ppFuns (doc : docs) =
+        let pp' prefix (docHead, docBody) = text prefix <+> docHead $$ nest 2 docBody
+            ppFirstFun = pp' "fun"
+            ppOtherFun = pp' "and"
+         in ppFirstFun doc $$ vcat (map ppOtherFun docs)
     ppFuns _ = PP.empty
 
 ppLit :: Lit -> PP.Doc
-ppLit (LInt i _)      = PP.integer i
-ppLit (LString s)   = PP.doubleQuotes (text s)
-ppLit (LLabel s)    = PP.braces (text s)
+ppLit (LInt i _) = PP.integer i
+ppLit (LString s) = PP.doubleQuotes (text s)
+ppLit (LLabel s) = PP.braces (text s)
 ppLit (LDCLabel dc) = ppDCLabelExpLit dc
-ppLit LUnit         = text "()"
-ppLit (LBool True)  = text "true"
+ppLit LUnit = text "()"
+ppLit (LBool True) = text "true"
 ppLit (LBool False) = text "false"
 ppLit (LAtom a) = text a
 
-
-
-
 termPrec :: Term -> Precedence
-termPrec (Lit _)         = maxPrec
-termPrec (Tuple _)       = maxPrec
-termPrec (List _ )       = maxPrec
-termPrec (Var _)         = maxPrec
-termPrec (App _ _)       = appPrec
-termPrec (Bin op _ _)    = opPrec op
-termPrec (ListCons _ _)  = 200
-termPrec _               = 0
+termPrec (Lit _) = maxPrec
+termPrec (Tuple _) = maxPrec
+termPrec (List _) = maxPrec
+termPrec (Var _) = maxPrec
+termPrec (App _ _) = appPrec
+termPrec (Bin op _ _) = opPrec op
+termPrec (ListCons _ _) = 200
+termPrec _ = 0
diff --git a/compiler/src/Exports.hs b/compiler/src/Exports.hs
index 0f9bd610..0aa3f1a2 100644
--- a/compiler/src/Exports.hs
+++ b/compiler/src/Exports.hs
@@ -7,10 +7,9 @@ module Exports where
 -- the exports are handled in many places throughout the compilation
 -- pipeline.
 
-
 import Basics
-import Direct
 import Control.Monad.Except
+import Direct
 
 type Exports = [(Basics.VarName, Basics.VarName)]
 
@@ -20,17 +19,14 @@ extractMain x = x
 
 errorMessage = "parse error: libraries need to use restricted syntax for their main body"
 
-
 extractExports :: Prog -> Except String [String]
 extractExports (Prog imports atoms term) = do
-  case extractMain term of
-    List exports -> reify exports
-    _ -> throwError errorMessage
-
+    case extractMain term of
+        List exports -> reify exports
+        _ -> throwError errorMessage
 
 reify :: [Term] -> Except String [String]
-reify = mapM checkOne 
-
+reify = mapM checkOne
 
 checkOne :: Term -> Except String String
 checkOne (Tuple [Lit (LString s), Var vn]) = return s
diff --git a/compiler/src/IR.hs b/compiler/src/IR.hs
index 8621c088..97e22577 100644
--- a/compiler/src/IR.hs
+++ b/compiler/src/IR.hs
@@ -1,122 +1,123 @@
--- 2019-03-22: closure converted IR based on ANF 
+-- 2019-03-22: closure converted IR based on ANF
 --
-
 {-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 module IR where
 
-import           Consts
 import qualified Basics
-import           RetCPS                    (VarName (..))
+import Consts
+import RetCPS (VarName (..))
 
-
-import qualified Core                      as C
-import qualified RetCPS                    as CPS
-import           Core (ppLit)
-import           Control.Monad.Except
-import           Control.Monad.Reader
-import           Control.Monad.RWS
-import           Control.Monad.State
-import           Control.Monad.Writer
 import Control.Monad (when)
-import           Data.List
-import qualified Data.ByteString           as BS
-import           Data.Serialize            (Serialize)
-import qualified Data.Serialize            as Serialize
-import           GHC.Generics              (Generic)
-
-import           CompileMode
-import           Text.PrettyPrint.HughesPJ (hsep, nest, text, vcat, ($$), (<+>))
+import Control.Monad.Except
+import Control.Monad.RWS
+import Control.Monad.Reader
+import Control.Monad.State
+import Control.Monad.Writer
+import Core (ppLit)
+import qualified Core as C
+import qualified Data.ByteString as BS
+import Data.List
+import Data.Serialize (Serialize)
+import qualified Data.Serialize as Serialize
+import GHC.Generics (Generic)
+import qualified RetCPS as CPS
+
+import CompileMode
+import DCLabels
+import Text.PrettyPrint.HughesPJ (hsep, nest, text, vcat, ($$), (<+>))
 import qualified Text.PrettyPrint.HughesPJ as PP
-import           TroupePositionInfo
-import           DCLabels
+import TroupePositionInfo
 
 -- | Describes a variable containing a labelled value.
 data VarAccess
-  -- | Local variable with a labelled value.
-  = VarLocal VarName
-  -- | Variable defined in the closure.
-  | VarEnv VarName
-  -- | Variable refering to the very function being declared.
-  | VarFunSelfRef
-  deriving (Eq, Show, Generic)
+    = -- | Local variable with a labelled value.
+      VarLocal VarName
+    | -- | Variable defined in the closure.
+      VarEnv VarName
+    | -- | Variable refering to the very function being declared.
+      VarFunSelfRef
+    deriving (Eq, Generic, Show)
 
 type Ident = String
 
-newtype HFN  = HFN Ident deriving (Eq, Show, Ord, Generic)
+newtype HFN = HFN Ident deriving (Eq, Generic, Ord, Show)
 
-type Fields =  [(Basics.FieldName, VarAccess)]
+type Fields = [(Basics.FieldName, VarAccess)]
 data IRExpr
-  = Bin Basics.BinOp VarAccess VarAccess
-  | Un Basics.UnaryOp VarAccess
-  | Tuple [VarAccess]
-  | Record Fields
-  | WithRecord VarAccess Fields 
-  | ProjField VarAccess Basics.FieldName
-  -- | Projection of a tuple field at the given index. The maximum allowed index
-  -- is 2^31-1 (2147483647).
-  | ProjIdx VarAccess Word
-  | List [VarAccess]
-  -- | List cons of a value to a list.
-  | ListCons VarAccess VarAccess
-  -- | Note: This instruction is not generated from source. Constants are stored in function definitions (see 'FunDef').
-  | Const C.Lit
-  -- | Predefined base function names.
-  | Base Basics.VarName
-  -- | Returns the definition (variable) with the given name
-  -- from the given library.
-  | Lib Basics.LibName Basics.VarName
-  deriving (Eq, Show, Generic)
+    = Bin Basics.BinOp VarAccess VarAccess
+    | Un Basics.UnaryOp VarAccess
+    | Tuple [VarAccess]
+    | Record Fields
+    | WithRecord VarAccess Fields
+    | ProjField VarAccess Basics.FieldName
+    | {- | Projection of a tuple field at the given index. The maximum allowed index
+      is 2^31-1 (2147483647).
+      -}
+      ProjIdx VarAccess Word
+    | List [VarAccess]
+    | -- | List cons of a value to a list.
+      ListCons VarAccess VarAccess
+    | -- | Note: This instruction is not generated from source. Constants are stored in function definitions (see 'FunDef').
+      Const C.Lit
+    | -- | Predefined base function names.
+      Base Basics.VarName
+    | {- | Returns the definition (variable) with the given name
+      from the given library.
+      -}
+      Lib Basics.LibName Basics.VarName
+    deriving (Eq, Generic, Show)
 
 -- | A block of instructions followed by a terminator, which can contain further 'IRBBTree's.
-data IRBBTree = BB [IRInst] IRTerminator deriving (Eq, Show, Generic)
+data IRBBTree = BB [IRInst] IRTerminator deriving (Eq, Generic, Show)
 
 data IRTerminator
-  -- | Call the function referred to by the first variable with the argument in the second variable.
-  = TailCall VarAccess VarAccess
-  -- | Return from the current Call with the given variable as return value.
-  | Ret VarAccess
-  | If VarAccess IRBBTree IRBBTree
-  -- | Check whether the value of the first variable is true. If yes, continue with the given tree.
-  -- If not, terminate the current thread with a runtime error, printing the message stored in the second variable (which is asserted to be a string) with the given PosInf.
-  | AssertElseError VarAccess IRBBTree VarAccess PosInf
-  -- | Make the library available under the given variable.
-  | LibExport VarAccess
-  -- | Terminate the current thread with a runtime error, printing the message stored in the variable (which is asserted to be a string) with the given PosInf.
-  | Error VarAccess PosInf
-  -- | Execute the first BB, store the returned result in the given variable
-  -- and then execute the second BB, which can refer to this variable and
-  -- where PC is reset to the level before entering the first BB.
-  -- Represents a "let x = ... in ..." format.
-  | Call VarName IRBBTree IRBBTree
-  deriving (Eq,Show,Generic)
-
+    = -- | Call the function referred to by the first variable with the argument in the second variable.
+      TailCall VarAccess VarAccess
+    | -- | Return from the current Call with the given variable as return value.
+      Ret VarAccess
+    | If VarAccess IRBBTree IRBBTree
+    | {- | Check whether the value of the first variable is true. If yes, continue with the given tree.
+      If not, terminate the current thread with a runtime error, printing the message stored in the second variable (which is asserted to be a string) with the given PosInf.
+      -}
+      AssertElseError VarAccess IRBBTree VarAccess PosInf
+    | -- | Make the library available under the given variable.
+      LibExport VarAccess
+    | -- | Terminate the current thread with a runtime error, printing the message stored in the variable (which is asserted to be a string) with the given PosInf.
+      Error VarAccess PosInf
+    | {- | Execute the first BB, store the returned result in the given variable
+      and then execute the second BB, which can refer to this variable and
+      where PC is reset to the level before entering the first BB.
+      Represents a "let x = ... in ..." format.
+      -}
+      Call VarName IRBBTree IRBBTree
+    deriving (Eq, Generic, Show)
 
 data IRInst
-  = Assign VarName IRExpr
-  -- | A closure instruction consists of
-  -- - A list of variables that need to be in the environment
-  -- - A list of closures with their name and the corresponding compiler-generated name of the function
-  | MkFunClosures [(VarName, VarAccess)] [(VarName, HFN)]
-  
- deriving (Eq, Show, Generic)
-
-
+    = Assign VarName IRExpr
+    | {- | A closure instruction consists of
+      - A list of variables that need to be in the environment
+      - A list of closures with their name and the corresponding compiler-generated name of the function
+      -}
+      MkFunClosures [(VarName, VarAccess)] [(VarName, HFN)]
+    deriving (Eq, Generic, Show)
 
 -- | A literal together with the variable name the constant is accessed through.
 type Consts = [(VarName, C.Lit)]
+
 -- Function definition
-data FunDef = FunDef 
-                    HFN         -- name of the function
-                    VarName     -- name of the argument
-                    Consts      -- constants used in the function  
-                    IRBBTree    -- body
-                deriving (Eq,Generic)
-
--- An IR program is just a collection of atoms declarations 
+data FunDef
+    = FunDef
+        HFN -- name of the function
+        VarName -- name of the argument
+        Consts -- constants used in the function
+        IRBBTree -- body
+    deriving (Eq, Generic)
+
+-- An IR program is just a collection of atoms declarations
 -- and function definitions
 data IRProgram = IRProgram C.Atoms [FunDef] deriving (Generic)
 
@@ -127,42 +128,40 @@ data IRProgram = IRProgram C.Atoms [FunDef] deriving (Generic)
 -- For dependencies, we only need the function dependencies
 
 class ComputesDependencies a where
-  dependencies :: a -> Writer ([HFN], [Basics.LibName], [Basics.AtomName])  ()
-
-instance ComputesDependencies IRInst where 
-   dependencies (MkFunClosures _ fdefs) = 
-        mapM_ (\(_, hfn) -> tell ([hfn],[],[])) fdefs
-   dependencies (Assign _ (Lib libname _)) = 
-        tell ([], [libname],[])
-   dependencies (Assign _ (Const (C.LAtom a))) = 
+    dependencies :: a -> Writer ([HFN], [Basics.LibName], [Basics.AtomName]) ()
+
+instance ComputesDependencies IRInst where
+    dependencies (MkFunClosures _ fdefs) =
+        mapM_ (\(_, hfn) -> tell ([hfn], [], [])) fdefs
+    dependencies (Assign _ (Lib libname _)) =
+        tell ([], [libname], [])
+    dependencies (Assign _ (Const (C.LAtom a))) =
         tell ([], [], [a])
-                                       
-   dependencies _ = return ()
+    dependencies _ = return ()
 
 instance ComputesDependencies IRBBTree where
-    dependencies (BB insts trm) = 
-        do mapM_ dependencies insts 
-           dependencies trm
+    dependencies (BB insts trm) =
+        do
+            mapM_ dependencies insts
+            dependencies trm
 
-instance ComputesDependencies IRTerminator where 
+instance ComputesDependencies IRTerminator where
     dependencies (If _ bb1 bb2) = mapM_ dependencies [bb1, bb2]
     dependencies (AssertElseError _ bb1 _ _) = dependencies bb1
-    dependencies (Call _ t1 t2) = dependencies t1  >> dependencies t2
-
-    dependencies _              = return ()
+    dependencies (Call _ t1 t2) = dependencies t1 >> dependencies t2
+    dependencies _ = return ()
 instance ComputesDependencies FunDef where
-  dependencies (FunDef _ _ _ bb) = dependencies bb
+    dependencies (FunDef _ _ _ bb) = dependencies bb
 
+ppDeps :: (ComputesDependencies a) => a -> (PP.Doc, PP.Doc, PP.Doc)
+ppDeps a =
+    let (ffs_0, lls_0, atoms_0) = execWriter (dependencies a)
+        (ffs, lls, aas) = (nub ffs_0, nub lls_0, nub atoms_0)
 
-ppDeps :: ComputesDependencies a => a -> (PP.Doc , PP.Doc, PP.Doc)
-ppDeps a = let (ffs_0,lls_0, atoms_0) = execWriter  (dependencies a)               
-               (ffs, lls, aas) = (nub ffs_0, nub lls_0, nub atoms_0)
-
-               format dd =
-                   let tt = map (PP.doubleQuotes . ppId) dd in 
-                   (PP.brackets.PP.hsep) (PP.punctuate PP.comma tt)
-            in ( format ffs, format lls , format aas )            
-
+        format dd =
+            let tt = map (PP.doubleQuotes . ppId) dd
+             in (PP.brackets . PP.hsep) (PP.punctuate PP.comma tt)
+     in (format ffs, format lls, format aas)
 
 -----------------------------------------------------------
 -- Serialization instances
@@ -178,19 +177,18 @@ instance Serialize IRInst
 instance Serialize IRBBTree
 
 -----------------------------------------------------------
--- Serialization 
+-- Serialization
 -----------------------------------------------------------
 data SerializationUnit
-  = FunSerialization FunDef
-  | AtomsSerialization C.Atoms
-  | ProgramSerialization IRProgram
-  deriving (Generic)
+    = FunSerialization FunDef
+    | AtomsSerialization C.Atoms
+    | ProgramSerialization IRProgram
+    deriving (Generic)
 
 instance Serialize SerializationUnit
 
-
 serializeFunDef :: FunDef -> BS.ByteString
-serializeFunDef fdef = Serialize.runPut ( Serialize.put (FunSerialization fdef) )
+serializeFunDef fdef = Serialize.runPut (Serialize.put (FunSerialization fdef))
 
 serializeAtoms :: C.Atoms -> BS.ByteString
 serializeAtoms atoms = Serialize.runPut (Serialize.put (AtomsSerialization atoms))
@@ -200,156 +198,152 @@ deserializeAtoms bs = Serialize.runGet (Serialize.get) bs
 
 deserialize :: BS.ByteString -> Either String SerializationUnit
 deserialize bs =
-  case Serialize.runGet (Serialize.get) bs of
-    Left s -> Left s
-    Right x@(FunSerialization fdecl) ->
-      case runExcept (wfFun fdecl) of 
-        Right  _ -> Right x 
-        Left s -> Left  "ir not well-formed"
-      -- if wfFun fdecl then (Right x)
-      -- else Left "ir not well-formed"
-    Right x -> Right x
+    case Serialize.runGet (Serialize.get) bs of
+        Left s -> Left s
+        Right x@(FunSerialization fdecl) ->
+            case runExcept (wfFun fdecl) of
+                Right _ -> Right x
+                Left s -> Left "ir not well-formed"
+        -- if wfFun fdecl then (Right x)
+        -- else Left "ir not well-formed"
+        Right x -> Right x
 
 -----------------------------------------------------------
 -- Well-formedness
 -----------------------------------------------------------
 
 class WellFormedIRCheck a where
-  wfir :: a -> WFCheck ()
+    wfir :: a -> WFCheck ()
 
-type WFCheck a = ExceptT String (State [Ident] ) a
+type WFCheck a = ExceptT String (State [Ident]) a
 
 checkId :: Ident -> WFCheck ()
 checkId x = do
-  ids <- lift get
-  if x `elem` ids then throwError x
-  else do
-    (lift . put) (x:ids)
-    return ()
+    ids <- lift get
+    if x `elem` ids
+        then throwError x
+        else do
+            (lift . put) (x : ids)
+            return ()
 
 instance WellFormedIRCheck IRInst where
- wfir (Assign (VN x) e) = do checkId x
-                             wfir e
- wfir (MkFunClosures _ fdefs) = mapM_ (\((VN x), _) -> checkId x) fdefs
- 
+    wfir (Assign (VN x) e) = do
+        checkId x
+        wfir e
+    wfir (MkFunClosures _ fdefs) = mapM_ (\((VN x), _) -> checkId x) fdefs
 
 instance WellFormedIRCheck IRTerminator where
-  wfir (If _ bb1 bb2) = do
-    wfir bb1
-    wfir bb2
-  wfir (AssertElseError _ bb _ _) = wfir bb
-  wfir (Call (VN x) bb1 bb2 ) = do 
-    checkId x 
-    wfir bb1
-    wfir bb2
-
-  wfir _ = return ()
-
+    wfir (If _ bb1 bb2) = do
+        wfir bb1
+        wfir bb2
+    wfir (AssertElseError _ bb _ _) = wfir bb
+    wfir (Call (VN x) bb1 bb2) = do
+        checkId x
+        wfir bb1
+        wfir bb2
+    wfir _ = return ()
 
 instance WellFormedIRCheck IRBBTree where
-  wfir (BB insts tr) = do
-    mapM_ wfir insts    
-    wfir tr
+    wfir (BB insts tr) = do
+        mapM_ wfir insts
+        wfir tr
 
 instance WellFormedIRCheck IRExpr where
-  wfir (Base fname) =
-    -- OBS: AA: 2018-07-24: This is the only
-    -- place where we check the base functions
-    -- (but this should be sufficient though). Note
-    -- that it is important to do this check at the level
-    -- of the IR because we otherwise may get a malformed
-    -- code over wire. Such malformed code would result
-    -- in a JS output returning a runtime error (which should
-    -- generally be avoided)
-     if  fname `elem`[ 
-                       "$$authorityarg"
-                     , "adv"
-                     , "ladv"
-                     , "arrayCreate"
-                     , "arrayGet"
-                     , "arraySet"
-                     , "attenuate"
-                     , "_blockThread"
-                     , "blockdecl"
-                     , "blockdeclto"
-                     , "blockendorse"
-                     , "blockendorseto"
-                     , "ceil"
-                     , "cert"
-                     , "charCodeAtWithDefault"
-                     , "consume"
-                     , "_debug"
-                     , "debugpc"
-                     , "declassify"
-                     , "exit"
-                     , "endorse"
-                     , "floor"
-                     , "flowsTo"                     
-                     , "fprintln"
-                     , "fprintlnWithLabels"
-                     , "fwrite"                     
-                     , "getTime"
-                     , "getType"
-                     , "getNanoTime"
-                     , "getStdout"
-                     , "_getSystemProcess"
-                     , "guard"
-                     , "inputLine"
-                     , "intToString"                     
-                     , "listToTuple"
-                     , "lowermbox"                    
-                     , "levelOf"
-                     , "mkuuid"
-                     , "mkSecret"
-                     , "monitorlocal"
-                     , "newlabel"                     
-                     , "node"
-                     , "_pc"
-                     , "pcpop"
-                     , "peek"
-                     , "pinipush"
-                     , "pinipushto"
-                     , "pinipop"
-                     , "pcpush"                      
-                     , "question"
-                     , "raisembox"
-                     , "raiseTrust"
-                     , "random"
-                     , "receive"
-                     , "recordExtend"
-                     , "register"
-                     , "_resetScheduler"
-                     , "rcv"
-                     , "rcvp"
-                     , "round"
-                     , "sandbox"
-                     , "save"
-                     , "send"
-                     , "self"
-                     , "_servicetest"
-                     , "_setProcessDebuggingName"
-                     , "_setFailureRate"
-                     , "sleep"
-                     , "spawn"
-                     , "sqrt"
-                     , "substring"
-                     , "stringToInt"
-                     , "strlen"
-                     , "restore"
-                     , "toStringL"
-                     , "toString"
-                     , "whereis"                 
-                                      
-                     ]
-        then return ()
-        else throwError $ "bad base function: " ++ fname
-  wfir (ProjIdx _ idx) =
-    when (idx > (fromIntegral Consts.llvm_maxIndex :: Word)) $
-      throwError $ "ProjIdx: illegal index: " ++ show idx ++ " (max index: " ++ show Consts.llvm_maxIndex ++ ")"
-
-  wfir _ = return ()
-
-
+    wfir (Base fname) =
+        -- OBS: AA: 2018-07-24: This is the only
+        -- place where we check the base functions
+        -- (but this should be sufficient though). Note
+        -- that it is important to do this check at the level
+        -- of the IR because we otherwise may get a malformed
+        -- code over wire. Such malformed code would result
+        -- in a JS output returning a runtime error (which should
+        -- generally be avoided)
+        if fname
+            `elem` [ "$$authorityarg"
+                   , "adv"
+                   , "ladv"
+                   , "arrayCreate"
+                   , "arrayGet"
+                   , "arraySet"
+                   , "attenuate"
+                   , "_blockThread"
+                   , "blockdecl"
+                   , "blockdeclto"
+                   , "blockendorse"
+                   , "blockendorseto"
+                   , "ceil"
+                   , "cert"
+                   , "charCodeAtWithDefault"
+                   , "consume"
+                   , "_debug"
+                   , "debugpc"
+                   , "declassify"
+                   , "exit"
+                   , "endorse"
+                   , "floor"
+                   , "flowsTo"
+                   , "fprintln"
+                   , "fprintlnWithLabels"
+                   , "fwrite"
+                   , "getTime"
+                   , "getType"
+                   , "getNanoTime"
+                   , "getStdout"
+                   , "_getSystemProcess"
+                   , "guard"
+                   , "inputLine"
+                   , "intToString"
+                   , "listToTuple"
+                   , "lowermbox"
+                   , "levelOf"
+                   , "mkuuid"
+                   , "mkSecret"
+                   , "monitorlocal"
+                   , "newlabel"
+                   , "node"
+                   , "_pc"
+                   , "pcpop"
+                   , "peek"
+                   , "pinipush"
+                   , "pinipushto"
+                   , "pinipop"
+                   , "pcpush"
+                   , "question"
+                   , "raisembox"
+                   , "raiseTrust"
+                   , "random"
+                   , "receive"
+                   , "recordExtend"
+                   , "register"
+                   , "_resetScheduler"
+                   , "rcv"
+                   , "rcvp"
+                   , "round"
+                   , "sandbox"
+                   , "save"
+                   , "send"
+                   , "self"
+                   , "_servicetest"
+                   , "_setProcessDebuggingName"
+                   , "_setFailureRate"
+                   , "sleep"
+                   , "spawn"
+                   , "sqrt"
+                   , "substring"
+                   , "stringToInt"
+                   , "strlen"
+                   , "restore"
+                   , "toStringL"
+                   , "toString"
+                   , "whereis"
+                   ]
+            then return ()
+            else throwError $ "bad base function: " ++ fname
+    wfir (ProjIdx _ idx) =
+        when (idx > (fromIntegral Consts.llvm_maxIndex :: Word)) $
+            throwError $
+                "ProjIdx: illegal index: " ++ show idx ++ " (max index: " ++ show Consts.llvm_maxIndex ++ ")"
+    wfir _ = return ()
 
 -- todo; 2018-02-18; not checking atoms at the moment
 -- they may need to be checked too...
@@ -357,18 +351,15 @@ instance WellFormedIRCheck IRExpr where
 wfIRProg :: IRProgram -> Except String ()
 wfIRProg (IRProgram _ funs) = mapM_ wfFun funs
 
-wfFun :: FunDef -> Except String () 
-wfFun (FunDef (HFN fn) (VN arg) consts bb) = 
-    let initVars =[ fn,arg] ++ [i  | VN i <-  fst (unzip consts)]
-        act = do 
-            mapM checkId initVars 
-            wfir bb 
-    in 
-            
-    case evalState (runExceptT act) [] of 
-      Right _ -> return () 
-      Left s -> throwError s 
-
+wfFun :: FunDef -> Except String ()
+wfFun (FunDef (HFN fn) (VN arg) consts bb) =
+    let initVars = [fn, arg] ++ [i | VN i <- fst (unzip consts)]
+        act = do
+            mapM checkId initVars
+            wfir bb
+     in case evalState (runExceptT act) [] of
+            Right _ -> return ()
+            Left s -> throwError s
 
 {--
 checkFromBB initState bb =
@@ -382,95 +373,90 @@ checkFromBB initState bb =
 -----------------------------------------------------------
 
 ppProg (IRProgram atoms funs) =
-  vcat $ (map ppFunDef funs)
+    vcat $ (map ppFunDef funs)
 
 instance Show IRProgram where
-  show = PP.render.ppProg
-
-ppConsts consts = 
-  vcat $ map ppConst consts 
-    where ppConst (x, lit) = hsep [ ppId x , text "=", ppLit lit ]
-
-ppFunDef (FunDef hfn  arg consts insts)
-  = vcat [ text "func" <+> ppFunCall (ppId hfn) [ppId arg] <+> text "{"
-         , nest 2 (ppConsts consts)
-         , nest 2 (ppBB insts)
-         , text "}"]
+    show = PP.render . ppProg
 
+ppConsts consts =
+    vcat $ map ppConst consts
+  where
+    ppConst (x, lit) = hsep [ppId x, text "=", ppLit lit]
 
+ppFunDef (FunDef hfn arg consts insts) =
+    vcat
+        [ text "func" <+> ppFunCall (ppId hfn) [ppId arg] <+> text "{"
+        , nest 2 (ppConsts consts)
+        , nest 2 (ppBB insts)
+        , text "}"
+        ]
 
 ppIRExpr :: IRExpr -> PP.Doc
 ppIRExpr (Bin binop va1 va2) =
-  ppId va1 <+> text (show binop) <+> ppId va2
+    ppId va1 <+> text (show binop) <+> ppId va2
 ppIRExpr (Un op v) =
-  text (show op) <> PP.parens (ppId v)
+    text (show op) <> PP.parens (ppId v)
 ppIRExpr (Tuple vars) =
-  PP.parens $ PP.hsep $ PP.punctuate (text ",") (map ppId vars)
+    PP.parens $ PP.hsep $ PP.punctuate (text ",") (map ppId vars)
 ppIRExpr (List vars) =
-  PP.brackets $ PP.hsep $ PP.punctuate (text ",") (map ppId vars)
+    PP.brackets $ PP.hsep $ PP.punctuate (text ",") (map ppId vars)
 ppIRExpr (ListCons v1 v2) =
-  text "cons" <>  ( PP.parens $ ppId v1 <> text "," <> ppId v2)
+    text "cons" <> (PP.parens $ ppId v1 <> text "," <> ppId v2)
 ppIRExpr (Const (C.LUnit)) = text "__unit"
 ppIRExpr (Const lit) = ppLit lit
-ppIRExpr (Base v) = if v == "$$authorityarg" -- special casing; hack; 2018-10-18: AA
-                      then text v 
-                      else text v <> text "$base"
+ppIRExpr (Base v) =
+    if v == "$$authorityarg" -- special casing; hack; 2018-10-18: AA
+        then text v
+        else text v <> text "$base"
 ppIRExpr (Lib (Basics.LibName l) v) = text l <> text "." <> text v
 ppIRExpr (Record fields) = PP.braces $ qqFields fields
-ppIRExpr (WithRecord x fields) = PP.braces $ PP.hsep[ ppId x, text "with", qqFields fields]
-ppIRExpr (ProjField x f) = 
-  (ppId x) PP.<> PP.text "." PP.<> PP.text f
-ppIRExpr (ProjIdx x idx) = 
-  (ppId x) PP.<> PP.text "." PP.<> PP.text (show idx)
-    
+ppIRExpr (WithRecord x fields) = PP.braces $ PP.hsep [ppId x, text "with", qqFields fields]
+ppIRExpr (ProjField x f) =
+    (ppId x) PP.<> PP.text "." PP.<> PP.text f
+ppIRExpr (ProjIdx x idx) =
+    (ppId x) PP.<> PP.text "." PP.<> PP.text (show idx)
+
 qqFields fields =
-  PP.hsep $ PP.punctuate (text ",") (map ppField fields)
-    where 
-      ppField (name, v) = 
+    PP.hsep $ PP.punctuate (text ",") (map ppField fields)
+  where
+    ppField (name, v) =
         PP.hcat [PP.text name, PP.text "=", ppId v]
 
 ppIR :: IRInst -> PP.Doc
 ppIR (Assign vn st) = ppId vn <+> text "=" <+> ppIRExpr st
-
-ppIR (MkFunClosures varmap fdefs) = 
+ppIR (MkFunClosures varmap fdefs) =
     let vs = hsepc $ ppEnvIds varmap
-        ppFdefs = map (\((VN x), HFN y) ->  text x <+> text "= mkClos" <+> text y ) fdefs 
+        ppFdefs = map (\((VN x), HFN y) -> text x <+> text "= mkClos" <+> text y) fdefs
      in text "with env:=" <+> PP.brackets vs $$ nest 2 (vcat ppFdefs)
-    where ppEnvIds ls =
-            map (\(a,b) -> (ppId a) PP.<+> text "->" <+> ppId b ) ls
-          hsepc ls = PP.hsep (PP.punctuate (text ",") ls)
-
-    
+  where
+    ppEnvIds ls =
+        map (\(a, b) -> (ppId a) PP.<+> text "->" <+> ppId b) ls
+    hsepc ls = PP.hsep (PP.punctuate (text ",") ls)
 
 ppTr (Call vn bb1 bb2) = (ppId vn <+> text "= call" $$ nest 2 (ppBB bb1)) $$ (ppBB bb2)
-
-
-ppTr (AssertElseError va ir va2 _) 
-  = text "assert" <+> PP.parens (ppId va) <+>
-    text "{" $$
-    nest 2 (ppBB ir) $$
-    text "}" $$
-    text "elseError" <+> (ppId va2)
-
-
-ppTr (If va ir1 ir2)
-  = text "if" <+> PP.parens (ppId va) <+>
-    text "{" $$
-    nest 2 (ppBB ir1) $$
-    text "}" $$
-    text "else {" $$
-    nest 2 (ppBB ir2) $$
-    text "}"
+ppTr (AssertElseError va ir va2 _) =
+    text "assert"
+        <+> PP.parens (ppId va)
+        <+> text "{"
+        $$ nest 2 (ppBB ir)
+        $$ text "}"
+        $$ text "elseError" <+> (ppId va2)
+ppTr (If va ir1 ir2) =
+    text "if"
+        <+> PP.parens (ppId va)
+        <+> text "{"
+        $$ nest 2 (ppBB ir1)
+        $$ text "}"
+        $$ text "else {"
+        $$ nest 2 (ppBB ir2)
+        $$ text "}"
 ppTr (TailCall va1 va2) = ppFunCall (text "tail") [ppId va1, ppId va2]
-ppTr (Ret va)  = ppFunCall (text "ret") [ppId va]
+ppTr (Ret va) = ppFunCall (text "ret") [ppId va]
 ppTr (LibExport va) = ppFunCall (text "export") [ppId va]
-ppTr (Error va _)  = (text "error") <> (ppId va)
-
+ppTr (Error va _) = (text "error") <> (ppId va)
 
 ppBB (BB insts tr) = vcat $ (map ppIR insts) ++ [ppTr tr]
 
-
-
 -----------------------------------------------------------
 -- Utils
 -----------------------------------------------------------
@@ -483,28 +469,23 @@ ppVarAccess (VarEnv vn) = text "$env." PP.<> (ppVarName vn)
 ppVarAccess (VarFunSelfRef) = text "<fun-self-ref>"
 
 class Identifier a where
-  ppId :: a ->  PP.Doc
-
+    ppId :: a -> PP.Doc
 
 instance Identifier VarName where
-  ppId = ppVarName
+    ppId = ppVarName
 
 instance Identifier VarAccess where
-  ppId = ppVarAccess
+    ppId = ppVarAccess
 
 instance Identifier HFN where
-  ppId (HFN n) = text n
+    ppId (HFN n) = text n
 
-instance Identifier Basics.LibName where 
-  ppId (Basics.LibName s) = text s
+instance Identifier Basics.LibName where
+    ppId (Basics.LibName s) = text s
 
-instance Identifier Basics.AtomName where 
-  ppId = text
+instance Identifier Basics.AtomName where
+    ppId = text
 
-
-ppArgs args = PP.parens( PP.hcat (PP.punctuate PP.comma args))
+ppArgs args = PP.parens (PP.hcat (PP.punctuate PP.comma args))
 
 ppFunCall fn args = fn <+> ppArgs args
-
-
-
diff --git a/compiler/src/IR2JS.hs b/compiler/src/IR2JS.hs
index ab217dd9..354cf06d 100644
--- a/compiler/src/IR2JS.hs
+++ b/compiler/src/IR2JS.hs
@@ -1,23 +1,19 @@
-module IR2JS where 
+module IR2JS where
 
 import Data.ByteString.Lazy (ByteString)
 import IR
 import qualified IR2Raw (ir2raw)
-import qualified RawOpt 
 import qualified Raw2Stack (raw2Stack)
-import qualified Stack 
+import qualified RawOpt
+import qualified Stack
 import qualified Stack2JS
 
-
 -- RT calls this to compile received code.
 ir2Stack :: SerializationUnit -> Stack.StackUnit
-ir2Stack = Raw2Stack.raw2Stack . RawOpt.rawopt . IR2Raw.ir2raw 
-
+ir2Stack = Raw2Stack.raw2Stack . RawOpt.rawopt . IR2Raw.ir2raw
 
 irToJSString :: SerializationUnit -> String
-irToJSString = Stack2JS.stack2JSString  . ir2Stack 
-
+irToJSString = Stack2JS.stack2JSString . ir2Stack
 
 irToJSON :: SerializationUnit -> ByteString
-irToJSON = Stack2JS.stack2JSON . ir2Stack 
-
+irToJSON = Stack2JS.stack2JSON . ir2Stack
diff --git a/compiler/src/IR2Raw.hs b/compiler/src/IR2Raw.hs
index 7f663c17..2f770351 100644
--- a/compiler/src/IR2Raw.hs
+++ b/compiler/src/IR2Raw.hs
@@ -1,8 +1,9 @@
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StrictData #-}
-{-|
+
+{- |
 
 IR to Raw translation.
 
@@ -33,122 +34,126 @@ abstraction as described above. In addition, the revision includes:
 - Some changed and new IR instructions
 "Revision 2023-08" marks places where semantics of the generated Raw code has changed
 (and other notable changes). We compare against commit b3bd971, a state just before the revision.
-
 -}
 module IR2Raw (ir2raw, prog2raw) where
 
 import qualified Basics
+import Control.Monad
+import Control.Monad.Trans.RWS (RWS, ask, censor, evalRWS, get, listen, put, tell)
+import IR (VarAccess (..))
 import qualified IR
-import IR (VarAccess(..))
 import Raw
-import RetCPS(VarName(..))
-import Control.Monad
-import Control.Monad.Trans.RWS(RWS, evalRWS, ask, get, put, tell, censor, listen)
+import RetCPS (VarName (..))
 
 -- ===== Monad definition =====
 
--- | Translation monad
--- Reader: currently not used
--- Writer: collected instructions
--- State: counter for fresh variables
+{- | Translation monad
+Reader: currently not used
+Writer: collected instructions
+State: counter for fresh variables
+-}
 type TM = RWS () [RawInst] Int
 
--- | Execute the given TM computation, returning the result value and the generated instructions,
--- removing them from the resulting computation (but keeping the counter).
+{- | Execute the given TM computation, returning the result value and the generated instructions,
+removing them from the resulting computation (but keeping the counter).
+-}
 intercept :: TM a -> TM (a, [RawInst])
 intercept = censor (const []) . listen
 
-
 -- ===== Data structures for the abstraction of Raw computations =====
 
--- | Representation of a labelled value, consisting of three 'RawVar's.
--- Not to be distinguished with a runtime LVal, representing a labelled value in the runtime.
-data LVal = LVal { rVal :: RawVar, rValLbl :: RawVar, rTyLbl :: RawVar }
+{- | Representation of a labelled value, consisting of three 'RawVar's.
+Not to be distinguished with a runtime LVal, representing a labelled value in the runtime.
+-}
+data LVal = LVal {rVal :: RawVar, rValLbl :: RawVar, rTyLbl :: RawVar}
 
 -- | Abstraction of a label computation.
 data LabelComp
-    -- | The label stored in the given Raw variable.
-    = Lbl RawVar
-    -- | The value label of the given variable.
-    | ValLbl VarAccess
-    -- | The type label of the given variable.
-    | TyLbl VarAccess
-    -- | The join of the labels described by the given label computations.
-    | Join LabelComp LabelComp [LabelComp]
-    -- | The current PC label.
-    | PC
-
--- | Describes the computation of a simple or labelled value (depending on the expression).
--- See 'RawComp'.
+    = -- | The label stored in the given Raw variable.
+      Lbl RawVar
+    | -- | The value label of the given variable.
+      ValLbl VarAccess
+    | -- | The type label of the given variable.
+      TyLbl VarAccess
+    | -- | The join of the labels described by the given label computations.
+      Join LabelComp LabelComp [LabelComp]
+    | -- | The current PC label.
+      PC
+
+{- | Describes the computation of a simple or labelled value (depending on the expression).
+See 'RawComp'.
+-}
 data ValueComp
-    -- | Result is (or is the value of) the given labelled value.
-    = RVar VarAccess
-    -- | Result is what the given expression computes to.
-    | RExpr RawExpr
-    -- | Result is what the given expression, parametrized over one variable, computes to.
-    | RUn VarAccess (RawVar -> RawExpr)
-    -- | Result is what the given expression, parametrized over two variables, computes to.
-    | RBin VarAccess VarAccess (RawVar -> RawVar -> RawExpr)
-
--- | Describes the computation of a labelled value, divided into a "value computation"
--- and two label computations.
--- NOTE: The computations will be carried out in the order the fields are given in.
+    = -- | Result is (or is the value of) the given labelled value.
+      RVar VarAccess
+    | -- | Result is what the given expression computes to.
+      RExpr RawExpr
+    | -- | Result is what the given expression, parametrized over one variable, computes to.
+      RUn VarAccess (RawVar -> RawExpr)
+    | -- | Result is what the given expression, parametrized over two variables, computes to.
+      RBin VarAccess VarAccess (RawVar -> RawVar -> RawExpr)
+
+{- | Describes the computation of a labelled value, divided into a "value computation"
+and two label computations.
+NOTE: The computations will be carried out in the order the fields are given in.
+-}
 data RawComp
-    -- | A simple computation where the given 'ValueComp' must produce a simple (unlabelled) raw value
-    -- and where the labels are solely determined based on the inputs and PC.
-    = SimpleRawComp
-    { cVal :: ValueComp
-    , cValLbl :: LabelComp
-    , cTyLbl :: LabelComp
-    }
-    -- | A complex computation where the given 'ValueComp' must produce a labelled value.
-    -- These labels are parameters to the label computations.
-    | ComplexRawComp
-    { ccVal :: ValueComp
-    , ccValLbl :: LabelComp -> LabelComp
-    , ccTyLbl :: LabelComp -> LabelComp
-    }
-
+    = {- | A simple computation where the given 'ValueComp' must produce a simple (unlabelled) raw value
+      and where the labels are solely determined based on the inputs and PC.
+      -}
+      SimpleRawComp
+        { cVal :: ValueComp
+        , cValLbl :: LabelComp
+        , cTyLbl :: LabelComp
+        }
+    | {- | A complex computation where the given 'ValueComp' must produce a labelled value.
+      These labels are parameters to the label computations.
+      -}
+      ComplexRawComp
+        { ccVal :: ValueComp
+        , ccValLbl :: LabelComp -> LabelComp
+        , ccTyLbl :: LabelComp -> LabelComp
+        }
 
 -- ===== Helper functions =====
 
 nextVarNum :: TM Int
 nextVarNum = do
-  i <- get
-  put (i + 1)
-  return i
+    i <- get
+    put (i + 1)
+    return i
 
 freshRawVar :: TM RawVar
 freshRawVar = freshRawVarWith "_raw_"
 
 freshRawVarWith :: String -> TM RawVar
 freshRawVarWith s = do
-  i <- nextVarNum
-  return $ RawVar $ s ++ show i
+    i <- nextVarNum
+    return $ RawVar $ s ++ show i
 
 freshLValVar :: TM VarName
 freshLValVar = do
-  i <- nextVarNum
-  return $ VN ("lval" ++ show i)
+    i <- nextVarNum
+    return $ VN ("lval" ++ show i)
 
 -- | Assign an expression to a Raw variable.
 assignRExpr :: RawExpr -> TM RawVar
 assignRExpr e = do
-  r <- freshRawVar
-  tell [AssignRaw r e]
-  return r
+    r <- freshRawVar
+    tell [AssignRaw r e]
+    return r
 
 -- | Assign an expression to the given variable.
 assignLVal :: VarName -> RawExpr -> TM ()
 assignLVal vn e = do
-  tell [AssignLVal vn e]
+    tell [AssignLVal vn e]
 
 -- | Assign an expression to a new variable representing a labelled value.
 assignLVal' :: RawExpr -> TM VarAccess
 assignLVal' e = do
-  vn <- freshLValVar
-  assignLVal vn e
-  return $ IR.VarLocal vn
+    vn <- freshLValVar
+    assignLVal vn e
+    return $ IR.VarLocal vn
 
 -- | Construct a labelled value in the runtime from the given 'LVal' and assign it to the given variable.
 constructLVal :: VarName -> LVal -> TM ()
@@ -158,47 +163,53 @@ constructLVal vn LVal{..} = assignLVal vn $ ConstructLVal rVal rValLbl rTyLbl
 constructLVal' :: LVal -> TM VarAccess
 constructLVal' LVal{..} = assignLVal' $ ConstructLVal rVal rValLbl rTyLbl
 
--- | Generate instructions assigning the components of a runtime LVal
--- to individual variables.
+{- | Generate instructions assigning the components of a runtime LVal
+to individual variables.
+-}
 getLVal :: VarAccess -> TM LVal
 getLVal va = do
-  rVal <- freshRawVarWith "_val_"
-  rValLbl <- freshRawVarWith "_vlbl_"
-  rTyLbl <- freshRawVarWith "_tlbl_"
+    rVal <- freshRawVarWith "_val_"
+    rValLbl <- freshRawVarWith "_vlbl_"
+    rTyLbl <- freshRawVarWith "_tlbl_"
 
-  mapM_
-    (\(r, f) -> tell [AssignRaw r (ProjectLVal va f)])
-    [ (rVal, FieldValue),
-      (rValLbl, FieldValLev),
-      (rTyLbl, FieldTypLev)
-    ]
+    mapM_
+        (\(r, f) -> tell [AssignRaw r (ProjectLVal va f)])
+        [ (rVal, FieldValue)
+        , (rValLbl, FieldValLev)
+        , (rTyLbl, FieldTypLev)
+        ]
 
-  return LVal {..}
+    return LVal{..}
 
--- | Generate instructions setting the three parts of the R0 register
--- to the values of the given 'RawVar's.
+{- | Generate instructions setting the three parts of the R0 register
+to the values of the given 'RawVar's.
+-}
 setR0 :: LVal -> TM ()
 setR0 LVal{..} =
-    tell [ SetState R0_Val rVal
-         , SetState R0_Lev rValLbl
-         , SetState R0_TLev rTyLbl
-         ]
-
--- | Generate instructions assigning the three parts of the R0 register
--- to new Raw variables.
+    tell
+        [ SetState R0_Val rVal
+        , SetState R0_Lev rValLbl
+        , SetState R0_TLev rTyLbl
+        ]
+
+{- | Generate instructions assigning the three parts of the R0 register
+to new Raw variables.
+-}
 getR0 :: TM LVal
 getR0 = do
-  rVal <- freshRawVarWith "_$reg0_val_"
-  rValLbl <- freshRawVarWith "_$reg0_vlbl_"
-  rTyLbl <- freshRawVarWith "_$reg0_tlbl_"
-  tell [ AssignRaw rVal (ProjectState R0_Val)
-       , AssignRaw rValLbl (ProjectState R0_Lev)
-       , AssignRaw rTyLbl (ProjectState R0_TLev)
-       ]
-  return LVal{..}
-
--- | Generate instructions assigning the value of the given runtime LVal
--- to a new Raw variable.
+    rVal <- freshRawVarWith "_$reg0_val_"
+    rValLbl <- freshRawVarWith "_$reg0_vlbl_"
+    rTyLbl <- freshRawVarWith "_$reg0_tlbl_"
+    tell
+        [ AssignRaw rVal (ProjectState R0_Val)
+        , AssignRaw rValLbl (ProjectState R0_Lev)
+        , AssignRaw rTyLbl (ProjectState R0_TLev)
+        ]
+    return LVal{..}
+
+{- | Generate instructions assigning the value of the given runtime LVal
+to a new Raw variable.
+-}
 getVal :: VarAccess -> TM RawVar
 getVal va = do
     rVal <- freshRawVarWith "_val_"
@@ -210,19 +221,21 @@ projectLVal VarFunSelfRef FieldTypLev = ProjectState MonPC
 projectLVal VarFunSelfRef FieldValLev = ProjectState MonPC
 projectLVal va field = ProjectLVal va field
 
--- | Generate instructions assigning the value label of the given runtime LVal
--- to a new Raw variable.
+{- | Generate instructions assigning the value label of the given runtime LVal
+to a new Raw variable.
+-}
 getValLbl :: VarAccess -> TM RawVar
 getValLbl va = do
     rValLbl <- freshRawVarWith "_vlbl_"
     tell [AssignRaw rValLbl (projectLVal va FieldValLev)]
     return rValLbl
 
--- | Generate instructions assigning the type label of the given runtime LVal
--- to a new Raw variable.
+{- | Generate instructions assigning the type label of the given runtime LVal
+to a new Raw variable.
+-}
 getTyLbl :: VarAccess -> TM RawVar
 getTyLbl va = do
-    rTyLbl <- freshRawVarWith "_tlbl_"    
+    rTyLbl <- freshRawVarWith "_tlbl_"
     tell [AssignRaw rTyLbl (projectLVal va FieldTypLev)]
     return rTyLbl
 
@@ -230,549 +243,572 @@ getTyLbl va = do
 getPC :: TM RawVar
 getPC = do
     pc <- freshRawVarWith "_pc_"
-    tell [AssignRaw pc (ProjectState MonPC) ]
+    tell [AssignRaw pc (ProjectState MonPC)]
     return pc
 
 -- | Generate instructions assigning the current blocking label to a new Raw variable.
 getBlock :: TM RawVar
 getBlock = do
     bl <- freshRawVarWith "_bl_"
-    tell [AssignRaw bl (ProjectState MonBlock) ]
+    tell [AssignRaw bl (ProjectState MonBlock)]
     return bl
 
--- | Generate instructions raising the PC with the label in the given variable.
--- Not to be used directly, see functions below instead.
+{- | Generate instructions raising the PC with the label in the given variable.
+Not to be used directly, see functions below instead.
+-}
 _raisePC :: RawVar -> TM ()
 _raisePC raiseBy = do
-  pc <- getPC
-  pc' <- freshRawVarWith "_pc_"
-  tell [ AssignRaw pc' (_default_bin Basics.LatticeJoin pc raiseBy)
-       , SetState MonPC pc'
-       ]
+    pc <- getPC
+    pc' <- freshRawVarWith "_pc_"
+    tell
+        [ AssignRaw pc' (_default_bin Basics.LatticeJoin pc raiseBy)
+        , SetState MonPC pc'
+        ]
 
-_default_bin op r1 r2 = Bin op (UseNativeBinop False) r1 r2 
+_default_bin op r1 r2 = Bin op (UseNativeBinop False) r1 r2
 
--- | Generate instructions raising the blocking label with the label in the given variable.
--- Not to be used directly, see functions below instead.
+{- | Generate instructions raising the blocking label with the label in the given variable.
+Not to be used directly, see functions below instead.
+-}
 _raiseBlock :: RawVar -> TM ()
 _raiseBlock raiseBy = do
-  bl  <- getBlock
-  bl' <- freshRawVarWith "_bl_"
-  tell [ AssignRaw bl' (_default_bin Basics.LatticeJoin bl raiseBy)
-       , SetState MonBlock bl'
-       ]
-
--- | Generate instructions raising both PC and blocking label with the label in the given variable.
--- Because of the invariant pc ⊑ block, the blocking label should always be raised when raising PC.
+    bl <- getBlock
+    bl' <- freshRawVarWith "_bl_"
+    tell
+        [ AssignRaw bl' (_default_bin Basics.LatticeJoin bl raiseBy)
+        , SetState MonBlock bl'
+        ]
+
+{- | Generate instructions raising both PC and blocking label with the label in the given variable.
+Because of the invariant pc ⊑ block, the blocking label should always be raised when raising PC.
+-}
 raisePCAndBlock :: LabelComp -> TM ()
 raisePCAndBlock raiseByComp = do
-  raiseBy <- compLabel raiseByComp
-  _raisePC raiseBy
-  _raiseBlock raiseBy
+    raiseBy <- compLabel raiseByComp
+    _raisePC raiseBy
+    _raiseBlock raiseBy
 
 -- | Generate instructions raising the blocking label with the label in the given variable.
 raiseBlock :: LabelComp -> TM ()
 raiseBlock raiseByComp = do
-  raiseBy <- compLabel raiseByComp
-  _raiseBlock raiseBy
+    raiseBy <- compLabel raiseByComp
+    _raiseBlock raiseBy
 
--- | Generate instructions for asserting the type of the given runtime LVal.
--- Consists of first raising the blocking label with the type label of that LVal and
--- then an assert instruction with the given type.
+{- | Generate instructions for asserting the type of the given runtime LVal.
+Consists of first raising the blocking label with the type label of that LVal and
+then an assert instruction with the given type.
+-}
 assertTypeAndRaise :: VarAccess -> RawType -> TM ()
 assertTypeAndRaise va t = do
-  raiseBlock $ TyLbl va
-  r <- getVal va
-  tell [ RTAssertion $ AssertType r t ]
+    raiseBlock $ TyLbl va
+    r <- getVal va
+    tell [RTAssertion $ AssertType r t]
 
 -- Note: Currently, RT does not support general type equality check.
 -- assertEqTypes :: [RawType] -> RawVar -> RawVar -> TM ()
 
--- | Generate instructions for asserting that the types of the given runtime LVals
--- are either both string or both numbers.
+{- | Generate instructions for asserting that the types of the given runtime LVals
+are either both string or both numbers.
+-}
 assertTypesBothStringsOrBothNumbers :: VarAccess -> VarAccess -> TM ()
 assertTypesBothStringsOrBothNumbers va1 va2 = do
-  raiseBlock $ Join (TyLbl va1) (TyLbl va2) []
-  r1 <- getVal va1
-  r2 <- getVal va2
-  tell [RTAssertion $ AssertTypesBothStringsOrBothNumbers r1 r2]
+    raiseBlock $ Join (TyLbl va1) (TyLbl va2) []
+    r1 <- getVal va1
+    r2 <- getVal va2
+    tell [RTAssertion $ AssertTypesBothStringsOrBothNumbers r1 r2]
 
--- | Generate instructions raising the blocking label with the value label of the
--- given runtime LVal and an assertion based on the value, specified by the given function.
+{- | Generate instructions raising the blocking label with the value label of the
+given runtime LVal and an assertion based on the value, specified by the given function.
+-}
 assertWithValAndRaise :: VarAccess -> (RawVar -> RTAssertion) -> TM ()
 assertWithValAndRaise va f = do
-  raiseBlock $ ValLbl va
-  r <- getVal va
-  tell [RTAssertion $ f r]
+    raiseBlock $ ValLbl va
+    r <- getVal va
+    tell [RTAssertion $ f r]
 
 -- | See 'InvalidateSparseBit'.
 invalidateSparseBit :: TM ()
 invalidateSparseBit = tell [InvalidateSparseBit]
 
-
 -- ===== Translations from the defined abstractions to Raw instructions =====
 
 -- | Generate instructions for a 'ValueComp' where the expected result is a simple raw value.
 compSimple :: ValueComp -> TM RawVar
 compSimple = \case
-  RVar va -> getVal va
-  RExpr e -> assignRExpr e
-  RUn va f -> do
-    r <- getVal va
-    assignRExpr $ f r
-  RBin va1 va2 f -> do
-    r1 <- getVal va1
-    r2 <- getVal va2
-    assignRExpr $ f r1 r2
-
--- | Generate instructions for a 'ValueComp' where the expected result is a labelled value.
--- The main difference to 'compSimple' is the return type, together with that the 'AssignLVal'
--- instruction is used instead of the 'AssignRaw' instruction, as a labelled value is computed.
+    RVar va -> getVal va
+    RExpr e -> assignRExpr e
+    RUn va f -> do
+        r <- getVal va
+        assignRExpr $ f r
+    RBin va1 va2 f -> do
+        r1 <- getVal va1
+        r2 <- getVal va2
+        assignRExpr $ f r1 r2
+
+{- | Generate instructions for a 'ValueComp' where the expected result is a labelled value.
+The main difference to 'compSimple' is the return type, together with that the 'AssignLVal'
+instruction is used instead of the 'AssignRaw' instruction, as a labelled value is computed.
+-}
 compComplex :: ValueComp -> TM VarAccess
 compComplex = \case
-  RVar va -> return va
-  RExpr e -> assignLVal' e
-  RUn va f -> do
-    r <- getVal va
-    assignLVal' $ f r
-  RBin va1 va2 f -> do
-    r1 <- getVal va1
-    r2 <- getVal va2
-    assignLVal' $ f r1 r2
+    RVar va -> return va
+    RExpr e -> assignLVal' e
+    RUn va f -> do
+        r <- getVal va
+        assignLVal' $ f r
+    RBin va1 va2 f -> do
+        r1 <- getVal va1
+        r2 <- getVal va2
+        assignLVal' $ f r1 r2
 
 -- | Generate instructions for a 'LabelComp'.
 compLabel :: LabelComp -> TM RawVar
 compLabel = \case
-  Lbl r -> return r
-  ValLbl va -> getValLbl va
-  TyLbl va -> getTyLbl va
-  Join c1 c2 cs -> do
-    r <- compLabel c1
-    rs <- mapM compLabel (c2:cs)
-    if null rs
-    then return r
-    else foldM (\(r1 :: RawVar) (r2 :: RawVar) -> do
-                   r' :: RawVar <- freshRawVarWith "_lbl_"
-                   tell [ AssignRaw r' $ _default_bin Basics.LatticeJoin r1 r2 ]
-                   return r'
-               ) r rs
-  PC -> getPC
-
--- | Generate instructions joining the current PC label into the given
--- variable's value and type labels.
+    Lbl r -> return r
+    ValLbl va -> getValLbl va
+    TyLbl va -> getTyLbl va
+    Join c1 c2 cs -> do
+        r <- compLabel c1
+        rs <- mapM compLabel (c2 : cs)
+        if null rs
+            then return r
+            else
+                foldM
+                    ( \(r1 :: RawVar) (r2 :: RawVar) -> do
+                        r' :: RawVar <- freshRawVarWith "_lbl_"
+                        tell [AssignRaw r' $ _default_bin Basics.LatticeJoin r1 r2]
+                        return r'
+                    )
+                    r
+                    rs
+    PC -> getPC
+
+{- | Generate instructions joining the current PC label into the given
+variable's value and type labels.
+-}
 pcTaint :: VarAccess -> TM VarAccess
 pcTaint va = do
-  rVal <- getVal va
-  rValLbl <- compLabel $ Join PC (ValLbl va) []
-  rTyLbl <- compLabel $ Join PC (TyLbl va) []
-  constructLVal' $ LVal{..}
-
+    rVal <- getVal va
+    rValLbl <- compLabel $ Join PC (ValLbl va) []
+    rTyLbl <- compLabel $ Join PC (TyLbl va) []
+    constructLVal' $ LVal{..}
 
 -- ===== Translation functions for the different components of a program =====
 
 expr2raw :: IR.IRExpr -> TM LVal
-expr2raw e = expr2rawComp e >>= \case
-    SimpleRawComp{..} -> do
-      rVal <- compSimple cVal
-      rValLbl <- compLabel cValLbl
-      rTyLbl <- compLabel cTyLbl
-      return LVal{..}
-    ComplexRawComp{..} -> do
-      v <- compComplex ccVal
-      rVal <- getVal v
-      rResValLbl <- getValLbl v
-      rResTyLbl <- getTyLbl v
-      rValLbl <- compLabel (ccValLbl $ Lbl rResValLbl)
-      rTyLbl <- compLabel (ccTyLbl $ Lbl rResTyLbl)
-      return LVal{..}
+expr2raw e =
+    expr2rawComp e >>= \case
+        SimpleRawComp{..} -> do
+            rVal <- compSimple cVal
+            rValLbl <- compLabel cValLbl
+            rTyLbl <- compLabel cTyLbl
+            return LVal{..}
+        ComplexRawComp{..} -> do
+            v <- compComplex ccVal
+            rVal <- getVal v
+            rResValLbl <- getValLbl v
+            rResTyLbl <- getTyLbl v
+            rValLbl <- compLabel (ccValLbl $ Lbl rResValLbl)
+            rTyLbl <- compLabel (ccTyLbl $ Lbl rResTyLbl)
+            return LVal{..}
 
 -- | Definition of the Raw computations for expressions.
 expr2rawComp :: IR.IRExpr -> TM RawComp
 expr2rawComp = \case
-  IR.Const lit -> return $ SimpleRawComp
-    { cVal = RExpr $ Const lit
-    , cValLbl = PC
-    , cTyLbl = PC
-    }
-
-  -- TODO Special cases should probably have their own type/instruction.
-  IR.Base "$$authorityarg" -> return $
-    let v = IR.VarLocal (VN "$$authorityarg") in
-    SimpleRawComp
-    { cVal = RVar v
-    , cValLbl = ValLbl v
-    , cTyLbl = TyLbl v
-    }
-
-  -- Revision 2023-08: Changed the runtime to create unlabelled values for
-  -- base functions. Previously, a labelled value with bottom and null labels
-  -- as created by the runtime, and then handled here like with 'ComplexRawComp',
-  -- assigning constant PC labels.
-  IR.Base v -> return $ SimpleRawComp
-    { cVal = RExpr $ Base v
-    , cValLbl = PC
-    , cTyLbl = PC
-    }
-
-  -- The following constructor operations take labelled values as arguments,
-  -- but these labels do not affect the labels of the resulting compound value.
-  IR.Tuple vs ->
-    return SimpleRawComp
-      { cVal = RExpr $ Tuple vs
-      , cValLbl = PC
-      , cTyLbl = PC
-      }
-  IR.List vs ->
-    return SimpleRawComp
-      { cVal = RExpr $ List vs
-      , cValLbl = PC
-      , cTyLbl = PC
-      }
-  IR.Record fs ->
-    return SimpleRawComp
-      { cVal = RExpr $ Record fs
-      , cValLbl = PC
-      , cTyLbl = PC
-      }
-
-  -- The following two constructors extend an existing collection data structure
-  -- with new values. The given labelled values are just added to the collection
-  -- and not touched, therefore their labels are not joined into the datastructure's
-  -- label.
-  IR.ListCons v l -> do
-    assertTypeAndRaise l RawList
-    return SimpleRawComp
-      { cVal = RUn l $ ListCons v
-      , cValLbl = Join PC (ValLbl l) []
-      , cTyLbl = PC
-      }
-  IR.WithRecord v fs -> do
-    assertTypeAndRaise v RawRecord
-    return SimpleRawComp
-      { cVal = RUn v $ \r -> WithRecord r fs
-      , cValLbl = Join PC (ValLbl v) []
-      , cTyLbl = PC
-      }
-
-  -- For the following projection operations (as well as for 'Basics.Head'), a labelled value
-  -- is extracted from a collection. The value label of the collection is joined into the value label
-  -- of the extracted value. It is necessary to do this at projection, as the label of the
-  -- data structure might have been raised.
-  -- Revision 2023-08: 'ProjField' is the new name for the previous 'Proj' for records,
-  -- to distinguish from the new 'ProjIdx' for tuples. The returned labelled value is
-  -- the same. New is the 'AssertRecordHasField' assertion which was missing (together
-  -- with raising the blocking label accordingly).
-  IR.ProjField v field -> do
-    assertTypeAndRaise v RawRecord
-    assertWithValAndRaise v $ \r -> AssertRecordHasField r field
-    return ComplexRawComp
-      { ccVal = RUn v $ \r -> ProjField r field
-      , ccValLbl = \resValLbl -> Join PC (ValLbl v) [resValLbl]
-      , ccTyLbl = \resTyLbl -> Join PC resTyLbl []
-      }
-  -- Revision 2023-08: 'ProjIdx' is the new indexing operation for tuples replacing
-  -- the previous 'Index'. The difference is that the index is a constant to the operation
-  -- instead of a variable. Previously, the type label of the tuple was incorrectly joined
-  -- into the result type label.
-  IR.ProjIdx v idx -> do
-    assertTypeAndRaise v RawTuple
-    assertWithValAndRaise v $ \r -> AssertTupleLengthGreaterThan r idx
-    return ComplexRawComp
-      { ccVal = RUn v $ \r -> ProjIdx r idx
-      , ccValLbl = \resValLbl -> Join PC (ValLbl v) [resValLbl]
-      , ccTyLbl = \resTyLbl -> Join PC resTyLbl []
-      }
-
-  -- Revision 2023-08: Changed the RT operation to return an unlabelled value,
-  -- as the labels are PC anyway.
-  IR.Lib libname funname ->
-    return SimpleRawComp
-      { cVal = RExpr $ Lib libname funname
-      , cValLbl = PC
-      , cTyLbl = PC
-      }
-
-  -- Revision 2023-08: Raising of the blocking label with an argument's type label and
-  -- an assertion on this argument are now coupled together for each argument (if possible).
-  -- This results in higher granularity for the blocking label: when the first assertion fails,
-  -- the blocking label is only raised with the type label of the first argument, not with that of
-  -- the second.
-  IR.Bin op v1 v2 ->
-    -- Basic binary op computation, where the value label is the join of those of the input and the type label is PC
-    -- (for operations where the result type is fixed).
-    let basicBinOpComp =
-         return SimpleRawComp
-          { cVal = RBin v1 v2 $ Bin op (UseNativeBinop True)
-          , cValLbl = Join PC (ValLbl v1) [ValLbl v2]
-          , cTyLbl = PC
-          }
-        numBinOpComp = do
-          assertTypeAndRaise v1 RawNumber
-          assertTypeAndRaise v2 RawNumber
-          basicBinOpComp
-        stringBinOpComp = do
-          assertTypeAndRaise v1 RawString
-          assertTypeAndRaise v2 RawString
-          basicBinOpComp
-        -- Note: The result type is boolean in any case.
-        numOrStringBinOpComp = do
-          assertTypesBothStringsOrBothNumbers v1 v2
-          basicBinOpComp
-
-    in case op of
-      Basics.Plus -> numBinOpComp
-      Basics.Minus -> numBinOpComp
-      Basics.Mult -> numBinOpComp
-      -- Note: Division operations now check for division by zero.
-      -- Revision 2023-08: Removed incorrect raising of PC by value label
-      -- of second operand (the operation always succeeds).
-      Basics.Div -> do
-        assertTypeAndRaise v1 RawNumber
-        assertTypeAndRaise v2 RawNumber
-        assertWithValAndRaise v2 $ \r -> AssertNotZero r
-        basicBinOpComp
-      Basics.Mod -> do
-        assertTypeAndRaise v1 RawNumber
-        assertTypeAndRaise v2 RawNumber
-        assertWithValAndRaise v2 $ \r -> AssertNotZero r
-        basicBinOpComp
-      Basics.IntDiv -> do
-        assertTypeAndRaise v1 RawNumber
-        assertTypeAndRaise v2 RawNumber
-        assertWithValAndRaise v2 $ \r -> AssertNotZero r
-        basicBinOpComp
-      Basics.Gt -> numOrStringBinOpComp
-      Basics.Lt -> numOrStringBinOpComp
-      Basics.Ge -> numOrStringBinOpComp
-      Basics.Le -> numOrStringBinOpComp
-      Basics.Concat -> stringBinOpComp
-
-      -- Revision 2023-08: Changed special handling as a "ComplexBin" (where the
-      -- inputs to the runtime operation were labelled values) to a normal
-      -- 'ComplexRawComp', where label computations with the labels of the inputs
-      -- are handled here instead. This removes the need for the runtime to compute
-      -- joins for shallow comparisons and allows for more optimization at Raw level.
-      -- The runtime only considers labels of nested values, which are joined into
-      -- the the returned labelled value (which is then joined here).
-      -- The downside is that we are now always constructing a new LVal here, in
-      -- addition to the one constructed in the RT, and that we always have to join the
-      -- returned value label.
-      -- Note: Even though the result depends on the types of the parameters, it is sufficient to join their
-      -- value labels into the result's value label, due to the invariant tyLbl ⊑ valLbl.
-      Basics.Eq -> return ComplexRawComp
-        { ccVal = RBin v1 v2 $ Bin op (UseNativeBinop False)
-        , ccValLbl = \resValLbl -> Join PC (ValLbl v1) [ValLbl v2, resValLbl]
-        , ccTyLbl = const PC -- The result type is always boolean
-        }
-      Basics.Neq -> return ComplexRawComp
-        { ccVal = RBin v1 v2 $ Bin op (UseNativeBinop False)
-        , ccValLbl = \resValLbl -> Join PC (ValLbl v1) [ValLbl v2, resValLbl]
-        , ccTyLbl = const PC -- The result type is always boolean
-        }
-      -- Revision 2023-08: Introduced new instruction InvalidateSparseBit
-      -- (before this was called by a runtime raisedTo operation, which is now not necessary anymore).
-      -- Otherwise equivalent except for order of instructions.
-      Basics.RaisedTo -> do
-        assertTypeAndRaise v2 RawLevel
-        rRaiseTo <- getVal v2
-        invalidateSparseBit
-        return SimpleRawComp
-          { cVal = RVar v1
-          , cValLbl = Join PC (ValLbl v1) [ValLbl v2, Lbl rRaiseTo]
-          , cTyLbl = Join PC (TyLbl v1) []
-          }
-      Basics.HasField -> do
-        assertTypeAndRaise v1 RawRecord
-        assertTypeAndRaise v2 RawString
-        basicBinOpComp
-      
-      -- Bit operations
-      Basics.BinAnd -> numBinOpComp
-      Basics.BinOr -> numBinOpComp
-      Basics.BinXor -> numBinOpComp
-      Basics.BinShiftLeft -> numBinOpComp
-      Basics.BinShiftRight -> numBinOpComp
-      Basics.BinZeroShiftRight -> numBinOpComp
-
-      -- TODO Implement remaining operations
-      _ -> error $ "Binary operation not yet implemented: " ++ show op
-
-  IR.Un op v ->
-    -- Basic unary op computation, where the value label is that of the input and the type label is PC
-    -- (for operations where the result type is fixed).
-    let basicUnOpComp =
-         return SimpleRawComp
-          { cVal = RUn v $ Un op
-          , cValLbl = Join PC (ValLbl v) []
-          , cTyLbl = PC
-          }
-    in case op of
-      -- Revision 2023-08: Not raising block for IsTuple, IsList, IsRecord anymore, as they cannot fail. Otherwise equivalent.
-      Basics.IsTuple -> basicUnOpComp
-      Basics.IsList -> basicUnOpComp
-      Basics.IsRecord -> basicUnOpComp
-      -- Revision 2023-08: Separate operations for list and tuple length.
-      -- Now also asserting the type (before only block was raised).
-      Basics.ListLength -> do
-        assertTypeAndRaise v RawList
-        basicUnOpComp
-      Basics.TupleLength -> do
-        assertTypeAndRaise v RawTuple
-        basicUnOpComp
-      Basics.RecordSize -> do
+    IR.Const lit ->
+        return $
+            SimpleRawComp
+                { cVal = RExpr $ Const lit
+                , cValLbl = PC
+                , cTyLbl = PC
+                }
+    -- TODO Special cases should probably have their own type/instruction.
+    IR.Base "$$authorityarg" ->
+        return $
+            let v = IR.VarLocal (VN "$$authorityarg")
+             in SimpleRawComp
+                    { cVal = RVar v
+                    , cValLbl = ValLbl v
+                    , cTyLbl = TyLbl v
+                    }
+    -- Revision 2023-08: Changed the runtime to create unlabelled values for
+    -- base functions. Previously, a labelled value with bottom and null labels
+    -- as created by the runtime, and then handled here like with 'ComplexRawComp',
+    -- assigning constant PC labels.
+    IR.Base v ->
+        return $
+            SimpleRawComp
+                { cVal = RExpr $ Base v
+                , cValLbl = PC
+                , cTyLbl = PC
+                }
+    -- The following constructor operations take labelled values as arguments,
+    -- but these labels do not affect the labels of the resulting compound value.
+    IR.Tuple vs ->
+        return
+            SimpleRawComp
+                { cVal = RExpr $ Tuple vs
+                , cValLbl = PC
+                , cTyLbl = PC
+                }
+    IR.List vs ->
+        return
+            SimpleRawComp
+                { cVal = RExpr $ List vs
+                , cValLbl = PC
+                , cTyLbl = PC
+                }
+    IR.Record fs ->
+        return
+            SimpleRawComp
+                { cVal = RExpr $ Record fs
+                , cValLbl = PC
+                , cTyLbl = PC
+                }
+    -- The following two constructors extend an existing collection data structure
+    -- with new values. The given labelled values are just added to the collection
+    -- and not touched, therefore their labels are not joined into the datastructure's
+    -- label.
+    IR.ListCons v l -> do
+        assertTypeAndRaise l RawList
+        return
+            SimpleRawComp
+                { cVal = RUn l $ ListCons v
+                , cValLbl = Join PC (ValLbl l) []
+                , cTyLbl = PC
+                }
+    IR.WithRecord v fs -> do
         assertTypeAndRaise v RawRecord
-        basicUnOpComp
-      -- Revision 2023-08: Equivalent.
-      Basics.Tail -> do
-        assertTypeAndRaise v RawList
-        basicUnOpComp
-      -- Revision 2023-08: Now also joining PC into value label (missed due to a typo in the previous version)
-      Basics.Head -> do
-        assertTypeAndRaise v RawList
-        return ComplexRawComp
-          { ccVal = RUn v $ Un op
-          , ccValLbl = \resValLbl -> Join PC (ValLbl v) [resValLbl]
-          , ccTyLbl = \resTyLbl -> Join PC resTyLbl []
-          }
-      -- Revision 2023-08: Now setting type label to PC instead of joining original type label (as the type is asserted).
-      Basics.UnMinus -> do
-        assertTypeAndRaise v RawNumber
-        basicUnOpComp
-
-      -- TODO Implement remaining operations
-      _ -> error $ "Unary operation not yet implemented: " ++ show op
-
+        return
+            SimpleRawComp
+                { cVal = RUn v $ \r -> WithRecord r fs
+                , cValLbl = Join PC (ValLbl v) []
+                , cTyLbl = PC
+                }
+
+    -- For the following projection operations (as well as for 'Basics.Head'), a labelled value
+    -- is extracted from a collection. The value label of the collection is joined into the value label
+    -- of the extracted value. It is necessary to do this at projection, as the label of the
+    -- data structure might have been raised.
+    -- Revision 2023-08: 'ProjField' is the new name for the previous 'Proj' for records,
+    -- to distinguish from the new 'ProjIdx' for tuples. The returned labelled value is
+    -- the same. New is the 'AssertRecordHasField' assertion which was missing (together
+    -- with raising the blocking label accordingly).
+    IR.ProjField v field -> do
+        assertTypeAndRaise v RawRecord
+        assertWithValAndRaise v $ \r -> AssertRecordHasField r field
+        return
+            ComplexRawComp
+                { ccVal = RUn v $ \r -> ProjField r field
+                , ccValLbl = \resValLbl -> Join PC (ValLbl v) [resValLbl]
+                , ccTyLbl = \resTyLbl -> Join PC resTyLbl []
+                }
+    -- Revision 2023-08: 'ProjIdx' is the new indexing operation for tuples replacing
+    -- the previous 'Index'. The difference is that the index is a constant to the operation
+    -- instead of a variable. Previously, the type label of the tuple was incorrectly joined
+    -- into the result type label.
+    IR.ProjIdx v idx -> do
+        assertTypeAndRaise v RawTuple
+        assertWithValAndRaise v $ \r -> AssertTupleLengthGreaterThan r idx
+        return
+            ComplexRawComp
+                { ccVal = RUn v $ \r -> ProjIdx r idx
+                , ccValLbl = \resValLbl -> Join PC (ValLbl v) [resValLbl]
+                , ccTyLbl = \resTyLbl -> Join PC resTyLbl []
+                }
+
+    -- Revision 2023-08: Changed the RT operation to return an unlabelled value,
+    -- as the labels are PC anyway.
+    IR.Lib libname funname ->
+        return
+            SimpleRawComp
+                { cVal = RExpr $ Lib libname funname
+                , cValLbl = PC
+                , cTyLbl = PC
+                }
+    -- Revision 2023-08: Raising of the blocking label with an argument's type label and
+    -- an assertion on this argument are now coupled together for each argument (if possible).
+    -- This results in higher granularity for the blocking label: when the first assertion fails,
+    -- the blocking label is only raised with the type label of the first argument, not with that of
+    -- the second.
+    IR.Bin op v1 v2 ->
+        -- Basic binary op computation, where the value label is the join of those of the input and the type label is PC
+        -- (for operations where the result type is fixed).
+        let basicBinOpComp =
+                return
+                    SimpleRawComp
+                        { cVal = RBin v1 v2 $ Bin op (UseNativeBinop True)
+                        , cValLbl = Join PC (ValLbl v1) [ValLbl v2]
+                        , cTyLbl = PC
+                        }
+            numBinOpComp = do
+                assertTypeAndRaise v1 RawNumber
+                assertTypeAndRaise v2 RawNumber
+                basicBinOpComp
+            stringBinOpComp = do
+                assertTypeAndRaise v1 RawString
+                assertTypeAndRaise v2 RawString
+                basicBinOpComp
+            -- Note: The result type is boolean in any case.
+            numOrStringBinOpComp = do
+                assertTypesBothStringsOrBothNumbers v1 v2
+                basicBinOpComp
+         in case op of
+                Basics.Plus -> numBinOpComp
+                Basics.Minus -> numBinOpComp
+                Basics.Mult -> numBinOpComp
+                -- Note: Division operations now check for division by zero.
+                -- Revision 2023-08: Removed incorrect raising of PC by value label
+                -- of second operand (the operation always succeeds).
+                Basics.Div -> do
+                    assertTypeAndRaise v1 RawNumber
+                    assertTypeAndRaise v2 RawNumber
+                    assertWithValAndRaise v2 $ \r -> AssertNotZero r
+                    basicBinOpComp
+                Basics.Mod -> do
+                    assertTypeAndRaise v1 RawNumber
+                    assertTypeAndRaise v2 RawNumber
+                    assertWithValAndRaise v2 $ \r -> AssertNotZero r
+                    basicBinOpComp
+                Basics.IntDiv -> do
+                    assertTypeAndRaise v1 RawNumber
+                    assertTypeAndRaise v2 RawNumber
+                    assertWithValAndRaise v2 $ \r -> AssertNotZero r
+                    basicBinOpComp
+                Basics.Gt -> numOrStringBinOpComp
+                Basics.Lt -> numOrStringBinOpComp
+                Basics.Ge -> numOrStringBinOpComp
+                Basics.Le -> numOrStringBinOpComp
+                Basics.Concat -> stringBinOpComp
+                -- Revision 2023-08: Changed special handling as a "ComplexBin" (where the
+                -- inputs to the runtime operation were labelled values) to a normal
+                -- 'ComplexRawComp', where label computations with the labels of the inputs
+                -- are handled here instead. This removes the need for the runtime to compute
+                -- joins for shallow comparisons and allows for more optimization at Raw level.
+                -- The runtime only considers labels of nested values, which are joined into
+                -- the the returned labelled value (which is then joined here).
+                -- The downside is that we are now always constructing a new LVal here, in
+                -- addition to the one constructed in the RT, and that we always have to join the
+                -- returned value label.
+                -- Note: Even though the result depends on the types of the parameters, it is sufficient to join their
+                -- value labels into the result's value label, due to the invariant tyLbl ⊑ valLbl.
+                Basics.Eq ->
+                    return
+                        ComplexRawComp
+                            { ccVal = RBin v1 v2 $ Bin op (UseNativeBinop False)
+                            , ccValLbl = \resValLbl -> Join PC (ValLbl v1) [ValLbl v2, resValLbl]
+                            , ccTyLbl = const PC -- The result type is always boolean
+                            }
+                Basics.Neq ->
+                    return
+                        ComplexRawComp
+                            { ccVal = RBin v1 v2 $ Bin op (UseNativeBinop False)
+                            , ccValLbl = \resValLbl -> Join PC (ValLbl v1) [ValLbl v2, resValLbl]
+                            , ccTyLbl = const PC -- The result type is always boolean
+                            }
+                -- Revision 2023-08: Introduced new instruction InvalidateSparseBit
+                -- (before this was called by a runtime raisedTo operation, which is now not necessary anymore).
+                -- Otherwise equivalent except for order of instructions.
+                Basics.RaisedTo -> do
+                    assertTypeAndRaise v2 RawLevel
+                    rRaiseTo <- getVal v2
+                    invalidateSparseBit
+                    return
+                        SimpleRawComp
+                            { cVal = RVar v1
+                            , cValLbl = Join PC (ValLbl v1) [ValLbl v2, Lbl rRaiseTo]
+                            , cTyLbl = Join PC (TyLbl v1) []
+                            }
+                Basics.HasField -> do
+                    assertTypeAndRaise v1 RawRecord
+                    assertTypeAndRaise v2 RawString
+                    basicBinOpComp
+
+                -- Bit operations
+                Basics.BinAnd -> numBinOpComp
+                Basics.BinOr -> numBinOpComp
+                Basics.BinXor -> numBinOpComp
+                Basics.BinShiftLeft -> numBinOpComp
+                Basics.BinShiftRight -> numBinOpComp
+                Basics.BinZeroShiftRight -> numBinOpComp
+                -- TODO Implement remaining operations
+                _ -> error $ "Binary operation not yet implemented: " ++ show op
+    IR.Un op v ->
+        -- Basic unary op computation, where the value label is that of the input and the type label is PC
+        -- (for operations where the result type is fixed).
+        let basicUnOpComp =
+                return
+                    SimpleRawComp
+                        { cVal = RUn v $ Un op
+                        , cValLbl = Join PC (ValLbl v) []
+                        , cTyLbl = PC
+                        }
+         in case op of
+                -- Revision 2023-08: Not raising block for IsTuple, IsList, IsRecord anymore, as they cannot fail. Otherwise equivalent.
+                Basics.IsTuple -> basicUnOpComp
+                Basics.IsList -> basicUnOpComp
+                Basics.IsRecord -> basicUnOpComp
+                -- Revision 2023-08: Separate operations for list and tuple length.
+                -- Now also asserting the type (before only block was raised).
+                Basics.ListLength -> do
+                    assertTypeAndRaise v RawList
+                    basicUnOpComp
+                Basics.TupleLength -> do
+                    assertTypeAndRaise v RawTuple
+                    basicUnOpComp
+                Basics.RecordSize -> do
+                    assertTypeAndRaise v RawRecord
+                    basicUnOpComp
+                -- Revision 2023-08: Equivalent.
+                Basics.Tail -> do
+                    assertTypeAndRaise v RawList
+                    basicUnOpComp
+                -- Revision 2023-08: Now also joining PC into value label (missed due to a typo in the previous version)
+                Basics.Head -> do
+                    assertTypeAndRaise v RawList
+                    return
+                        ComplexRawComp
+                            { ccVal = RUn v $ Un op
+                            , ccValLbl = \resValLbl -> Join PC (ValLbl v) [resValLbl]
+                            , ccTyLbl = \resTyLbl -> Join PC resTyLbl []
+                            }
+                -- Revision 2023-08: Now setting type label to PC instead of joining original type label (as the type is asserted).
+                Basics.UnMinus -> do
+                    assertTypeAndRaise v RawNumber
+                    basicUnOpComp
+
+                -- TODO Implement remaining operations
+                _ -> error $ "Unary operation not yet implemented: " ++ show op
 
 -- Revision 2023-08: Changed and moved handling of the complex operations Eq and Neq to expr2Raw.
+
 -- | Generate raw instructions for the given IR instruction.
 inst2raw :: IR.IRInst -> TM ()
 inst2raw = \case
-  -- Note: This is the only place where expressions occur in an IR program.
-  IR.Assign vn expr -> do
-    LVal{..} <- expr2raw expr
-    -- Joining PC to be safe, even though for now PC is always joined when computing the expression (and it will be optimized away).
-    rValLbl' <- compLabel $ Join PC (Lbl rValLbl) []
-    rTyLbl' <- compLabel $ Join PC (Lbl rTyLbl) []
-    constructLVal vn LVal{rValLbl = rValLbl', rTyLbl = rTyLbl', .. }
-
-  IR.MkFunClosures vs env -> do
-    -- The generation of closures and the related monitoring is first implemented in stack generation,
-    -- to be able to use cyclic pointers for constructing the environments.
-    tell [MkFunClosures vs env]
-
+    -- Note: This is the only place where expressions occur in an IR program.
+    IR.Assign vn expr -> do
+        LVal{..} <- expr2raw expr
+        -- Joining PC to be safe, even though for now PC is always joined when computing the expression (and it will be optimized away).
+        rValLbl' <- compLabel $ Join PC (Lbl rValLbl) []
+        rTyLbl' <- compLabel $ Join PC (Lbl rTyLbl) []
+        constructLVal vn LVal{rValLbl = rValLbl', rTyLbl = rTyLbl', ..}
+    IR.MkFunClosures vs env -> do
+        -- The generation of closures and the related monitoring is first implemented in stack generation,
+        -- to be able to use cyclic pointers for constructing the environments.
+        tell [MkFunClosures vs env]
 
 -- | Translate an IR terminator to a Raw terminator, generating instructions.
 tr2raw :: IR.IRTerminator -> TM RawTerminator
 tr2raw = \case
-  -- Revision 2023-08: Equivalent except for the additional redundant raise.
-  IR.TailCall v1 v2 -> do
-    raisePCAndBlock $ ValLbl v1
-    -- Note: The raise here is redundant because we have already raised by the value label above.
-    -- However, optimizations aware of the relation between type- and value label will remove it.
-    assertTypeAndRaise v1 RawFunction
-    setR0 =<< getLVal v2
-    TailCall <$> getVal v1 -- labels of v1 are dismissed at this point
-
-  -- Revision 2023-08: This generates now more instructions than before,
-  -- as we also construct LVals instead of just working on single RawVars,
-  -- but after optimization with RawOpt the result is the same.
-  IR.Ret v -> do
-    -- At this point, we taint value and type label of the to-be-returned value with PC,
-    -- as both value and type can depend on it. Note: when implementing more fine-grained type labels,
-    -- the type label should not always be tainted here.
-    setR0 =<< getLVal =<< pcTaint v
-    return Ret
-
-  IR.LibExport x ->
-    return $ LibExport x
-
-  -- Revision 2023-08: Equivalent except for the additional redundant raise.
-  IR.If v bb1 bb2 -> do
-    raisePCAndBlock $ ValLbl v
-    bb1' <- tree2raw bb1
-    bb2' <- tree2raw bb2
-    -- Note: The raise here is redundant because we have already raised by the value label above.
-    -- However, optimizations aware of the relation between type- and value label will remove it.
-    assertTypeAndRaise v RawBoolean
-    tell [ SetBranchFlag ]
-    r <- getVal v
-    return $ If r bb1' bb2'
-
-  -- Revision 2023-08: Equivalent, only way of modifying bb2 changed.
-  IR.Call v irBB1 irBB2 -> do
-    bb1 <- tree2raw irBB1
-    BB insts2 tr2 <- tree2raw irBB2
-    -- Prepend before insts2 instructions to store in variable v the result
-    -- of executing BB1 (expected in R0 after a RET which eventually ends execution of BB1).
-    (_, insts2') <- intercept $ do
-                      r0 <- getR0
-                      constructLVal v r0
-                      tell insts2 -- Note on performance: concatenating lists might be slow,
-                                  -- generally using Sequence (faster concatenation) for instructions
-                                  -- might improve performance
-    let bb2 = BB insts2' tr2
-    return $ Call bb1 bb2
-
-  -- Note: This is translated into branching and Error for throwing RT exception
-  -- Revision 2023-08: More fine-grained raising of blocking label, see below.
-  IR.AssertElseError v1 irBB verr pos -> do
-    -- Note: We are first raising the blocking label with the type label,
-    -- then assert the type and then raise with the value label.
-    -- Raising with the value label directly would be sufficient,
-    -- but with the two-step raising we obtain a more fine-grained
-    -- blocking label for the assertion. In case more is know about
-    -- value and type label, optimizations might eliminated the second raise.
-    assertTypeAndRaise v1 RawBoolean
-    raiseBlock $ ValLbl v1
-    bb <- tree2raw irBB
-    -- Generate the BB for the error case
-    (tr_err, insts_err) <- intercept $ tr2raw $ IR.Error verr pos
-    let bb_err = BB insts_err tr_err
-    r <- getVal v1
-    return $ If r bb bb_err
-
-  -- Revision 2023-08: Now asserting that verr is a string. Also raising both PC
-  -- and blocking label to the error message's value label (which will become
-  -- obsolete with an improvement moving the arguments of the Raw.Error
-  -- instruction to R0).
-  IR.Error verr pos -> do
-    -- Note: first raising block with type label and then with value label; see AssertElseError for explanation.
-    assertTypeAndRaise verr RawString
-    -- Note: There is no value label anymore at Raw level; instead join the label into PC (which e.g. determines whether are allowed to print the message)
-    raisePCAndBlock $ ValLbl verr
-    r <- getVal verr
-    return $ Error r pos
-
+    -- Revision 2023-08: Equivalent except for the additional redundant raise.
+    IR.TailCall v1 v2 -> do
+        raisePCAndBlock $ ValLbl v1
+        -- Note: The raise here is redundant because we have already raised by the value label above.
+        -- However, optimizations aware of the relation between type- and value label will remove it.
+        assertTypeAndRaise v1 RawFunction
+        setR0 =<< getLVal v2
+        TailCall <$> getVal v1 -- labels of v1 are dismissed at this point
+
+    -- Revision 2023-08: This generates now more instructions than before,
+    -- as we also construct LVals instead of just working on single RawVars,
+    -- but after optimization with RawOpt the result is the same.
+    IR.Ret v -> do
+        -- At this point, we taint value and type label of the to-be-returned value with PC,
+        -- as both value and type can depend on it. Note: when implementing more fine-grained type labels,
+        -- the type label should not always be tainted here.
+        setR0 =<< getLVal =<< pcTaint v
+        return Ret
+    IR.LibExport x ->
+        return $ LibExport x
+    -- Revision 2023-08: Equivalent except for the additional redundant raise.
+    IR.If v bb1 bb2 -> do
+        raisePCAndBlock $ ValLbl v
+        bb1' <- tree2raw bb1
+        bb2' <- tree2raw bb2
+        -- Note: The raise here is redundant because we have already raised by the value label above.
+        -- However, optimizations aware of the relation between type- and value label will remove it.
+        assertTypeAndRaise v RawBoolean
+        tell [SetBranchFlag]
+        r <- getVal v
+        return $ If r bb1' bb2'
+
+    -- Revision 2023-08: Equivalent, only way of modifying bb2 changed.
+    IR.Call v irBB1 irBB2 -> do
+        bb1 <- tree2raw irBB1
+        BB insts2 tr2 <- tree2raw irBB2
+        -- Prepend before insts2 instructions to store in variable v the result
+        -- of executing BB1 (expected in R0 after a RET which eventually ends execution of BB1).
+        (_, insts2') <- intercept $ do
+            r0 <- getR0
+            constructLVal v r0
+            tell insts2 -- Note on performance: concatenating lists might be slow,
+            -- generally using Sequence (faster concatenation) for instructions
+            -- might improve performance
+        let bb2 = BB insts2' tr2
+        return $ Call bb1 bb2
+
+    -- Note: This is translated into branching and Error for throwing RT exception
+    -- Revision 2023-08: More fine-grained raising of blocking label, see below.
+    IR.AssertElseError v1 irBB verr pos -> do
+        -- Note: We are first raising the blocking label with the type label,
+        -- then assert the type and then raise with the value label.
+        -- Raising with the value label directly would be sufficient,
+        -- but with the two-step raising we obtain a more fine-grained
+        -- blocking label for the assertion. In case more is know about
+        -- value and type label, optimizations might eliminated the second raise.
+        assertTypeAndRaise v1 RawBoolean
+        raiseBlock $ ValLbl v1
+        bb <- tree2raw irBB
+        -- Generate the BB for the error case
+        (tr_err, insts_err) <- intercept $ tr2raw $ IR.Error verr pos
+        let bb_err = BB insts_err tr_err
+        r <- getVal v1
+        return $ If r bb bb_err
+
+    -- Revision 2023-08: Now asserting that verr is a string. Also raising both PC
+    -- and blocking label to the error message's value label (which will become
+    -- obsolete with an improvement moving the arguments of the Raw.Error
+    -- instruction to R0).
+    IR.Error verr pos -> do
+        -- Note: first raising block with type label and then with value label; see AssertElseError for explanation.
+        assertTypeAndRaise verr RawString
+        -- Note: There is no value label anymore at Raw level; instead join the label into PC (which e.g. determines whether are allowed to print the message)
+        raisePCAndBlock $ ValLbl verr
+        r <- getVal verr
+        return $ Error r pos
 
 -- Revision 2023-08: unchanged
+
 -- | Translate an IR tree to a Raw tree (does not add any instructions to the monad).
 tree2raw :: IR.IRBBTree -> TM RawBBTree
 tree2raw (IR.BB irInsts irTr) = do
     -- Generate Raw instructions for the instructions of the block and the terminator.
-    (tr, insts) <- intercept
-            $ mapM_ inst2raw irInsts >> tr2raw irTr -- inst2raw only generates instructions without result value, tr2raw adds instructions and returns resulting RawTerminator
+    (tr, insts) <-
+        intercept $
+            mapM_ inst2raw irInsts >> tr2raw irTr -- inst2raw only generates instructions without result value, tr2raw adds instructions and returns resulting RawTerminator
     return $ BB insts tr
 
 -- Revision 2023-08: new code, but equivalent
 fun2raw :: IR.FunDef -> FunDef
 fun2raw irfdef@(IR.FunDef hfn vname consts (IR.BB irInsts irTr)) =
-   FunDef hfn rawConsts (BB insts tr) irfdef
-      where ((tr, rawConsts), insts) = evalRWS comp () 0
-            comp = do
-              -- Store the argument from R0 in the variable under which the argument is expected.
-              r0 <- getR0
-              constructLVal vname r0
-              -- Generate instructions creating LVals for the constants
-              pc <- getPC
-              rawConsts <- forM consts $ \(v@(VN vn), constVal) -> do
-                let r = RawVar $ vn ++ "$$$const"
-                constructLVal v LVal { rVal = r, rValLbl = pc, rTyLbl = pc }
-                return (r, constVal)
-              -- Generate the instructions for the BB
-              mapM_ inst2raw irInsts
-              -- Generate instructions for and translate the terminator
-              tr' <- tr2raw irTr
-              return (tr', rawConsts)
+    FunDef hfn rawConsts (BB insts tr) irfdef
+  where
+    ((tr, rawConsts), insts) = evalRWS comp () 0
+    comp = do
+        -- Store the argument from R0 in the variable under which the argument is expected.
+        r0 <- getR0
+        constructLVal vname r0
+        -- Generate instructions creating LVals for the constants
+        pc <- getPC
+        rawConsts <- forM consts $ \(v@(VN vn), constVal) -> do
+            let r = RawVar $ vn ++ "$$$const"
+            constructLVal v LVal{rVal = r, rValLbl = pc, rTyLbl = pc}
+            return (r, constVal)
+        -- Generate the instructions for the BB
+        mapM_ inst2raw irInsts
+        -- Generate instructions for and translate the terminator
+        tr' <- tr2raw irTr
+        return (tr', rawConsts)
 
 -- Revision 2023-08: unchanged
 ir2raw :: IR.SerializationUnit -> RawUnit
@@ -784,5 +820,3 @@ ir2raw (IR.ProgramSerialization prog) = ProgramRawUnit (prog2raw prog)
 prog2raw :: IR.IRProgram -> RawProgram
 prog2raw (IR.IRProgram atoms funs) =
     RawProgram atoms (map fun2raw funs)
-
-
diff --git a/compiler/src/IROpt.hs b/compiler/src/IROpt.hs
index 610c1f24..a0872a79 100644
--- a/compiler/src/IROpt.hs
+++ b/compiler/src/IROpt.hs
@@ -1,18 +1,18 @@
 {-# LANGUAGE FlexibleContexts #-}
 
-module IROpt(iropt) where
-import IR
+module IROpt (iropt) where
+
+import qualified Basics
 import Control.Monad.RWS.Lazy
+import qualified Core as C
 import Data.Map.Lazy (Map)
-import Data.Set(Set)
-import qualified Data.Set as Set 
-import qualified Basics
-import qualified Core                      as C
-import           TroupePositionInfo
-
-import qualified Data.Map.Lazy as Map 
-import           RetCPS                    (VarName (..))
+import Data.Set (Set)
+import qualified Data.Set as Set
+import IR
+import TroupePositionInfo
 
+import qualified Data.Map.Lazy as Map
+import RetCPS (VarName (..))
 
 --------------------------------------------------
 --  substitutions for IR
@@ -20,21 +20,20 @@ import           RetCPS                    (VarName (..))
 newtype Subst = Subst (Map VarName VarAccess)
 
 class Substitutable a where
-  apply :: Subst -> a -> a
+    apply :: Subst -> a -> a
 
 idSubst :: Subst
 idSubst = Subst (Map.empty)
 
-
-instance Substitutable VarAccess where 
-    apply _ x@(VarEnv _) = x 
-    apply _ x@(VarFunSelfRef) = x 
-    apply subst@(Subst varmap) (VarLocal x) = 
+instance Substitutable VarAccess where
+    apply _ x@(VarEnv _) = x
+    apply _ x@(VarFunSelfRef) = x
+    apply subst@(Subst varmap) (VarLocal x) =
         Map.findWithDefault (VarLocal x) x varmap
 
-instance Substitutable IRExpr where 
-    apply subst e = 
-        case e of 
+instance Substitutable IRExpr where
+    apply subst e =
+        case e of
             Bin op x y -> Bin op (apply subst x) (apply subst y)
             Un op x -> Un op (apply subst x)
             Tuple xs -> Tuple (map (apply subst) xs)
@@ -42,88 +41,84 @@ instance Substitutable IRExpr where
             WithRecord x fields -> WithRecord (apply subst x) (_ff fields)
             ProjField x f -> ProjField (apply subst x) f
             ProjIdx x idx -> ProjIdx (apply subst x) idx
-            List xs  -> List (map (apply subst) xs)
+            List xs -> List (map (apply subst) xs)
             ListCons x y -> ListCons (apply subst x) (apply subst y)
             Const x -> Const x
-            Base name -> Base name 
+            Base name -> Base name
             Lib name name' -> Lib name name'
-        where _ff fields = map (\(f,x) -> (f, apply subst x)) fields
+      where
+        _ff fields = map (\(f, x) -> (f, apply subst x)) fields
 
-instance Substitutable IRInst where 
-    apply subst i = 
-        case i of 
+instance Substitutable IRInst where
+    apply subst i =
+        case i of
             Assign x e -> Assign x (apply subst e)
-            MkFunClosures env funs -> 
-                let env' = map (\(decVar, y) -> (decVar, apply subst y)) env  -- obs: need only subst in y
-                in MkFunClosures env' funs 
+            MkFunClosures env funs ->
+                let env' = map (\(decVar, y) -> (decVar, apply subst y)) env -- obs: need only subst in y
+                 in MkFunClosures env' funs
 
-instance Substitutable IRTerminator where 
-    apply subst tr = 
-        case tr of 
+instance Substitutable IRTerminator where
+    apply subst tr =
+        case tr of
             TailCall x y -> TailCall (apply subst x) (apply subst y)
             Ret x -> Ret (apply subst x)
             If x bb1 bb2 -> If (apply subst x) (apply subst bb1) (apply subst bb2)
-            AssertElseError x bb y pos -> 
-                AssertElseError (apply subst x) (apply subst bb) (apply subst y) pos 
+            AssertElseError x bb y pos ->
+                AssertElseError (apply subst x) (apply subst bb) (apply subst y) pos
             LibExport x -> LibExport (apply subst x)
-            Error x pos -> Error (apply subst x) pos 
+            Error x pos -> Error (apply subst x) pos
             Call decVar bb1 bb2 -> Call decVar (apply subst bb1) (apply subst bb2)
 
-instance Substitutable IRBBTree where 
-    apply subst (BB insts tr) = 
+instance Substitutable IRBBTree where
+    apply subst (BB insts tr) =
         BB (map (apply subst) insts) (apply subst tr)
 
 --------------------------------------------------
--- end of substitutions for IR 
+-- end of substitutions for IR
 --------------------------------------------------
 
-
-
 -- | Partial value.
-data PValue = Unknown
-            | TupleVal [VarAccess]
-            | ListVal
-            | IntConst Integer
-            | BoolConst Bool
-            | StringConst String
-            | RecordVal Fields
-             
-             
-
+data PValue
+    = Unknown
+    | TupleVal [VarAccess]
+    | ListVal
+    | IntConst Integer
+    | BoolConst Bool
+    | StringConst String
+    | RecordVal Fields
 
 type Env = Map VarName PValue
-type ChangeFlag = Bool 
+type ChangeFlag = Bool
 type State = (Env, ChangeFlag)
-type Writer = Set VarName 
-type Opt = RWS () Writer State 
+type Writer = Set VarName
+type Opt = RWS () Writer State
 
-
-getEnv = do 
-    (e, _) <- get 
+getEnv = do
+    (e, _) <- get
     return e
 
 envInsert :: VarName -> PValue -> Opt ()
-envInsert x v = do 
-    (env, flag) <- get 
+envInsert x v = do
+    (env, flag) <- get
     let env' = Map.insert x v env
     put (env', flag)
 
-setChangeFlag :: Opt () 
-setChangeFlag = do 
-    (e, _) <- get 
+setChangeFlag :: Opt ()
+setChangeFlag = do
+    (e, _) <- get
     put (e, True)
 
 class PEval a where
-    peval :: a -> Opt a 
-
+    peval :: a -> Opt a
 
 markUsed x = tell $ Set.singleton x -- collect the use of the local
 markUsed' (VarEnv _) = return ()
 markUsed' (VarFunSelfRef) = return ()
 markUsed' (VarLocal x) = markUsed x
 
--- | Check if an expression can fail at runtime or has side effects
--- This is used to prevent unsound dead code elimination
+{- | Check if an expression can fail at runtime or has side effects
+This is used to prevent unsound dead code elimination
+-}
 canFailOrHasEffects :: IRExpr -> Bool
 canFailOrHasEffects expr = case expr of
     -- Binary operations that can fail due to type errors
@@ -132,7 +127,7 @@ canFailOrHasEffects expr = case expr of
         Basics.Plus -> True
         Basics.Minus -> True
         Basics.Mult -> True
-        Basics.Div -> True  -- Also division by zero
+        Basics.Div -> True -- Also division by zero
         Basics.IntDiv -> True
         Basics.Mod -> True
         -- Bitwise operations require numbers
@@ -160,7 +155,6 @@ canFailOrHasEffects expr = case expr of
         Basics.LatticeJoin -> True
         Basics.LatticeMeet -> True
         Basics.RaisedTo -> True
-    
     -- Unary operations
     Un op _ -> case op of
         -- List/tuple operations can fail
@@ -180,359 +174,329 @@ canFailOrHasEffects expr = case expr of
         Basics.IsRecord -> False
         -- Level operations
         Basics.LevelOf -> False
-    
     -- Field/index projections can fail
     ProjField _ _ -> True
     ProjIdx _ _ -> True
-    
     -- List operations
-    ListCons _ _ -> True  -- Second argument must be a list
-    
+    ListCons _ _ -> True -- Second argument must be a list
+
     -- Function calls can have side effects
     Base _ -> True
     Lib _ _ -> True
-    
     -- These are generally safe
     Tuple _ -> False
     Record _ -> False
-    WithRecord _ _ -> False  -- Assuming the base is a record
+    WithRecord _ _ -> False -- Assuming the base is a record
     List _ -> False
-    Const _ -> False 
+    Const _ -> False
 
 -- | Get evaluation of a variable.
-varPEval :: VarAccess -> Opt PValue 
+varPEval :: VarAccess -> Opt PValue
 varPEval (VarEnv _) = return Unknown
 varPEval (VarFunSelfRef) = return Unknown
-varPEval (VarLocal x) = do 
-    env <- getEnv 
+varPEval (VarLocal x) = do
+    env <- getEnv
     markUsed x
-    case Map.lookup x env of 
-        Just v -> return v 
+    case Map.lookup x env of
+        Just v -> return v
         Nothing -> return Unknown
 
-
-data IRExprRes 
+data IRExprRes
     = RExpr (PValue, IRExpr)
     | RMov VarAccess
 
-
-        
 irExprPeval :: IRExpr -> Opt IRExprRes -- (PValue, IRExpr)
-irExprPeval e = 
-    let r_ x = return (RExpr x) 
-        def_ = r_ (Unknown, e) in
-    case e of 
-        Un Basics.IsTuple x -> do 
-            v <- varPEval x 
-            case v of 
-                TupleVal _ -> do 
-                    setChangeFlag
-                    r_ (BoolConst True, Const (C.LBool True))
-                _ -> def_
-        Un Basics.IsRecord x -> do 
-            v <- varPEval x 
-            case v of 
-                RecordVal _ -> do 
-                    setChangeFlag 
-                    r_ (BoolConst True, Const (C.LBool True))
-                _ -> def_
-        
-
-        Bin Basics.Eq x y -> do 
-            v1 <- varPEval x 
-            v2 <- varPEval y 
-            case (v1, v2) of 
-                (IntConst a, IntConst b) | a == b -> do
-                    setChangeFlag
-                    r_ (BoolConst True, Const (C.LBool True))
-                (IntConst a, IntConst b) | a /= b -> do
-                    setChangeFlag
-                    r_ (BoolConst False, Const (C.LBool False))
-                _ -> r_ (Unknown, e)
-        
-
-        Bin Basics.HasField x y -> do 
-            v1 <- varPEval x 
-            v2 <- varPEval y 
-            case (v1, v2) of 
-                (RecordVal fs, StringConst s) -> 
-                    case lookup s fs of 
-                        Just _ -> do
-                            setChangeFlag
-                            r_ (BoolConst True, Const (C.LBool True))
-                        Nothing -> def_ 
-                _ -> def_ 
-        
-        
-        Bin op x y -> do 
-          u <- varPEval x 
-          v <- varPEval y
-          case (u, v) of 
-            (IntConst a, IntConst b) -> do
-                let ii f = let c = f a b in do
-                              setChangeFlag
-                              r_ (IntConst c, Const (C.LInt c NoPos))  
-                let bb f = let c = f a b in do
-                              setChangeFlag
-                              r_ (BoolConst c, Const (C.LBool c))
-                case op of 
-                            Basics.Plus ->  ii (+)
+irExprPeval e =
+    let r_ x = return (RExpr x)
+        def_ = r_ (Unknown, e)
+     in case e of
+            Un Basics.IsTuple x -> do
+                v <- varPEval x
+                case v of
+                    TupleVal _ -> do
+                        setChangeFlag
+                        r_ (BoolConst True, Const (C.LBool True))
+                    _ -> def_
+            Un Basics.IsRecord x -> do
+                v <- varPEval x
+                case v of
+                    RecordVal _ -> do
+                        setChangeFlag
+                        r_ (BoolConst True, Const (C.LBool True))
+                    _ -> def_
+            Bin Basics.Eq x y -> do
+                v1 <- varPEval x
+                v2 <- varPEval y
+                case (v1, v2) of
+                    (IntConst a, IntConst b) | a == b -> do
+                        setChangeFlag
+                        r_ (BoolConst True, Const (C.LBool True))
+                    (IntConst a, IntConst b) | a /= b -> do
+                        setChangeFlag
+                        r_ (BoolConst False, Const (C.LBool False))
+                    _ -> r_ (Unknown, e)
+            Bin Basics.HasField x y -> do
+                v1 <- varPEval x
+                v2 <- varPEval y
+                case (v1, v2) of
+                    (RecordVal fs, StringConst s) ->
+                        case lookup s fs of
+                            Just _ -> do
+                                setChangeFlag
+                                r_ (BoolConst True, Const (C.LBool True))
+                            Nothing -> def_
+                    _ -> def_
+            Bin op x y -> do
+                u <- varPEval x
+                v <- varPEval y
+                case (u, v) of
+                    (IntConst a, IntConst b) -> do
+                        let ii f =
+                                let c = f a b
+                                 in do
+                                        setChangeFlag
+                                        r_ (IntConst c, Const (C.LInt c NoPos))
+                        let bb f =
+                                let c = f a b
+                                 in do
+                                        setChangeFlag
+                                        r_ (BoolConst c, Const (C.LBool c))
+                        case op of
+                            Basics.Plus -> ii (+)
                             Basics.Minus -> ii (-)
-                            Basics.Mult ->  ii (*)
-                            Basics.Div ->   def_ -- do not mess with divisions -- ii div
-                            Basics.IntDiv-> def_
-                            Basics.Mod ->   def_ -- ii mod 
+                            Basics.Mult -> ii (*)
+                            Basics.Div -> def_ -- do not mess with divisions -- ii div
+                            Basics.IntDiv -> def_
+                            Basics.Mod -> def_ -- ii mod
                             -- Basics.Eq ->    bb (==)
-                            Basics.Neq ->   bb(/=)
-                            Basics.Le ->    bb (<=)
-                            Basics.Lt ->    bb (<)
-                            Basics.Ge ->    bb ( >= )
-                            Basics.Gt ->    bb ( > )
+                            Basics.Neq -> bb (/=)
+                            Basics.Le -> bb (<=)
+                            Basics.Lt -> bb (<)
+                            Basics.Ge -> bb (>=)
+                            Basics.Gt -> bb (>)
                             _ -> def_
-                            -- _  -> fail "Type error discovered at compliation time"
-                            
-            _ -> do
-              markUsed' x 
-              markUsed' y
-              def_
-        Record fields -> do mapM pevalField fields 
-                            r_ (RecordVal fields, e)
-                            -- def_
-            where pevalField (_, x) = markUsed' x
-        WithRecord r fields -> do   
-                    markUsed' r
-                    mapM (\(_,x) -> markUsed' x) fields
-                    z <- varPEval r 
-                    let fields' = fields ++ ( case z of 
-                                               RecordVal f0 -> f0
-                                               _ -> [] )
-                    r_ (RecordVal fields', e)
-        ProjField x s -> do 
-            v <- varPEval x 
-            case v of 
-                RecordVal fs -> 
-                    case lookup s fs of 
-                        Just y -> do
-                            setChangeFlag
-                            return $ RMov y 
+                    -- _  -> fail "Type error discovered at compliation time"
+
+                    _ -> do
+                        markUsed' x
+                        markUsed' y
+                        def_
+            Record fields -> do
+                mapM pevalField fields
+                r_ (RecordVal fields, e)
+              where
+                -- def_
+                pevalField (_, x) = markUsed' x
+            WithRecord r fields -> do
+                markUsed' r
+                mapM (\(_, x) -> markUsed' x) fields
+                z <- varPEval r
+                let fields' =
+                        fields
+                            ++ ( case z of
+                                    RecordVal f0 -> f0
+                                    _ -> []
+                               )
+                r_ (RecordVal fields', e)
+            ProjField x s -> do
+                v <- varPEval x
+                case v of
+                    RecordVal fs ->
+                        case lookup s fs of
+                            Just y -> do
+                                setChangeFlag
+                                return $ RMov y
                             -- r_ (BoolConst True, Const (C.LBool True))
-                        Nothing -> def_ 
-                _ -> def_ 
-        -- TODO Implement optimization for ProjIdx
-        ProjIdx x idx -> do
-            markUsed' x  -- Mark the tuple variable as used
-            def_
-        -- ProjIdx x idx -> do 
-        --     v <- varPEval x 
-        --     case v of 
-        --         TupleVal vs -> 
-        --         _ -> def_ 
-
-        -- Previous Index:
-        -- Bin Basics.Index x y -> do 
-        --     v1 <- varPEval x 
-        --     v2 <- varPEval y 
-        --     case (v1, v2) of 
-        --         (TupleVal xs, IntConst i) -> do
-        --             setChangeFlag
-        --             return $ RMov (xs !! (fromIntegral  i))
-        --         _ -> def_
-
-        
-
--- irExprPeval e@(Bin Basics.Index x y) = do 
---     v1 <- varPEval x 
---     v2 <- varPEval y 
---     case (v1, v2) of 
---         (TupleVal xs, IntConst i) -> 
- 
- 
-
-
-        (List xs) -> do 
-            mapM_ markUsed' xs
-            r_ (Unknown, e)
-
-        (ListCons x y) -> do 
-            markUsed' x 
-            markUsed' y 
-            r_ (Unknown, e)    
-
-        (Const x) -> do 
-            case x of 
-                C.LInt n pos -> 
-                    r_ (IntConst n, e)
-                C.LBool b -> 
-                    r_ (BoolConst b, e)
-                C.LString s -> 
-                    r_ (StringConst s, e)
-                _ -> 
-                    r_ (Unknown, e) 
-
-        (Base _) -> do 
-            r_ (Unknown, e)
-
-        (Lib _ _) -> do 
-            r_ (Unknown, e)
-
-        (Un Basics.TupleLength x) -> do 
-            v <- varPEval x 
-            case v of 
-                TupleVal vars -> do  
-                    setChangeFlag
-                    let n = fromIntegral $ length vars
-                    r_ (IntConst n, Const (C.LInt n NoPos))    
-                _ -> r_ (Unknown, e)    
-        -- Not possible as not tracking list content:
-        -- (Un Basics.ListLength x) -> do 
-        --     v <- varPEval x 
-        --     case v of 
-        --         ListVal -> do  
-
-        (Un _ x) -> do 
-            markUsed' x 
-            r_ (Unknown, e)
-
-
-        (Tuple xs) -> do
-            mapM_ markUsed' xs 
-            r_ (TupleVal xs, e)
-
-
-data IRInstRes 
-    = RIns IRInst 
-    | RSubst Subst 
-
-insPeval :: IRInst -> Opt IRInstRes 
-insPeval i = 
-    case i of 
-        Assign x e -> do 
-            exprRes <- irExprPeval e 
-            case exprRes of 
+                            Nothing -> def_
+                    _ -> def_
+            -- TODO Implement optimization for ProjIdx
+            ProjIdx x idx -> do
+                markUsed' x -- Mark the tuple variable as used
+                def_
+            -- ProjIdx x idx -> do
+            --     v <- varPEval x
+            --     case v of
+            --         TupleVal vs ->
+            --         _ -> def_
+
+            -- Previous Index:
+            -- Bin Basics.Index x y -> do
+            --     v1 <- varPEval x
+            --     v2 <- varPEval y
+            --     case (v1, v2) of
+            --         (TupleVal xs, IntConst i) -> do
+            --             setChangeFlag
+            --             return $ RMov (xs !! (fromIntegral  i))
+            --         _ -> def_
+
+            -- irExprPeval e@(Bin Basics.Index x y) = do
+            --     v1 <- varPEval x
+            --     v2 <- varPEval y
+            --     case (v1, v2) of
+            --         (TupleVal xs, IntConst i) ->
+
+            (List xs) -> do
+                mapM_ markUsed' xs
+                r_ (Unknown, e)
+            (ListCons x y) -> do
+                markUsed' x
+                markUsed' y
+                r_ (Unknown, e)
+            (Const x) -> do
+                case x of
+                    C.LInt n pos ->
+                        r_ (IntConst n, e)
+                    C.LBool b ->
+                        r_ (BoolConst b, e)
+                    C.LString s ->
+                        r_ (StringConst s, e)
+                    _ ->
+                        r_ (Unknown, e)
+            (Base _) -> do
+                r_ (Unknown, e)
+            (Lib _ _) -> do
+                r_ (Unknown, e)
+            (Un Basics.TupleLength x) -> do
+                v <- varPEval x
+                case v of
+                    TupleVal vars -> do
+                        setChangeFlag
+                        let n = fromIntegral $ length vars
+                        r_ (IntConst n, Const (C.LInt n NoPos))
+                    _ -> r_ (Unknown, e)
+            -- Not possible as not tracking list content:
+            -- (Un Basics.ListLength x) -> do
+            --     v <- varPEval x
+            --     case v of
+            --         ListVal -> do
+
+            (Un _ x) -> do
+                markUsed' x
+                r_ (Unknown, e)
+            (Tuple xs) -> do
+                mapM_ markUsed' xs
+                r_ (TupleVal xs, e)
+
+data IRInstRes
+    = RIns IRInst
+    | RSubst Subst
+
+insPeval :: IRInst -> Opt IRInstRes
+insPeval i =
+    case i of
+        Assign x e -> do
+            exprRes <- irExprPeval e
+            case exprRes of
                 RExpr (v', e') -> do
-                    envInsert x v' 
+                    envInsert x v'
                     return $ RIns (Assign x e')
                 RMov y ->
                     return $ RSubst $ Subst (Map.singleton x y)
-        (MkFunClosures envs hfns) -> do 
-            mapM (\(_, x) -> markUsed' x) envs 
+        (MkFunClosures envs hfns) -> do
+            mapM (\(_, x) -> markUsed' x) envs
             return $ RIns i
 
-
 {--
-instance PEval IRInst where 
-    peval (Assign x e) = do 
-        RExpr (v', e') <- irExprPeval e 
-        envInsert x v' 
-        return (Assign x e')        
-
-    peval i@(MkFunClosures envs hfns) = do 
-        mapM (\(_, x) -> markUsed' x) envs 
+instance PEval IRInst where
+    peval (Assign x e) = do
+        RExpr (v', e') <- irExprPeval e
+        envInsert x v'
+        return (Assign x e')
+
+    peval i@(MkFunClosures envs hfns) = do
+        mapM (\(_, x) -> markUsed' x) envs
         return i
 --}
 
 trPeval :: IRTerminator -> Opt IRBBTree
+trPeval (If x bb1 bb2) = do
+    v <- varPEval x
+    let _doThen = do
+            setChangeFlag
+            peval bb1
 
-trPeval (If x bb1 bb2) = do 
-        v <- varPEval x 
-        let _doThen = do setChangeFlag   
-                         peval bb1 
-        
-        let _doElse = do setChangeFlag
-                         peval bb2  
-        case v of 
-            BoolConst True -> _doThen
-            BoolConst False -> _doElse
-            IntConst x | x /= 0 -> _doThen 
-            IntConst 0 -> _doElse
-                                  
-            _ -> do bb1' <- peval bb1 
-                    bb2' <- peval bb2 
-                    return $ BB [] (If x bb1' bb2')
-
-
-trPeval (AssertElseError x bb y_err pos) = do 
-    v <- varPEval x 
+    let _doElse = do
+            setChangeFlag
+            peval bb2
+    case v of
+        BoolConst True -> _doThen
+        BoolConst False -> _doElse
+        IntConst x | x /= 0 -> _doThen
+        IntConst 0 -> _doElse
+        _ -> do
+            bb1' <- peval bb1
+            bb2' <- peval bb2
+            return $ BB [] (If x bb1' bb2')
+trPeval (AssertElseError x bb y_err pos) = do
+    v <- varPEval x
     markUsed' y_err
-    case v of 
-        BoolConst True -> do 
+    case v of
+        BoolConst True -> do
             setChangeFlag
-            peval bb 
-        _ -> do bb' <- peval bb 
-                return $ BB [] (AssertElseError x bb' y_err pos)     
-
-
-trPeval (Call x bb1 bb2) = do 
-    bb1' <- peval bb1 
+            peval bb
+        _ -> do
+            bb' <- peval bb
+            return $ BB [] (AssertElseError x bb' y_err pos)
+trPeval (Call x bb1 bb2) = do
+    bb1' <- peval bb1
     bb2' <- peval bb2
 
-    case bb1' of 
-        BB insts1 (Ret rv1) -> do 
+    case bb1' of
+        BB insts1 (Ret rv1) -> do
             let subst = Subst (Map.singleton x rv1)
-            let (BB insts2 tr2) = apply subst bb2' 
-            setChangeFlag           
+            let (BB insts2 tr2) = apply subst bb2'
+            setChangeFlag
             return $ BB (insts1 ++ insts2) tr2
-        _ -> 
+        _ ->
             return $ BB [] (Call x bb1' bb2')
-
-trPeval tr@(Ret x) = do 
-    markUsed' x 
-    return $ BB [] tr 
-
-trPeval tr@(LibExport x) = do 
-    markUsed' x 
-    return $ BB [] tr 
-
-trPeval tr@(Error x _) = do 
-    markUsed' x 
-    return $ BB [] tr 
-
-trPeval tr@(TailCall x y)  = do 
-    markUsed' x 
-    markUsed' y 
+trPeval tr@(Ret x) = do
+    markUsed' x
+    return $ BB [] tr
+trPeval tr@(LibExport x) = do
+    markUsed' x
+    return $ BB [] tr
+trPeval tr@(Error x _) = do
+    markUsed' x
+    return $ BB [] tr
+trPeval tr@(TailCall x y) = do
+    markUsed' x
+    markUsed' y
     return $ BB [] tr
 
-
-bbPeval (BB insts tr) = do 
-    case insts of 
-        [] -> trPeval tr 
-        (i:insts) -> do 
-            insRes <- insPeval i 
-            case insRes of 
+bbPeval (BB insts tr) = do
+    case insts of
+        [] -> trPeval tr
+        (i : insts) -> do
+            insRes <- insPeval i
+            case insRes of
                 RIns i' -> do
                     BB insts'' tr'' <- bbPeval (BB insts tr)
-                    return $ BB (i':insts'') tr''
-                RSubst subst -> do 
+                    return $ BB (i' : insts'') tr''
+                RSubst subst -> do
                     bb_ <- bbPeval (BB insts tr)
                     setChangeFlag
                     return (apply subst bb_)
-                    
-
 
-instance PEval IRBBTree where    
-    peval bb@(BB insts tr) = do 
-        
+instance PEval IRBBTree where
+    peval bb@(BB insts tr) = do
         (BB insts_ tr_, used) <- listen $ bbPeval bb
 
-        let isNotDeadAssign (Assign x e) = 
+        let isNotDeadAssign (Assign x e) =
                 Set.member x used || canFailOrHasEffects e
-            isNotDeadAssign _   = True
+            isNotDeadAssign _ = True
 
             instsFiltered = filter isNotDeadAssign insts_
-        return $ BB instsFiltered tr_ 
-
-
+        return $ BB instsFiltered tr_
 
 funopt :: FunDef -> FunDef
-funopt (FunDef hfn argname consts bb) = 
+funopt (FunDef hfn argname consts bb) =
     let initEnv = (Map.singleton argname Unknown, False)
         (bb', (_, hasChanges), _) = runRWS (peval bb) () initEnv
 
         new = FunDef hfn argname consts bb'
-    in if (bb /= bb')  then funopt new 
-                       else new 
-
-
+     in if (bb /= bb')
+            then funopt new
+            else new
 
-iropt::IRProgram -> IRProgram
+iropt :: IRProgram -> IRProgram
 iropt (IRProgram atoms fdefs) = IRProgram atoms (map funopt fdefs)
diff --git a/compiler/src/ProcessImports.hs b/compiler/src/ProcessImports.hs
index eb579f23..8463b044 100644
--- a/compiler/src/ProcessImports.hs
+++ b/compiler/src/ProcessImports.hs
@@ -1,49 +1,45 @@
 module ProcessImports (processImports) where
+
 import Basics
+import Data.String.Utils
 import Direct
 import System.Environment
 import System.Exit
-import Data.String.Utils 
-
-defaultLibFolder="/lib/out/" 
-defaultBin="/bin/troupec"
-
-getRelativeHome :: IO String 
-getRelativeHome = do 
-   progPath <- getExecutablePath
-   if endswith defaultBin progPath
-   then do 
-       let home = take ( length progPath - length defaultBin) progPath 
-       return home
-   else do
-       die "Cannot determine Troupe home folder. Consider setting up the TROUPE environment variable" 
-
-getTroupeHome :: IO String 
-getTroupeHome = do 
-  maybeVar <- lookupEnv "TROUPE" 
-  case maybeVar of 
-      Nothing -> getRelativeHome 
-      Just troupeEnv  -> return troupeEnv 
-      
 
+defaultLibFolder = "/lib/out/"
+defaultBin = "/bin/troupec"
+
+getRelativeHome :: IO String
+getRelativeHome = do
+    progPath <- getExecutablePath
+    if endswith defaultBin progPath
+        then do
+            let home = take (length progPath - length defaultBin) progPath
+            return home
+        else do
+            die "Cannot determine Troupe home folder. Consider setting up the TROUPE environment variable"
+
+getTroupeHome :: IO String
+getTroupeHome = do
+    maybeVar <- lookupEnv "TROUPE"
+    case maybeVar of
+        Nothing -> getRelativeHome
+        Just troupeEnv -> return troupeEnv
 
 processImport (LibName lib, _) = do
-  troupeEnv <- getTroupeHome
-  let fname = troupeEnv ++ defaultLibFolder ++ lib ++ ".exports" 
-  input <- readFile fname
-  return ( LibName lib, Just (lines input))
-
+    troupeEnv <- getTroupeHome
+    let fname = troupeEnv ++ defaultLibFolder ++ lib ++ ".exports"
+    input <- readFile fname
+    return (LibName lib, Just (lines input))
 
 processImports' :: Imports -> IO Imports
-processImports' (Imports imports)=
-  Imports <$> mapM processImport imports
-
+processImports' (Imports imports) =
+    Imports <$> mapM processImport imports
 
 processImports :: Prog -> IO Prog
 processImports (Prog imports atoms term) = do
-  imports' <- processImports' imports
-  return $ Prog imports' atoms term
-
+    imports' <- processImports' imports
+    return $ Prog imports' atoms term
 
 -- TODO: 2018-07-02: AA: proper error handling in case we have errors
 -- loading information from the lib files
diff --git a/compiler/src/Raw.hs b/compiler/src/Raw.hs
index a9a17046..83ad71d9 100644
--- a/compiler/src/Raw.hs
+++ b/compiler/src/Raw.hs
@@ -1,375 +1,387 @@
 {-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
-module Raw where 
+module Raw where
 
 import qualified Basics
-import           RetCPS (VarName (..))
-import           IR ( Identifier(..)
-                    , VarAccess(..), HFN (..), Fields (..), Ident
-                    , ppId,ppFunCall,ppArgs
-                    )
+import IR (
+    Fields (..),
+    HFN (..),
+    Ident,
+    Identifier (..),
+    VarAccess (..),
+    ppArgs,
+    ppFunCall,
+    ppId,
+ )
 import qualified IR (FunDef (..))
+import RetCPS (VarName (..))
 
-
-import qualified Core                      as C
-import           Core (ppLit)
-import qualified RetCPS                    as CPS
+import Core (ppLit)
+import qualified Core as C
 import Data.Map.Lazy (Map, (!))
-import qualified Data.Map.Lazy as Map 
-
-
-import           Control.Monad.Except
-import           Control.Monad.Reader
-import           Control.Monad.RWS
-import           Control.Monad.State
-import           Control.Monad.Writer
-import           Data.List
-import qualified Data.ByteString           as BS
-
-import           CompileMode
-import           Text.PrettyPrint.HughesPJ (hsep, nest, text, vcat, ($$), (<+>))
+import qualified Data.Map.Lazy as Map
+import qualified RetCPS as CPS
+
+import Control.Monad.Except
+import Control.Monad.RWS
+import Control.Monad.Reader
+import Control.Monad.State
+import Control.Monad.Writer
+import qualified Data.ByteString as BS
+import Data.List
+
+import CompileMode
+import Text.PrettyPrint.HughesPJ (hsep, nest, text, vcat, ($$), (<+>))
 import qualified Text.PrettyPrint.HughesPJ as PP
-import           TroupePositionInfo
-
+import TroupePositionInfo
 
 -- | Variable names used for plain (unlabelled) values.
-newtype RawVar = RawVar Ident deriving (Eq, Show, Ord)
-instance Identifier RawVar where ppId (RawVar x) = text x
+newtype RawVar = RawVar Ident deriving (Eq, Ord, Show)
 
+instance Identifier RawVar where ppId (RawVar x) = text x
 
-type ConstMap = Map RawVar C.Lit 
+type ConstMap = Map RawVar C.Lit
 
-instance Identifier Assignable where 
-  ppId (AssignableRaw x) = ppId x 
-  ppId (AssignableLVal x) = ppId x 
-  ppId (Env) = text "$env"
+instance Identifier Assignable where
+    ppId (AssignableRaw x) = ppId x
+    ppId (AssignableLVal x) = ppId x
+    ppId (Env) = text "$env"
 
 data LValField = FieldValue | FieldValLev | FieldTypLev deriving (Eq, Ord)
-instance Show LValField where 
+instance Show LValField where
     show FieldValue = "val"
     show FieldValLev = "lev"
     show FieldTypLev = "tlev"
 
 data MonComponent = MonPC | MonBlock | R0_Val | R0_Lev | R0_TLev
-     deriving (Eq, Show, Ord)
-instance Identifier MonComponent where 
-  ppId MonPC = text "<pc>"
-  ppId MonBlock = text "<block>"
-  ppId R0_Val = text "<r0_val>"
-  ppId R0_Lev = text "<r0_lev>"
-  ppId R0_TLev = text "<r0_tlev>"
-
-
+    deriving (Eq, Ord, Show)
+instance Identifier MonComponent where
+    ppId MonPC = text "<pc>"
+    ppId MonBlock = text "<block>"
+    ppId R0_Val = text "<r0_val>"
+    ppId R0_Lev = text "<r0_lev>"
+    ppId R0_TLev = text "<r0_tlev>"
 
 data RawType
-  = RawNumber| RawUnit | RawBoolean | RawString | RawFunction
-  | RawLocalObj| RawHandler| RawList | RawTuple| RawRecord
-  | RawDCLabel
-  | RawNode| RawProcessId| RawCapability| RawLevel
-  | RawAuthority | RawTopAuthority| RawEnv
+    = RawNumber
+    | RawUnit
+    | RawBoolean
+    | RawString
+    | RawFunction
+    | RawLocalObj
+    | RawHandler
+    | RawList
+    | RawTuple
+    | RawRecord
+    | RawDCLabel
+    | RawNode
+    | RawProcessId
+    | RawCapability
+    | RawLevel
+    | RawAuthority
+    | RawTopAuthority
+    | RawEnv
     deriving (Eq, Show)
 
-
 -- | A runtime assertion stopping the current thread if the condition is not satisfied.
 data RTAssertion
-  = AssertType RawVar RawType
-  -- | Assert that the types of the given 'RawVar's are equal and (if provided) included in the given list of types. 
-  -- (Probably better design: possibly empty list of types (where empty means any types allowed))
-  -- | AssertEqTypes (Maybe (List2OrMore RawType)) RawVar RawVar
-  | AssertTypesBothStringsOrBothNumbers RawVar RawVar
-  | AssertTupleLengthGreaterThan RawVar Word
-  | AssertRecordHasField RawVar Basics.FieldName
-  | AssertNotZero RawVar
-   deriving (Eq, Show)
+    = AssertType RawVar RawType
+    | {- | Assert that the types of the given 'RawVar's are equal and (if provided) included in the given list of types.
+      (Probably better design: possibly empty list of types (where empty means any types allowed))
+      | AssertEqTypes (Maybe (List2OrMore RawType)) RawVar RawVar
+      -}
+      AssertTypesBothStringsOrBothNumbers RawVar RawVar
+    | AssertTupleLengthGreaterThan RawVar Word
+    | AssertRecordHasField RawVar Basics.FieldName
+    | AssertNotZero RawVar
+    deriving (Eq, Show)
 
 -- data List2OrMore a = List2OrMore a a [a] deriving (Eq, Show)
 
--- | Note about categorization of Raw expressions: There are two main types of expressions:
--- those computing a single raw value, and those computing a labelled value (see the return type
--- of the corresponding runtime operation). Operations also differ in whether they take simple or
--- labelled values as parameters.
--- We could categorize RawExpr into different datatypes, but that would also mean to
--- split up Basics.UnaryOp and Basics.BinOp, and the overall benefit is unclear. They still
--- have to be treated separately in IR2Raw, which works on the structure provided by IR, and
--- it is there where instructions to handle the result are generated (AssignRaw and AssignLVal).
--- What would be possible is to introduce a pre-processing which translates IR expressions into
--- categorized expressions, which could then slightly simplify handling at IR2Raw.
+{- | Note about categorization of Raw expressions: There are two main types of expressions:
+those computing a single raw value, and those computing a labelled value (see the return type
+of the corresponding runtime operation). Operations also differ in whether they take simple or
+labelled values as parameters.
+We could categorize RawExpr into different datatypes, but that would also mean to
+split up Basics.UnaryOp and Basics.BinOp, and the overall benefit is unclear. They still
+have to be treated separately in IR2Raw, which works on the structure provided by IR, and
+it is there where instructions to handle the result are generated (AssignRaw and AssignLVal).
+What would be possible is to introduce a pre-processing which translates IR expressions into
+categorized expressions, which could then slightly simplify handling at IR2Raw.
+-}
 data RawExpr
-  = Bin Basics.BinOp UseNativeBinop RawVar RawVar
-  | Un Basics.UnaryOp RawVar
-  | ProjectLVal VarAccess LValField
-  | ProjectState MonComponent
-  | Tuple [VarAccess]
-  | Record Fields
-  | WithRecord RawVar Fields 
-  | ProjField RawVar Basics.FieldName
-  | ProjIdx RawVar Word
-  | List [VarAccess]
-  -- | Cons operation with the new head (labelled value) and the list (simple value).
-  | ListCons VarAccess RawVar
-  | Const C.Lit
-  -- | Reference to a definition in a library
-  | Lib Basics.LibName Basics.VarName
-  | Base Basics.VarName
-  -- | Make a labelled value out of the given 'RawVar's (value, value label, type label).
-  | ConstructLVal RawVar RawVar RawVar
-  deriving (Eq, Show)
-
--- | For equality and inequality, we generally defer to the runtime. However 
--- when we know that the operation involves simple types we can generate 
--- faster code, avoiding calling the runtime functions
--- 
+    = Bin Basics.BinOp UseNativeBinop RawVar RawVar
+    | Un Basics.UnaryOp RawVar
+    | ProjectLVal VarAccess LValField
+    | ProjectState MonComponent
+    | Tuple [VarAccess]
+    | Record Fields
+    | WithRecord RawVar Fields
+    | ProjField RawVar Basics.FieldName
+    | ProjIdx RawVar Word
+    | List [VarAccess]
+    | -- | Cons operation with the new head (labelled value) and the list (simple value).
+      ListCons VarAccess RawVar
+    | Const C.Lit
+    | -- | Reference to a definition in a library
+      Lib Basics.LibName Basics.VarName
+    | Base Basics.VarName
+    | -- | Make a labelled value out of the given 'RawVar's (value, value label, type label).
+      ConstructLVal RawVar RawVar RawVar
+    deriving (Eq, Show)
+
+{- | For equality and inequality, we generally defer to the runtime. However
+when we know that the operation involves simple types we can generate
+faster code, avoiding calling the runtime functions
+-}
 newtype UseNativeBinop = UseNativeBinop Bool
-  deriving (Eq, Show)
+    deriving (Eq, Show)
 
 data RawInst
-  -- | Assign the result of the given simple expression (an unlabelled value) to the given raw variable.
-  -- There is no type-level distinction of 'RawExpr' which produce a labelled value and those producing
-  -- an unlabelled value, because this is more convenient for how these are generated in IR2Raw.
-  = AssignRaw RawVar RawExpr
-  -- | Assign the result of the given complex expression (a labelled value) to a variable with the given name.
-  | AssignLVal VarName RawExpr
-  -- | Set a monitor component. Provided variable must contain a label (this is not checked).
-  | SetState MonComponent RawVar
-  -- | Indicates that the current block invoked a branch instruction.
-  -- Is inserted before an "if".
-  -- See stack/execution model.
-  | SetBranchFlag
-  -- | The sparse bit is tracking whether data in the current closure is bounded by PC.
-  -- If this condition is invalidated by introducing new labels (like with the raisedTo instruction),
-  -- this instruction must be added to ensure that the required join operations happen.
-  | InvalidateSparseBit
-  | MkFunClosures [(VarName, VarAccess)] [(VarName, HFN)]
-  | RTAssertion RTAssertion
-   deriving (Eq, Show)
+    = {- | Assign the result of the given simple expression (an unlabelled value) to the given raw variable.
+      There is no type-level distinction of 'RawExpr' which produce a labelled value and those producing
+      an unlabelled value, because this is more convenient for how these are generated in IR2Raw.
+      -}
+      AssignRaw RawVar RawExpr
+    | -- | Assign the result of the given complex expression (a labelled value) to a variable with the given name.
+      AssignLVal VarName RawExpr
+    | -- | Set a monitor component. Provided variable must contain a label (this is not checked).
+      SetState MonComponent RawVar
+    | {- | Indicates that the current block invoked a branch instruction.
+      Is inserted before an "if".
+      See stack/execution model.
+      -}
+      SetBranchFlag
+    | {- | The sparse bit is tracking whether data in the current closure is bounded by PC.
+      If this condition is invalidated by introducing new labels (like with the raisedTo instruction),
+      this instruction must be added to ensure that the required join operations happen.
+      -}
+      InvalidateSparseBit
+    | MkFunClosures [(VarName, VarAccess)] [(VarName, HFN)]
+    | RTAssertion RTAssertion
+    deriving (Eq, Show)
 
 -- | A block of instructions followed by a terminator, which can contain further 'RawBBTree's.
 data RawBBTree = BB [RawInst] RawTerminator deriving (Eq, Show)
 
 data RawTerminator
-  = TailCall RawVar
-  | Ret
-  | If RawVar RawBBTree RawBBTree
-  | LibExport VarAccess
-  | Error RawVar PosInf
-  -- | Execute the first BB and then execute the second BB where
-  -- PC is reset to the level before entering the first BB.
-  | Call RawBBTree RawBBTree
-  deriving (Eq, Show)
-
-
--- TODO: 2025-09-19; AA -- this is a bit too hacky 
-                        -- we should not be referencing runtime functions 
-                        -- by concatenating their names 
-ppRTAssertionCode f a = f (text $ "rt.rawAssert" ++ rtFun) args
-  where (rtFun, args) = case a of
-          AssertType x t -> (case t of
-            RawNumber -> "IsNumber"
-            RawBoolean -> "IsBoolean"
-            RawString -> "IsString"
-            RawFunction -> "IsFunction"
-            RawList -> "IsList"
-            RawTuple -> "IsTuple"
-            RawRecord -> "IsRecord"
-            RawLevel -> "IsLevel"
-            _ -> error $ "type assertion not implemented for " ++ show t
-            , [ppId x])
-          AssertTypesBothStringsOrBothNumbers x y -> ("PairsAreStringsOrNumbers", [ppId x, ppId y])
-          AssertTupleLengthGreaterThan x n -> ("TupleLengthGreaterThan", [ppId x, text (show n)])
-          AssertRecordHasField x f -> ("RecordHasField", [ppId x, PP.doubleQuotes $ text f])
-          AssertNotZero x -> ("NotZero", [ppId x])
-
+    = TailCall RawVar
+    | Ret
+    | If RawVar RawBBTree RawBBTree
+    | LibExport VarAccess
+    | Error RawVar PosInf
+    | {- | Execute the first BB and then execute the second BB where
+      PC is reset to the level before entering the first BB.
+      -}
+      Call RawBBTree RawBBTree
+    deriving (Eq, Show)
 
+-- TODO: 2025-09-19; AA -- this is a bit too hacky
+-- we should not be referencing runtime functions
+-- by concatenating their names
+ppRTAssertionCode f a = f (text $ "rt.rawAssert" ++ rtFun) args
+  where
+    (rtFun, args) = case a of
+        AssertType x t ->
+            ( case t of
+                RawNumber -> "IsNumber"
+                RawBoolean -> "IsBoolean"
+                RawString -> "IsString"
+                RawFunction -> "IsFunction"
+                RawList -> "IsList"
+                RawTuple -> "IsTuple"
+                RawRecord -> "IsRecord"
+                RawLevel -> "IsLevel"
+                _ -> error $ "type assertion not implemented for " ++ show t
+            , [ppId x]
+            )
+        AssertTypesBothStringsOrBothNumbers x y -> ("PairsAreStringsOrNumbers", [ppId x, ppId y])
+        AssertTupleLengthGreaterThan x n -> ("TupleLengthGreaterThan", [ppId x, text (show n)])
+        AssertRecordHasField x f -> ("RecordHasField", [ppId x, PP.doubleQuotes $ text f])
+        AssertNotZero x -> ("NotZero", [ppId x])
 
 ppRTAssertion :: RTAssertion -> PP.Doc
 ppRTAssertion = ppRTAssertionCode ppFunCall
 
-type Consts = [(RawVar, C.Lit )]
+type Consts = [(RawVar, C.Lit)]
 
 -- Function definition
-data FunDef = FunDef 
-                    HFN          -- name of the function          
-                    Consts   
-                    RawBBTree    -- body
-                    IR.FunDef    -- original definition for serialization
-                deriving (Eq)
-
--- An IR program is just a collection of atoms declarations 
+data FunDef
+    = FunDef
+        HFN -- name of the function
+        Consts
+        RawBBTree -- body
+        IR.FunDef -- original definition for serialization
+    deriving (Eq)
+
+-- An IR program is just a collection of atoms declarations
 -- and function definitions
-data RawProgram = RawProgram C.Atoms [FunDef] 
-
+data RawProgram = RawProgram C.Atoms [FunDef]
 
 -----------------------------------------------------------
--- Serialization 
+-- Serialization
 -----------------------------------------------------------
-data RawUnit 
-  = FunRawUnit FunDef 
-  | AtomRawUnit C.Atoms 
-  | ProgramRawUnit RawProgram 
-
-
+data RawUnit
+    = FunRawUnit FunDef
+    | AtomRawUnit C.Atoms
+    | ProgramRawUnit RawProgram
 
 -----------------------------------------------------------
 -- AUX DECLARATIONS
 -----------------------------------------------------------
 
+data Assignable
+    = AssignableRaw Raw.RawVar
+    | AssignableLVal VarName
+    | Env
+    deriving (Eq, Ord, Show)
 
-
-data Assignable = AssignableRaw Raw.RawVar 
-                | AssignableLVal VarName
-                | Env
-                deriving (Eq, Ord, Show)
-
-
-data RegularInstructionKind 
-  = RegConstructor 
-  | RegDestructor
-  | RegOther 
-      deriving (Eq, Ord, Show)
+data RegularInstructionKind
+    = RegConstructor
+    | RegDestructor
+    | RegOther
+    deriving (Eq, Ord, Show)
 
 -- | Used to determine in how far instructions can be reordered.
-data InstructionType 
-  = RegularInstruction RegularInstructionKind
-  | LabelSpecificInstruction
+data InstructionType
+    = RegularInstruction RegularInstructionKind
+    | LabelSpecificInstruction
     deriving (Eq, Ord, Show)
 
 instructionType :: RawInst -> InstructionType
-instructionType i = case i of 
-  AssignRaw _ (Bin Basics.LatticeJoin _ _ _) -> LabelSpecificInstruction
-  AssignRaw _ (ProjectState MonPC) -> LabelSpecificInstruction
-  AssignRaw _ (ProjectState MonBlock) -> LabelSpecificInstruction
-  AssignRaw _ (ProjectState R0_Lev)  -> LabelSpecificInstruction
-  AssignRaw _ (ProjectState R0_TLev) -> LabelSpecificInstruction
-  AssignLVal _ (ConstructLVal _ _ _) -> RegularInstruction RegConstructor
-  AssignRaw _ (ProjectLVal _ _) -> RegularInstruction RegDestructor
-  SetBranchFlag -> RegularInstruction RegConstructor
-  InvalidateSparseBit -> RegularInstruction RegOther
-  SetState s _ -> 
-    case s of 
-      R0_Val -> RegularInstruction RegConstructor 
-      R0_Lev -> RegularInstruction RegConstructor
-      R0_TLev -> RegularInstruction RegConstructor
-      MonPC -> LabelSpecificInstruction
-      MonBlock -> LabelSpecificInstruction
-  _ -> RegularInstruction RegOther
-
-
+instructionType i = case i of
+    AssignRaw _ (Bin Basics.LatticeJoin _ _ _) -> LabelSpecificInstruction
+    AssignRaw _ (ProjectState MonPC) -> LabelSpecificInstruction
+    AssignRaw _ (ProjectState MonBlock) -> LabelSpecificInstruction
+    AssignRaw _ (ProjectState R0_Lev) -> LabelSpecificInstruction
+    AssignRaw _ (ProjectState R0_TLev) -> LabelSpecificInstruction
+    AssignLVal _ (ConstructLVal _ _ _) -> RegularInstruction RegConstructor
+    AssignRaw _ (ProjectLVal _ _) -> RegularInstruction RegDestructor
+    SetBranchFlag -> RegularInstruction RegConstructor
+    InvalidateSparseBit -> RegularInstruction RegOther
+    SetState s _ ->
+        case s of
+            R0_Val -> RegularInstruction RegConstructor
+            R0_Lev -> RegularInstruction RegConstructor
+            R0_TLev -> RegularInstruction RegConstructor
+            MonPC -> LabelSpecificInstruction
+            MonBlock -> LabelSpecificInstruction
+    _ -> RegularInstruction RegOther
 
 -----------------------------------------------------------
 -- PRETTY PRINTING
 -----------------------------------------------------------
 
 ppProg (RawProgram atoms funs) =
-  vcat $ (map ppFunDef funs)
+    vcat $ (map ppFunDef funs)
 
 instance Show RawProgram where
-  show = PP.render.ppProg
-
-ppFunDef ( FunDef hfn consts insts  _ )
-  = vcat [ text "func" <+> ppFunCall (ppId hfn) [] <+> text "{"
-         , nest 2 (ppConsts consts )
-         , nest 2 (ppBB insts)
-         , text "}"]
-
+    show = PP.render . ppProg
 
+ppFunDef (FunDef hfn consts insts _) =
+    vcat
+        [ text "func" <+> ppFunCall (ppId hfn) [] <+> text "{"
+        , nest 2 (ppConsts consts)
+        , nest 2 (ppBB insts)
+        , text "}"
+        ]
 
 ppRawExpr :: RawExpr -> PP.Doc
-ppRawExpr (Bin binop _ va1 va2) = -- TODO: 2025-07-31; also print the fast flag 
-  ppId va1 <+> text (show binop) <+> ppId va2
+ppRawExpr (Bin binop _ va1 va2) =
+    -- TODO: 2025-07-31; also print the fast flag
+    ppId va1 <+> text (show binop) <+> ppId va2
 ppRawExpr (Un op v) =
-  text (show op) <> PP.parens (ppId v)
+    text (show op) <> PP.parens (ppId v)
 ppRawExpr (Tuple vars) =
-  PP.parens $ PP.hsep $ PP.punctuate (text ",") (map ppId vars)
+    PP.parens $ PP.hsep $ PP.punctuate (text ",") (map ppId vars)
 ppRawExpr (List vars) =
-  PP.brackets $ PP.hsep $ PP.punctuate (text ",") (map ppId vars)
+    PP.brackets $ PP.hsep $ PP.punctuate (text ",") (map ppId vars)
 ppRawExpr (ListCons v1 v2) =
-  text "cons" <> (PP.parens $ ppId v1 <> text "," <> ppId v2)
+    text "cons" <> (PP.parens $ ppId v1 <> text "," <> ppId v2)
 ppRawExpr (Const C.LUnit) = text "__unit"
 ppRawExpr (Const lit) = ppLit lit
 -- ppRawExpr (Base v) = if v == "$$authorityarg" -- special casing; hack; 2018-10-18: AA
---                       then text v 
+--                       then text v
 --                       else text v <> text "$base"
 ppRawExpr (Lib (Basics.LibName l) v) = text l <> text "." <> text v
 ppRawExpr (Record fields) = PP.braces $ qqFields fields
-ppRawExpr (WithRecord x fields) = PP.braces $ PP.hsep[ ppId x, text "with", qqFields fields]
+ppRawExpr (WithRecord x fields) = PP.braces $ PP.hsep [ppId x, text "with", qqFields fields]
 ppRawExpr (ProjField x f) =
-  PP.text "ProjField" PP.<+> (ppId x) PP.<+> PP.text f
+    PP.text "ProjField" PP.<+> (ppId x) PP.<+> PP.text f
 ppRawExpr (ProjIdx x idx) =
-  PP.text "ProjIdx" PP.<+> (ppId x) PP.<+> PP.text (show idx)
-ppRawExpr (ProjectLVal v f) = 
-  (ppId v) PP.<> text "." PP.<>  PP.text (show f)
+    PP.text "ProjIdx" PP.<+> (ppId x) PP.<+> PP.text (show idx)
+ppRawExpr (ProjectLVal v f) =
+    (ppId v) PP.<> text "." PP.<> PP.text (show f)
 ppRawExpr (ProjectState cmp) = ppId cmp
-
-
 ppRawExpr (Base v) = text v
 ppRawExpr (ConstructLVal v lv lt) =
-  text "LVal" <+> PP.parens ( ppId v  <+> text "," <+>
-                                ppId lv <+> text "," <+>
-                                ppId lt)
-    
+    text "LVal"
+        <+> PP.parens
+            ( ppId v
+                <+> text ","
+                <+> ppId lv
+                <+> text ","
+                <+> ppId lt
+            )
+
 qqFields fields =
-  PP.hsep $ PP.punctuate (text ",") (map ppField fields)
-    where 
-      ppField (name, v) = 
+    PP.hsep $ PP.punctuate (text ",") (map ppField fields)
+  where
+    ppField (name, v) =
         PP.hcat [PP.text name, PP.text "=", ppId v]
 
 ppIR :: RawInst -> PP.Doc
 ppIR SetBranchFlag = text "<setbranchflag>"
 ppIR (AssignRaw vn st) = ppId vn <+> text "=(raw)" <+> ppRawExpr st
-ppIR (AssignLVal vn expr) = 
-  ppId vn <+> text "=(lval)" <+> ppRawExpr expr
--- ppIR (ConstructLVal x v lv lt) = 
---   ppId x <+> text 
+ppIR (AssignLVal vn expr) =
+    ppId vn <+> text "=(lval)" <+> ppRawExpr expr
+-- ppIR (ConstructLVal x v lv lt) =
+--   ppId x <+> text
 ppIR (RTAssertion a) = ppRTAssertion a
-ppIR (SetState comp v) = 
-  ppId comp <+> text "<-" <+> ppId v
+ppIR (SetState comp v) =
+    ppId comp <+> text "<-" <+> ppId v
 ppIR InvalidateSparseBit = text "<invalidate sparse bit>"
-
-ppIR (MkFunClosures varmap fdefs) = 
+ppIR (MkFunClosures varmap fdefs) =
     let vs = hsepc $ ppEnvIds varmap
-        ppFdefs = map (\((VN x), HFN y) ->  text x <+> text "= mkClos" <+> text y ) fdefs 
+        ppFdefs = map (\((VN x), HFN y) -> text x <+> text "= mkClos" <+> text y) fdefs
      in text "with env:=" <+> PP.brackets vs $$ nest 2 (vcat ppFdefs)
-    where ppEnvIds ls =
-            map (\(a,b) -> (ppId a) PP.<+> text "->" <+> ppId b ) ls
-          hsepc ls = PP.hsep (PP.punctuate (text ",") ls)
+  where
+    ppEnvIds ls =
+        map (\(a, b) -> (ppId a) PP.<+> text "->" <+> ppId b) ls
+    hsepc ls = PP.hsep (PP.punctuate (text ",") ls)
 
-    
--- ppIR (LevelOperations _ insts) = 
+-- ppIR (LevelOperations _ insts) =
 --  text "level operation" $$ nest 2 (vcat (map ppIR insts))
 
 ppTr (Call bb1 bb2) = (text "call" $$ nest 4 (ppBB bb1)) $$ (ppBB bb2)
-
-
--- ppTr (AssertElseError va ir va2 _) 
+-- ppTr (AssertElseError va ir va2 _)
 --   = text "assert" <+> PP.parens (ppId va) <+>
 --     text "{" $$
 --     nest 2 (ppBB ir) $$
 --     text "}" $$
 --     text "elseError" <+> (ppId va2)
 
-
-ppTr (If va ir1 ir2)
-  = text "if" <+> PP.parens (ppId va) <+>
-    text "{" $$
-    nest 4 (ppBB ir1) $$
-    text "}" $$
-    text "else {" $$
-    nest 4 (ppBB ir2) $$
-    text "}"
-ppTr (TailCall va1 ) = ppFunCall (text "tail") [ppId va1]
-ppTr (Ret)  = text "ret"
+ppTr (If va ir1 ir2) =
+    text "if"
+        <+> PP.parens (ppId va)
+        <+> text "{"
+        $$ nest 4 (ppBB ir1)
+        $$ text "}"
+        $$ text "else {"
+        $$ nest 4 (ppBB ir2)
+        $$ text "}"
+ppTr (TailCall va1) = ppFunCall (text "tail") [ppId va1]
+ppTr (Ret) = text "ret"
 ppTr (LibExport va) = ppFunCall (text "export") [ppId va]
-ppTr (Error va _)  = (text "error ") <> (ppId va)
-
+ppTr (Error va _) = (text "error ") <> (ppId va)
 
 ppBB (BB insts tr) = vcat $ (map ppIR insts) ++ [ppTr tr]
 
-ppConsts consts = 
-  vcat $ map ppConst consts 
-    where ppConst (x, lit) = hsep [ ppId x , text "=", ppLit lit ]
-
-
+ppConsts consts =
+    vcat $ map ppConst consts
+  where
+    ppConst (x, lit) = hsep [ppId x, text "=", ppLit lit]
diff --git a/compiler/src/Raw2Stack.hs b/compiler/src/Raw2Stack.hs
index caf87c3b..ea46a64d 100644
--- a/compiler/src/Raw2Stack.hs
+++ b/compiler/src/Raw2Stack.hs
@@ -1,249 +1,259 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
-
+{-# LANGUAGE OverloadedStrings #-}
 
 module Raw2Stack (rawProg2Stack, rawFun2Stack, raw2Stack)
 where
 
-import IR (SerializationUnit(..), HFN(..)
-          , ppId, ppFunCall, ppArgs, Fields (..), Ident
-          , serializeFunDef
-          , serializeAtoms )
-import qualified IR           
-import qualified Raw 
-import qualified Stack 
+import Data.Map.Lazy (Map, (!))
+import qualified Data.Map.Lazy as Map
 import qualified Data.Maybe as Maybe
-import Data.Map.Lazy (Map,(!))
-import qualified Data.Map.Lazy as Map 
-
-import Data.Set(Set)
-import qualified Data.Set as Set 
+import IR (
+    Fields (..),
+    HFN (..),
+    Ident,
+    SerializationUnit (..),
+    ppArgs,
+    ppFunCall,
+    ppId,
+    serializeAtoms,
+    serializeFunDef,
+ )
+import qualified IR
+import qualified Raw
+import qualified Stack
+
+import Data.Set (Set)
+import qualified Data.Set as Set
 
 import qualified Basics
-import qualified Core as C
-import RetCPS(VarName(..))
-import qualified RetCPS as CPS
+import CompileMode
 import Control.Monad.RWS
+import Control.Monad.Reader
 import Control.Monad.State
 import Control.Monad.Writer
-import Control.Monad.Reader
+import qualified Core as C
+import qualified Data.Aeson as Aeson
+import Data.ByteString.Base64 (decode, encode)
+import Data.ByteString.Lazy (ByteString)
 import Data.List
 import qualified Data.Text as T
 import Data.Text.Encoding
-import Data.ByteString.Lazy (ByteString)
-import Data.ByteString.Base64 (encode,decode)
-import CompileMode
-import TroupePositionInfo
-import qualified Data.Aeson as Aeson
 import GHC.Generics (Generic)
-import           RetCPS (VarName (..))
+import RetCPS (VarName (..))
+import qualified RetCPS as CPS
+import TroupePositionInfo
 
-import           IR ( Identifier(..)
-                    , VarAccess(..), HFN (..), Fields (..), Ident
-                    , ppId,ppFunCall,ppArgs
-                    )
+import IR (
+    Fields (..),
+    HFN (..),
+    Ident,
+    Identifier (..),
+    VarAccess (..),
+    ppArgs,
+    ppFunCall,
+    ppId,
+ )
 
 import RawDefUse
 
-data TEnv = TEnv { defsUses :: DefUse, offsets :: OffsetMap, localCallDepth :: Int, __consts :: Raw.ConstMap }
-type BlockNumber = Int 
+data TEnv = TEnv {defsUses :: DefUse, offsets :: OffsetMap, localCallDepth :: Int, __consts :: Raw.ConstMap}
+type BlockNumber = Int
 
 type Tr = RWS TEnv () BlockNumber
 
-getBlockNumber :: Tr BlockNumber 
-getBlockNumber = get 
-
+getBlockNumber :: Tr BlockNumber
+getBlockNumber = get
 
 setBlockNumber :: BlockNumber -> Tr ()
 setBlockNumber = put
 
-
 frameOverhead = 5
 
-offsetWithCallDepth = do 
-  __callDepth <- localCallDepth <$> ask 
-  __offsets <- offsets <$> ask 
-  let frameSize = Map.size __offsets
-  let rel i = i - if __callDepth == 0 
-                      then 0
-                      else __callDepth * frameOverhead + (frameSize + 1)
-  return rel 
-      
-
+offsetWithCallDepth = do
+    __callDepth <- localCallDepth <$> ask
+    __offsets <- offsets <$> ask
+    let frameSize = Map.size __offsets
+    let rel i =
+            i
+                - if __callDepth == 0
+                    then 0
+                    else __callDepth * frameOverhead + (frameSize + 1)
+    return rel
 
 trInsts :: [Raw.RawInst] -> Tr [Stack.StackInst]
-trInsts ii = work [] [] ii  where
-  trOneRegInst :: Raw.RawInst -> Tr [Stack.StackInst]
-  trOneRegInst i = do 
-    __offsets <- offsets <$> ask  
-    rel <- offsetWithCallDepth 
-    let store a =
-            case Map.lookup a __offsets of
-                Nothing -> []
-                Just i ->  [Stack.StoreStack a (rel i)]
-    case i of 
-      Raw.AssignRaw x e -> return $
-        (Stack.AssignRaw Stack.AssignConst x e):(store (Raw.AssignableRaw x))
-      Raw.AssignLVal x e -> return $ 
-        (Stack.AssignLVal x e):(store (Raw.AssignableLVal x))            
-      Raw.SetState cmp x -> return [Stack.SetState cmp x]
-      Raw.SetBranchFlag -> return [Stack.SetBranchFlag]
-      Raw.InvalidateSparseBit -> return [Stack.InvalidateSparseBit]
-      Raw.MkFunClosures envmap vars -> do 
-        let stores = concat $ map (store . Raw.AssignableLVal) (fst (unzip vars))      
-        return $ (Stack.MkFunClosures envmap vars):stores
-      Raw.RTAssertion a -> return [Stack.RTAssertion a]
-
-  translateGroup [] = return []
-  translateGroup insts = do 
-    rr <- ask 
-    rel <- offsetWithCallDepth
-    let __uses = (uses.defsUses) rr
-        __defs = (defs.defsUses) rr 
-        __offsets = offsets rr 
-
-        filteredUsesOf f x = 
-          let x' = Raw.AssignableRaw x 
-              loc_def = case Map.lookup x' __defs of
-                            Nothing-> error $ "cannot find " ++ (show x')
-                            Just w -> w
-              x_uses_set = Map.findWithDefault Set.empty x' __uses
-          in Set.filter (f loc_def) x_uses_set
-
-
-        escapingUses = filteredUsesOf $ 
-                 \(c_def, _) ( c_use, _) -> c_use > c_def
-
-        outsideGroupUses = filteredUsesOf $ 
-                 \(c_def, z_def) ( c_use, z_use) -> c_use > c_def || z_use /= z_def
-
-        isGroupEscaping x = 0 < Set.size ( outsideGroupUses x )
-        isBlockEscaping x = 0 < Set.size ( escapingUses x )
-
-        assignVars = concat $ map assignVar insts
-                 where 
-                   assignVar i = case i of 
-                     Raw.AssignRaw x _ -> [x]
-                     _ -> []
-        
-
-        prologue = [ Stack.AssignRaw Stack.AssignLet x (Raw.ProjectState Raw.MonPC) 
-                       | x <- assignVars,
-                         isGroupEscaping x ]
-
-        
-        epilogue = [ Stack.StoreStack x' (rel j)
-                       | x <- assignVars
-                       , isBlockEscaping x
-                       , let x' = Raw.AssignableRaw x
-                       , let j = case Map.lookup x' __offsets of 
-                                          Nothing -> error $ "epilogue: cannot find " ++ (show x')
-                                          Just w -> w 
-                   ]
-                    
-        tri i = case i of 
-                  Raw.AssignRaw x y -> 
-                      let t = if isGroupEscaping x then Stack.AssignMut 
-                                                   else Stack.AssignConst 
-                      in Stack.AssignRaw t x y
-                  Raw.SetState cmp x -> Stack.SetState cmp x 
-                  _ -> error "impossible case/bug: only label instructions must be passed to this translation function"
-
-        insts' = Stack.LabelGroup $ map tri insts 
-        
-    return $ prologue ++ (insts' : epilogue )
-
-  work accum group ii = do
-    case ii of 
-      [] -> do 
-              gg <- translateGroup group 
-              return $ accum ++ gg 
-      (inst:insts) -> do
-        if instructionType inst == LabelSpecificInstruction 
-          then
-            case group of 
-              [] -> work accum ([inst]) insts 
-              jj -> work accum ((jj ++ [inst])) insts 
-          else do 
-            ii' <- trOneRegInst inst 
-            case group of 
-              [] -> work (accum ++ ii') [] insts 
-              jj -> do 
-                  gg <- translateGroup jj 
-                  work (accum ++ gg ++ ii') [] insts 
-
-           
+trInsts ii = work [] [] ii
+  where
+    trOneRegInst :: Raw.RawInst -> Tr [Stack.StackInst]
+    trOneRegInst i = do
+        __offsets <- offsets <$> ask
+        rel <- offsetWithCallDepth
+        let store a =
+                case Map.lookup a __offsets of
+                    Nothing -> []
+                    Just i -> [Stack.StoreStack a (rel i)]
+        case i of
+            Raw.AssignRaw x e ->
+                return $
+                    (Stack.AssignRaw Stack.AssignConst x e) : (store (Raw.AssignableRaw x))
+            Raw.AssignLVal x e ->
+                return $
+                    (Stack.AssignLVal x e) : (store (Raw.AssignableLVal x))
+            Raw.SetState cmp x -> return [Stack.SetState cmp x]
+            Raw.SetBranchFlag -> return [Stack.SetBranchFlag]
+            Raw.InvalidateSparseBit -> return [Stack.InvalidateSparseBit]
+            Raw.MkFunClosures envmap vars -> do
+                let stores = concat $ map (store . Raw.AssignableLVal) (fst (unzip vars))
+                return $ (Stack.MkFunClosures envmap vars) : stores
+            Raw.RTAssertion a -> return [Stack.RTAssertion a]
+
+    translateGroup [] = return []
+    translateGroup insts = do
+        rr <- ask
+        rel <- offsetWithCallDepth
+        let __uses = (uses . defsUses) rr
+            __defs = (defs . defsUses) rr
+            __offsets = offsets rr
+
+            filteredUsesOf f x =
+                let x' = Raw.AssignableRaw x
+                    loc_def = case Map.lookup x' __defs of
+                        Nothing -> error $ "cannot find " ++ (show x')
+                        Just w -> w
+                    x_uses_set = Map.findWithDefault Set.empty x' __uses
+                 in Set.filter (f loc_def) x_uses_set
+
+            escapingUses = filteredUsesOf $
+                \(c_def, _) (c_use, _) -> c_use > c_def
+
+            outsideGroupUses = filteredUsesOf $
+                \(c_def, z_def) (c_use, z_use) -> c_use > c_def || z_use /= z_def
+
+            isGroupEscaping x = 0 < Set.size (outsideGroupUses x)
+            isBlockEscaping x = 0 < Set.size (escapingUses x)
+
+            assignVars = concat $ map assignVar insts
+              where
+                assignVar i = case i of
+                    Raw.AssignRaw x _ -> [x]
+                    _ -> []
+
+            prologue =
+                [ Stack.AssignRaw Stack.AssignLet x (Raw.ProjectState Raw.MonPC)
+                | x <- assignVars
+                , isGroupEscaping x
+                ]
+
+            epilogue =
+                [ Stack.StoreStack x' (rel j)
+                | x <- assignVars
+                , isBlockEscaping x
+                , let x' = Raw.AssignableRaw x
+                , let j = case Map.lookup x' __offsets of
+                        Nothing -> error $ "epilogue: cannot find " ++ (show x')
+                        Just w -> w
+                ]
+
+            tri i = case i of
+                Raw.AssignRaw x y ->
+                    let t =
+                            if isGroupEscaping x
+                                then Stack.AssignMut
+                                else Stack.AssignConst
+                     in Stack.AssignRaw t x y
+                Raw.SetState cmp x -> Stack.SetState cmp x
+                _ -> error "impossible case/bug: only label instructions must be passed to this translation function"
+
+            insts' = Stack.LabelGroup $ map tri insts
+
+        return $ prologue ++ (insts' : epilogue)
+
+    work accum group ii = do
+        case ii of
+            [] -> do
+                gg <- translateGroup group
+                return $ accum ++ gg
+            (inst : insts) -> do
+                if instructionType inst == LabelSpecificInstruction
+                    then case group of
+                        [] -> work accum ([inst]) insts
+                        jj -> work accum ((jj ++ [inst])) insts
+                    else do
+                        ii' <- trOneRegInst inst
+                        case group of
+                            [] -> work (accum ++ ii') [] insts
+                            jj -> do
+                                gg <- translateGroup jj
+                                work (accum ++ gg ++ ii') [] insts
 
 trTr :: Raw.RawTerminator -> Tr Stack.StackTerminator
-trTr (Raw.TailCall r) = do 
-     return $ Stack.TailCall r
-trTr Raw.Ret = return Stack.Ret 
-trTr (Raw.If r bb1 bb2) = do 
-     bb1' <- trBB bb1 
-     bb2' <- trBB bb2 
-     return $ Stack.If r bb1' bb2' 
-trTr (Raw.LibExport v) = do 
-     return $ Stack.LibExport v 
-trTr (Raw.Error r1 p) = do 
-     return $ Stack.Error r1 p 
-trTr (Raw.Call bb1 bb2) = do 
-   __callDepth <- localCallDepth <$> ask 
-   bb1' <- local (\tenv -> tenv { localCallDepth = __callDepth + 1 } ) $ trBB bb1 
-   n <- getBlockNumber
-   let n' = n + 1 
-   setBlockNumber n' 
-   varsToLoad <- 
-     (Map.findWithDefault Set.empty n').escapingUses.defsUses <$> ask
-   offsets <- offsets <$> ask 
-   rel <- offsetWithCallDepth 
-   consts <- __consts <$> ask 
-   let filterConsts (Raw.AssignableRaw x) = Map.notMember x consts 
-       filterConsts _ = True
-   let loads = [ Stack.FetchStack x (rel (Map.findWithDefault (error (show x)) x offsets))
-                    | x <-  filter filterConsts (Set.elems varsToLoad) ]   
-   bb2'@(Stack.BB inst_2 tr_2) <- trBB bb2
-
-   return $ Stack.Call bb1' (Stack.BB (loads ++ inst_2) tr_2)
-
-
-trBB :: Raw.RawBBTree -> Tr Stack.StackBBTree 
+trTr (Raw.TailCall r) = do
+    return $ Stack.TailCall r
+trTr Raw.Ret = return Stack.Ret
+trTr (Raw.If r bb1 bb2) = do
+    bb1' <- trBB bb1
+    bb2' <- trBB bb2
+    return $ Stack.If r bb1' bb2'
+trTr (Raw.LibExport v) = do
+    return $ Stack.LibExport v
+trTr (Raw.Error r1 p) = do
+    return $ Stack.Error r1 p
+trTr (Raw.Call bb1 bb2) = do
+    __callDepth <- localCallDepth <$> ask
+    bb1' <- local (\tenv -> tenv{localCallDepth = __callDepth + 1}) $ trBB bb1
+    n <- getBlockNumber
+    let n' = n + 1
+    setBlockNumber n'
+    varsToLoad <-
+        (Map.findWithDefault Set.empty n') . escapingUses . defsUses <$> ask
+    offsets <- offsets <$> ask
+    rel <- offsetWithCallDepth
+    consts <- __consts <$> ask
+    let filterConsts (Raw.AssignableRaw x) = Map.notMember x consts
+        filterConsts _ = True
+    let loads =
+            [ Stack.FetchStack x (rel (Map.findWithDefault (error (show x)) x offsets))
+            | x <- filter filterConsts (Set.elems varsToLoad)
+            ]
+    bb2'@(Stack.BB inst_2 tr_2) <- trBB bb2
+
+    return $ Stack.Call bb1' (Stack.BB (loads ++ inst_2) tr_2)
+
+trBB :: Raw.RawBBTree -> Tr Stack.StackBBTree
 trBB (Raw.BB insts tr) = do
-  insts' <- trInsts insts
-  tr'    <- trTr tr 
-  return $ Stack.BB insts' tr'
-
+    insts' <- trInsts insts
+    tr' <- trTr tr
+    return $ Stack.BB insts' tr'
 
 trFun :: Raw.FunDef -> Stack.FunDef
-trFun fdef@(Raw.FunDef hfn consts bb ir) = 
-  let defUseInfo = defUse fdef 
-      constMap = Map.fromList consts
-      offsets = offsetMap constMap defUseInfo
-      
-      env = TEnv { defsUses = defUseInfo
-                 , offsets = offsets
-                 , localCallDepth = 0
-                 , __consts = constMap 
-                 }
-      (bb', _, _) =runRWS (trBB bb) env 0
-      Stack.BB insts bb_ = bb' 
-      insts_ = case Map.lookup Raw.Env offsets of 
-                     Nothing -> insts 
-                     Just ee  -> (Stack.StoreStack Raw.Env ee) :insts
-      frameSize = Map.size offsets
-  in Stack.FunDef hfn frameSize consts (Stack.BB insts_ bb_) ir
-
+trFun fdef@(Raw.FunDef hfn consts bb ir) =
+    let defUseInfo = defUse fdef
+        constMap = Map.fromList consts
+        offsets = offsetMap constMap defUseInfo
+
+        env =
+            TEnv
+                { defsUses = defUseInfo
+                , offsets = offsets
+                , localCallDepth = 0
+                , __consts = constMap
+                }
+        (bb', _, _) = runRWS (trBB bb) env 0
+        Stack.BB insts bb_ = bb'
+        insts_ = case Map.lookup Raw.Env offsets of
+            Nothing -> insts
+            Just ee -> (Stack.StoreStack Raw.Env ee) : insts
+        frameSize = Map.size offsets
+     in Stack.FunDef hfn frameSize consts (Stack.BB insts_ bb_) ir
 
 rawProg2Stack :: Raw.RawProgram -> Stack.StackProgram
-rawProg2Stack (Raw.RawProgram atms fdefs)  =
-  Stack.StackProgram atms (map trFun fdefs)
-
+rawProg2Stack (Raw.RawProgram atms fdefs) =
+    Stack.StackProgram atms (map trFun fdefs)
 
-rawFun2Stack = trFun 
+rawFun2Stack = trFun
 
-raw2Stack :: Raw.RawUnit -> Stack.StackUnit 
-raw2Stack r = case r of 
-  Raw.FunRawUnit f -> Stack.FunStackUnit (trFun f)
-  Raw.AtomRawUnit c -> Stack.AtomStackUnit c 
-  Raw.ProgramRawUnit p -> Stack.ProgramStackUnit (rawProg2Stack p)
\ No newline at end of file
+raw2Stack :: Raw.RawUnit -> Stack.StackUnit
+raw2Stack r = case r of
+    Raw.FunRawUnit f -> Stack.FunStackUnit (trFun f)
+    Raw.AtomRawUnit c -> Stack.AtomStackUnit c
+    Raw.ProgramRawUnit p -> Stack.ProgramStackUnit (rawProg2Stack p)
diff --git a/compiler/src/RawDefUse.hs b/compiler/src/RawDefUse.hs
index c6b7314f..4956bf34 100644
--- a/compiler/src/RawDefUse.hs
+++ b/compiler/src/RawDefUse.hs
@@ -1,367 +1,363 @@
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
-module RawDefUse (offsetMap
-                 , defUse
-                 , DefUse (..)
-                 , OffsetMap(..)
-                 , InstructionType (..)
-                 , instructionType
-                 , iDefUse
-                 ) where
-
-import Raw  
-import IR (SerializationUnit(..), HFN(..)
-          , ppId, ppFunCall, ppArgs, Fields (..), Ident
-          , serializeFunDef
-          , serializeAtoms )
-import qualified IR           
-import qualified Stack 
-import qualified Data.Maybe as Maybe
-import Data.Map.Lazy (Map, (!))
-import qualified Data.Map.Lazy as Map 
+module RawDefUse (
+    offsetMap,
+    defUse,
+    DefUse (..),
+    OffsetMap (..),
+    InstructionType (..),
+    instructionType,
+    iDefUse,
+) where
 
-import Data.Set(Set)
-import qualified Data.Set as Set 
+import Data.Map.Lazy (Map, (!))
+import qualified Data.Map.Lazy as Map
+import qualified Data.Maybe as Maybe
+import IR (
+    Fields (..),
+    HFN (..),
+    Ident,
+    SerializationUnit (..),
+    ppArgs,
+    ppFunCall,
+    ppId,
+    serializeAtoms,
+    serializeFunDef,
+ )
+import qualified IR
+import Raw
+import qualified Stack
+
+import Data.Set (Set)
+import qualified Data.Set as Set
 
 import qualified Basics
-import qualified Core as C
-import RetCPS(VarName(..))
-import qualified RetCPS as CPS
+import CompileMode
 import Control.Monad.RWS
+import Control.Monad.Reader
 import Control.Monad.State
 import Control.Monad.Writer
-import Control.Monad.Reader
+import qualified Core as C
+import qualified Data.Aeson as Aeson
+import Data.ByteString.Base64 (decode, encode)
+import Data.ByteString.Lazy (ByteString)
 import Data.List
 import qualified Data.Text as T
 import Data.Text.Encoding
-import Data.ByteString.Lazy (ByteString)
-import Data.ByteString.Base64 (encode,decode)
-import CompileMode
-import TroupePositionInfo
-import qualified Data.Aeson as Aeson
 import GHC.Generics (Generic)
-import           RetCPS (VarName (..))
+import RetCPS (VarName (..))
+import qualified RetCPS as CPS
+import TroupePositionInfo
 
-import           IR ( Identifier(..)
-                    , VarAccess(..), HFN (..), Fields (..), Ident
-                    , ppId,ppFunCall,ppArgs
-                    )
+import IR (
+    Fields (..),
+    HFN (..),
+    Ident,
+    Identifier (..),
+    VarAccess (..),
+    ppArgs,
+    ppFunCall,
+    ppId,
+ )
 
 type CallLocation = Int
-type ZoneLocation = Int 
+type ZoneLocation = Int
 type Location = (CallLocation, ZoneLocation) -- calls, zones
 
-
 data DefUse = DefUse
-  { 
-    defs :: Map Assignable Location ,
-    uses :: Map Assignable (Set Location),
-    escapingUses :: Map CallLocation (Set Assignable) -- map from basic blocks to the assignables        
-  }
-
-
-data TraverseState a = TraverseState 
-  { 
-    defUseMaps :: a,
-    locInfo :: Location ,
-    nCalls :: Int
-  }
-
-
-data DefUseOps a = DefUseOps 
-  { 
-    __insertUse :: Assignable -> TraverseState a -> TraverseState a,
-    __insertDef :: Assignable -> TraverseState a -> TraverseState a
-  }
-
+    { defs :: Map Assignable Location
+    , uses :: Map Assignable (Set Location)
+    , escapingUses :: Map CallLocation (Set Assignable) -- map from basic blocks to the assignables
+    }
+
+data TraverseState a = TraverseState
+    { defUseMaps :: a
+    , locInfo :: Location
+    , nCalls :: Int
+    }
+
+data DefUseOps a = DefUseOps
+    { __insertUse :: Assignable -> TraverseState a -> TraverseState a
+    , __insertDef :: Assignable -> TraverseState a -> TraverseState a
+    }
 
 -- | The traversal monad for the Def-Use analysis.
 type UseDefTraversal a = RWS (DefUseOps a) () (TraverseState a)
-type Tr = UseDefTraversal DefUse 
 
+type Tr = UseDefTraversal DefUse
 
 type OffsetMap = Map Assignable Int
 offsetMap :: ConstMap -> DefUse -> OffsetMap
-offsetMap consts (DefUse { defs, uses, escapingUses }) = 
-  let isEscaping x (c_def, _) = 
-        let uses_set = Map.findWithDefault (Set.empty) x uses 
-            uses' = Set.filter ( \(c,_) -> c > c_def) uses_set
-        in (0 < Set.size uses') && (case x of AssignableRaw  r -> Map.notMember r consts
-                                              _ -> True  )
-      map' = Map.filterWithKey isEscaping defs 
-      escaping = Map.keys map' 
-  in Map.fromList $ zip escaping [0..(-1 + Map.size map')] 
-
-
-
-class Definable a b where 
-  define :: a -> UseDefTraversal b ()
+offsetMap consts (DefUse{defs, uses, escapingUses}) =
+    let isEscaping x (c_def, _) =
+            let uses_set = Map.findWithDefault (Set.empty) x uses
+                uses' = Set.filter (\(c, _) -> c > c_def) uses_set
+             in (0 < Set.size uses')
+                    && ( case x of
+                            AssignableRaw r -> Map.notMember r consts
+                            _ -> True
+                       )
+        map' = Map.filterWithKey isEscaping defs
+        escaping = Map.keys map'
+     in Map.fromList $ zip escaping [0 .. (-1 + Map.size map')]
+
+class Definable a b where
+    define :: a -> UseDefTraversal b ()
 
 class Usable a b where
-  use :: a -> UseDefTraversal b ()
+    use :: a -> UseDefTraversal b ()
 
-
-
-__insertUsePure x state = 
-    let defsUses = defUseMaps state 
+__insertUsePure x state =
+    let defsUses = defUseMaps state
         useMap = uses defsUses
         defMap = defs defsUses
-        escUse = escapingUses defsUses 
-        block@(c_use,_) = locInfo state
-        (c_def, _) = 
-          case Map.lookup x defMap of 
-                 Nothing -> error $ "insert use: cannot find " ++ (show x)
-                 Just w -> w 
+        escUse = escapingUses defsUses
+        block@(c_use, _) = locInfo state
+        (c_def, _) =
+            case Map.lookup x defMap of
+                Nothing -> error $ "insert use: cannot find " ++ (show x)
+                Just w -> w
         currentUses = Map.findWithDefault (Set.empty) x useMap
         currentEsc = Map.findWithDefault (Set.empty) (fst block) escUse
         newUse = Set.insert block currentUses
-        newEsc = if c_def < c_use then Set.insert x currentEsc
-                                  else currentEsc
-    in  state { 
-            defUseMaps = 
-              defsUses {
-                uses = Map.insert x newUse useMap, 
-                escapingUses = Map.insert (fst block) newEsc escUse
-        }} 
-
-
-__insertDefPure x state = 
-  let defsUses = defUseMaps state 
-      defMap = defs defsUses
-      block = locInfo state
-  in
-    if Map.member x defMap 
-      then error $ "Duplicate bindings for " ++ (show x)
-      else  state { 
-                  defUseMaps = 
-                    defsUses {
-                      defs = Map.insert x block defMap}} 
-
-
-
-instance Definable RawVar b where 
-  define x = do 
-    f <- __insertDef <$> ask 
-    modify $ f (AssignableRaw x)
-
-
-instance Definable VarName b where 
-  define x = do
-    f <- __insertDef <$> ask
-    modify $ f (AssignableLVal x)
-
+        newEsc =
+            if c_def < c_use
+                then Set.insert x currentEsc
+                else currentEsc
+     in state
+            { defUseMaps =
+                defsUses
+                    { uses = Map.insert x newUse useMap
+                    , escapingUses = Map.insert (fst block) newEsc escUse
+                    }
+            }
+
+__insertDefPure x state =
+    let defsUses = defUseMaps state
+        defMap = defs defsUses
+        block = locInfo state
+     in if Map.member x defMap
+            then error $ "Duplicate bindings for " ++ (show x)
+            else
+                state
+                    { defUseMaps =
+                        defsUses
+                            { defs = Map.insert x block defMap
+                            }
+                    }
+
+instance Definable RawVar b where
+    define x = do
+        f <- __insertDef <$> ask
+        modify $ f (AssignableRaw x)
+
+instance Definable VarName b where
+    define x = do
+        f <- __insertDef <$> ask
+        modify $ f (AssignableLVal x)
 
 instance Usable Assignable b where
-  use x = do 
-     f <- __insertUse <$> ask
-     modify (f x)
-
-
-instance Definable a b => Definable [a] b where
-  define = mapM_ define 
+    use x = do
+        f <- __insertUse <$> ask
+        modify (f x)
 
+instance (Definable a b) => Definable [a] b where
+    define = mapM_ define
 
 instance Usable RawVar b where
-  use x = do 
-     insertUse <- __insertUse <$> ask 
-     modify (insertUse (AssignableRaw x))
-
+    use x = do
+        insertUse <- __insertUse <$> ask
+        modify (insertUse (AssignableRaw x))
 
-instance Usable VarName b where 
-  use x = do 
-    insertUse <- __insertUse <$> ask 
-    modify $ insertUse (AssignableLVal x)
-
-
-instance Usable a b => Usable [a] b
-  where use x = mapM_ use x
+instance Usable VarName b where
+    use x = do
+        insertUse <- __insertUse <$> ask
+        modify $ insertUse (AssignableLVal x)
 
+instance (Usable a b) => Usable [a] b where
+    use x = mapM_ use x
 
 instance Usable VarAccess b where
-  use (VarLocal x) = use x
-  use _ = use Env
-
-
-instance Trav a => Trav [a]
-  where trav = mapM_ trav
-
-
-instance Usable RawExpr b where 
-  use e =     
-      case e of 
-        Raw.Bin _ _ x y -> use [x,y] 
-        Raw.Un _ x -> use x
-        Raw.ProjectLVal x _ -> use x
-        Raw.ProjectState _ -> return ()
-        Raw.Tuple xs -> use xs 
-        Raw.Record fields -> use (snd (unzip fields))
-        Raw.WithRecord x fields -> do 
-          use x 
-          use (snd (unzip fields))
-        Raw.ProjField x _ -> use x
-        Raw.ProjIdx x _ -> use x
-        Raw.List xs -> use xs
-        Raw.ListCons x y -> use x >> use y
-        Raw.Const _ -> return ()
-        Raw.Lib _ _ -> return ()
-        Raw.Base _ -> return ()    
-        Raw.ConstructLVal x y z -> do use x 
-                                      use [y,z]
-
-
-clearZone = do 
-  (c,z) <- getLocation
-  if z `mod` 2 /= 0 then 
-    setLocation (c, z + 1)
-  else 
-    return ()
-
-instance Trav RawTerminator where 
-  trav tr = 
-     case tr of 
-       TailCall r -> use r 
-       Ret -> return () 
-       If r bb1 bb2 -> do 
-         (c, z) <- getLocation 
-         use r 
-         setLocation $ (c, z + 2) 
-         trav bb1 
-         setLocation $ (c, z + 2) 
-         trav bb2
-       LibExport v -> use v 
-       Error r _ -> use r 
-       Call bb1 bb2 -> do
-         trav bb1
-         modify (\s -> 
-                     let (c, _) = locInfo s 
-                         n =  1 + nCalls s                         
-                     in s { locInfo = (n, 0), nCalls = n })
-         trav bb2 
-
+    use (VarLocal x) = use x
+    use _ = use Env
+
+instance (Trav a) => Trav [a] where
+    trav = mapM_ trav
+
+instance Usable RawExpr b where
+    use e =
+        case e of
+            Raw.Bin _ _ x y -> use [x, y]
+            Raw.Un _ x -> use x
+            Raw.ProjectLVal x _ -> use x
+            Raw.ProjectState _ -> return ()
+            Raw.Tuple xs -> use xs
+            Raw.Record fields -> use (snd (unzip fields))
+            Raw.WithRecord x fields -> do
+                use x
+                use (snd (unzip fields))
+            Raw.ProjField x _ -> use x
+            Raw.ProjIdx x _ -> use x
+            Raw.List xs -> use xs
+            Raw.ListCons x y -> use x >> use y
+            Raw.Const _ -> return ()
+            Raw.Lib _ _ -> return ()
+            Raw.Base _ -> return ()
+            Raw.ConstructLVal x y z -> do
+                use x
+                use [y, z]
+
+clearZone = do
+    (c, z) <- getLocation
+    if z `mod` 2 /= 0
+        then
+            setLocation (c, z + 1)
+        else
+            return ()
+
+instance Trav RawTerminator where
+    trav tr =
+        case tr of
+            TailCall r -> use r
+            Ret -> return ()
+            If r bb1 bb2 -> do
+                (c, z) <- getLocation
+                use r
+                setLocation $ (c, z + 2)
+                trav bb1
+                setLocation $ (c, z + 2)
+                trav bb2
+            LibExport v -> use v
+            Error r _ -> use r
+            Call bb1 bb2 -> do
+                trav bb1
+                modify
+                    ( \s ->
+                        let (c, _) = locInfo s
+                            n = 1 + nCalls s
+                         in s{locInfo = (n, 0), nCalls = n}
+                    )
+                trav bb2
 
 getLocation :: UseDefTraversal b Location
 getLocation = locInfo <$> get
 
-setLocation b = modify (\st -> st {locInfo = b})
-
+setLocation b = modify (\st -> st{locInfo = b})
 
--- Instructions in the basic blocks are partitioned into so-called 
--- zones, a zone is a natural number. Even zones correspond to regular 
--- instructions, e.g., an arithmetic plus while odd zones correspond 
--- to label operation such as setting a pc. 
+-- Instructions in the basic blocks are partitioned into so-called
+-- zones, a zone is a natural number. Even zones correspond to regular
+-- instructions, e.g., an arithmetic plus while odd zones correspond
+-- to label operation such as setting a pc.
 
 -- The idea behind the zones is that instructions within the same
--- label zone may be shortcutted if the current pc bounds the 
--- maximum amount of information that may be accessed in the function 
-
+-- label zone may be shortcutted if the current pc bounds the
+-- maximum amount of information that may be accessed in the function
 
 updateZone :: RawInst -> UseDefTraversal b ()
-updateZone i = do 
-  (blockCounter, zoneCounter) <- getLocation
-  let zoneType = zoneCounter `mod` 2 == 0 
-      typeAsBool LabelSpecificInstruction = False 
-      typeAsBool _ = True 
-  if (typeAsBool.instructionType) i  /= zoneType then 
-      setLocation ( blockCounter, zoneCounter + 1 )
-  else return ()
-
+updateZone i = do
+    (blockCounter, zoneCounter) <- getLocation
+    let zoneType = zoneCounter `mod` 2 == 0
+        typeAsBool LabelSpecificInstruction = False
+        typeAsBool _ = True
+    if (typeAsBool . instructionType) i /= zoneType
+        then
+            setLocation (blockCounter, zoneCounter + 1)
+        else return ()
 
 -- | Def-Use analysis: mark used variables
-instance Usable RawInst b where 
-  use i = do 
-     updateZone i
-     case i of 
-       AssignRaw x e -> use e 
-       AssignLVal x e -> use e 
-       SetState cmp x -> use x 
-       RTAssertion (AssertType r _) -> use r
-       --  RTAssertion (AssertEqTypes _ x y) -> use [x,y]
-       RTAssertion (AssertTypesBothStringsOrBothNumbers x y) -> use [x,y]
-       RTAssertion (AssertRecordHasField r _) -> use r
-       RTAssertion (AssertTupleLengthGreaterThan r _) -> use r
-       RTAssertion (AssertNotZero r) -> use r
-       MkFunClosures xs _ -> use (snd (unzip xs))
-       -- Instructions without variables
-       InvalidateSparseBit -> return ()
-       SetBranchFlag -> return ()
-
+instance Usable RawInst b where
+    use i = do
+        updateZone i
+        case i of
+            AssignRaw x e -> use e
+            AssignLVal x e -> use e
+            SetState cmp x -> use x
+            RTAssertion (AssertType r _) -> use r
+            --  RTAssertion (AssertEqTypes _ x y) -> use [x,y]
+            RTAssertion (AssertTypesBothStringsOrBothNumbers x y) -> use [x, y]
+            RTAssertion (AssertRecordHasField r _) -> use r
+            RTAssertion (AssertTupleLengthGreaterThan r _) -> use r
+            RTAssertion (AssertNotZero r) -> use r
+            MkFunClosures xs _ -> use (snd (unzip xs))
+            -- Instructions without variables
+            InvalidateSparseBit -> return ()
+            SetBranchFlag -> return ()
 
 -- | Mark variables that are defined.
-instance Definable RawInst b where 
-  define i = do 
-    updateZone i 
-    case i of 
-       AssignRaw x _ -> define x
-       AssignLVal x _ -> define x
-       SetState cmp x -> return ()
-       RTAssertion _ -> return ()
-       SetBranchFlag -> return ()
-       InvalidateSparseBit -> return ()
-       MkFunClosures _ ys -> mapM_ define (fst (unzip ys))
-
-
-instance Trav RawBBTree where 
-  trav (BB ii tr) = do 
-    clearZone
-    (blockCounter, zz) <- getLocation    
-    mapM_ define ii
-    setLocation (blockCounter, zz) -- reset
-    mapM_ use ii 
-    trav tr
-
-
-class Trav a where 
-   trav :: a -> Tr ()
-
-
-defUse :: FunDef -> DefUse 
-defUse (FunDef _ consts bb _) = 
-  let constVars = ( fst . unzip )consts 
-      insertConsts = mapM define constVars 
-      (defUse, _) = execRWS 
-        (modify (__insertDefPure Env) >> insertConsts >> trav bb)
-        DefUseOps { 
-                __insertUse = __insertUsePure,
-                __insertDef = __insertDefPure
-              }
-        (TraverseState 
-            {defUseMaps = DefUse 
-                           { defs = Map.empty,
-                             uses = Map.empty, 
-                             escapingUses = Map.empty
-                             },
-            locInfo = (0,0),
-            nCalls = 0
-            })
-  in defUseMaps defUse
-
+instance Definable RawInst b where
+    define i = do
+        updateZone i
+        case i of
+            AssignRaw x _ -> define x
+            AssignLVal x _ -> define x
+            SetState cmp x -> return ()
+            RTAssertion _ -> return ()
+            SetBranchFlag -> return ()
+            InvalidateSparseBit -> return ()
+            MkFunClosures _ ys -> mapM_ define (fst (unzip ys))
+
+instance Trav RawBBTree where
+    trav (BB ii tr) = do
+        clearZone
+        (blockCounter, zz) <- getLocation
+        mapM_ define ii
+        setLocation (blockCounter, zz) -- reset
+        mapM_ use ii
+        trav tr
+
+class Trav a where
+    trav :: a -> Tr ()
+
+defUse :: FunDef -> DefUse
+defUse (FunDef _ consts bb _) =
+    let constVars = (fst . unzip) consts
+        insertConsts = mapM define constVars
+        (defUse, _) =
+            execRWS
+                (modify (__insertDefPure Env) >> insertConsts >> trav bb)
+                DefUseOps
+                    { __insertUse = __insertUsePure
+                    , __insertDef = __insertDefPure
+                    }
+                ( TraverseState
+                    { defUseMaps =
+                        DefUse
+                            { defs = Map.empty
+                            , uses = Map.empty
+                            , escapingUses = Map.empty
+                            }
+                    , locInfo = (0, 0)
+                    , nCalls = 0
+                    }
+                )
+     in defUseMaps defUse
 
 iDefUse :: RawInst -> (Set Assignable, Set Assignable)
-iDefUse i = 
-  let go = do 
-            -- insDef <- __insertDef <$> ask 
-            -- modify $  insDef Env             
+iDefUse i =
+    let go = do
+            -- insDef <- __insertDef <$> ask
+            -- modify $  insDef Env
             define i
-            use i 
-      (defUse, _) = execRWS go 
-        (DefUseOps {
-            __insertDef = \x state -> 
-                            let (inserts,uses) = defUseMaps state 
-                            in state {defUseMaps = (Set.insert x inserts, uses)},
-            __insertUse = \x state -> 
-                            let (inserts, uses) = defUseMaps state 
-                            in state {defUseMaps = (inserts, Set.insert x uses)}
-        })
-        (TraverseState {
-             defUseMaps = (Set.empty, Set.empty),
-             locInfo = (0, 0),
-             nCalls = 0
-        })
-  in defUseMaps defUse    
-     
-         
-
-  
+            use i
+        (defUse, _) =
+            execRWS
+                go
+                ( DefUseOps
+                    { __insertDef = \x state ->
+                        let (inserts, uses) = defUseMaps state
+                         in state{defUseMaps = (Set.insert x inserts, uses)}
+                    , __insertUse = \x state ->
+                        let (inserts, uses) = defUseMaps state
+                         in state{defUseMaps = (inserts, Set.insert x uses)}
+                    }
+                )
+                ( TraverseState
+                    { defUseMaps = (Set.empty, Set.empty)
+                    , locInfo = (0, 0)
+                    , nCalls = 0
+                    }
+                )
+     in defUseMaps defUse
diff --git a/compiler/src/RawOpt.hs b/compiler/src/RawOpt.hs
index 937dc8be..5bf4c241 100644
--- a/compiler/src/RawOpt.hs
+++ b/compiler/src/RawOpt.hs
@@ -2,604 +2,606 @@
 {-# LANGUAGE LambdaCase #-}
 
 module RawOpt (rawopt) where
-import Raw
-import qualified Data.Maybe
-import Control.Monad.RWS.Lazy
-import Control.Monad
-import Data.Map.Lazy (Map)
-import Data.Set(Set)
-import qualified Data.List 
-import RawDefUse (iDefUse)
-import qualified Data.Set as Set 
+
 import qualified Basics
+import Control.Monad
+import Control.Monad.RWS.Lazy
 import qualified Core
-import           RetCPS (VarName (..))
-import qualified Data.Map.Lazy as Map 
-import           IR ( Identifier(..)
-                    , VarAccess(..), HFN (..), Fields (..), Ident
-                    , ppId,ppFunCall,ppArgs
-                    )
 import qualified Data.List
+import Data.Map.Lazy (Map)
+import qualified Data.Map.Lazy as Map
+import qualified Data.Maybe
 import qualified Data.Ord
+import Data.Set (Set)
+import qualified Data.Set as Set
+import IR (
+    Fields (..),
+    HFN (..),
+    Ident,
+    Identifier (..),
+    VarAccess (..),
+    ppArgs,
+    ppFunCall,
+    ppId,
+ )
+import Raw
+import RawDefUse (iDefUse)
+import RetCPS (VarName (..))
 
 import Debug.Trace
+
 --------------------------------------------------
---  substitutions for Raw 
+--  substitutions for Raw
 --------------------------------------------------
 newtype Subst = Subst (Map RawVar RawVar)
 
 class Substitutable a where
-  apply :: Subst -> a -> a
+    apply :: Subst -> a -> a
 
 idSubst :: Subst
 idSubst = Subst (Map.empty)
 
-
-
-
-instance Substitutable RawVar where 
+instance Substitutable RawVar where
     apply subst@(Subst varmap) x =
         Map.findWithDefault x x varmap
 
-instance Substitutable RawExpr where 
-  apply subst e = 
-    case e of 
-      Bin op use_native x y -> Bin op use_native  (apply subst x) (apply subst y)
-      Un op x -> Un op (apply subst x)
-      ListCons x y -> ListCons x (apply subst y)
-      WithRecord x fs -> WithRecord (apply subst x) fs 
-      ProjField x f -> ProjField (apply subst x) f
-      ProjIdx x n -> ProjIdx (apply subst x) n
-      ConstructLVal r1 r2 r3 -> 
-        ConstructLVal (apply subst r1) (apply subst r2) (apply subst r3)
-      _ -> e 
+instance Substitutable RawExpr where
+    apply subst e =
+        case e of
+            Bin op use_native x y -> Bin op use_native (apply subst x) (apply subst y)
+            Un op x -> Un op (apply subst x)
+            ListCons x y -> ListCons x (apply subst y)
+            WithRecord x fs -> WithRecord (apply subst x) fs
+            ProjField x f -> ProjField (apply subst x) f
+            ProjIdx x n -> ProjIdx (apply subst x) n
+            ConstructLVal r1 r2 r3 ->
+                ConstructLVal (apply subst r1) (apply subst r2) (apply subst r3)
+            _ -> e
 
 -- | Defining how to apply a substitution.
-instance Substitutable RawInst where 
-  apply subst i = 
-    case i of 
-      AssignRaw r1 r2 -> AssignRaw (apply subst r1) (apply subst r2)
-      SetState mc r -> SetState mc (apply subst r)
-      AssignLVal v e -> AssignLVal v (apply subst e)
-      RTAssertion a -> RTAssertion $ case a of
-        AssertType r t -> AssertType (apply subst r) t
-        -- AssertEqTypes ts r1 r2 -> AssertEqTypes ts (apply subst r1) (apply subst r2)
-        AssertTypesBothStringsOrBothNumbers r1 r2 -> AssertTypesBothStringsOrBothNumbers (apply subst r1) (apply subst r2)
-        AssertTupleLengthGreaterThan v n -> AssertTupleLengthGreaterThan (apply subst v) n
-        AssertRecordHasField v f -> AssertRecordHasField (apply subst v) f
-        AssertNotZero r -> AssertNotZero (apply subst r)
-      InvalidateSparseBit -> i
-      _ -> i
-
-instance Substitutable RawTerminator where 
-  apply subst tr = 
-    case tr of 
-      TailCall r -> TailCall (apply subst r) 
-      If r bb1 bb2 -> 
-        If (apply subst r) (apply subst bb1) (apply subst bb2)
-      Error r p -> Error (apply subst r) p 
-      Call bb1 bb2 -> Call (apply subst bb1) (apply subst bb2) 
-      _ -> tr
+instance Substitutable RawInst where
+    apply subst i =
+        case i of
+            AssignRaw r1 r2 -> AssignRaw (apply subst r1) (apply subst r2)
+            SetState mc r -> SetState mc (apply subst r)
+            AssignLVal v e -> AssignLVal v (apply subst e)
+            RTAssertion a -> RTAssertion $ case a of
+                AssertType r t -> AssertType (apply subst r) t
+                -- AssertEqTypes ts r1 r2 -> AssertEqTypes ts (apply subst r1) (apply subst r2)
+                AssertTypesBothStringsOrBothNumbers r1 r2 -> AssertTypesBothStringsOrBothNumbers (apply subst r1) (apply subst r2)
+                AssertTupleLengthGreaterThan v n -> AssertTupleLengthGreaterThan (apply subst v) n
+                AssertRecordHasField v f -> AssertRecordHasField (apply subst v) f
+                AssertNotZero r -> AssertNotZero (apply subst r)
+            InvalidateSparseBit -> i
+            _ -> i
+
+instance Substitutable RawTerminator where
+    apply subst tr =
+        case tr of
+            TailCall r -> TailCall (apply subst r)
+            If r bb1 bb2 ->
+                If (apply subst r) (apply subst bb1) (apply subst bb2)
+            Error r p -> Error (apply subst r) p
+            Call bb1 bb2 -> Call (apply subst bb1) (apply subst bb2)
+            _ -> tr
 
 instance Substitutable RawBBTree where
-  apply subst (BB ins tr) = 
-    BB (map (apply subst) ins) (apply subst tr)
-
+    apply subst (BB ins tr) =
+        BB (map (apply subst) ins) (apply subst tr)
 
--- end of substitutions 
+-- end of substitutions
 
 -- | Stores inferred information from the traversal.
-data PState = 
-    PState { stateMon   :: Map MonComponent RawVar,               -- monitor state 
-             stateLVals :: Map (VarName, LValField) RawVar,       -- lvalues 
-             stateJoins :: Map (RawVar, RawVar) RawVar,           -- computed joins
-             stateSubst :: Subst,
-             stateChange:: ChangeFlag,
-             stateRawVarTypes :: Map RawVar RawType,              -- for assertions optimizations
-             stateLValTypes :: Map VarName RawType                -- for assertions optimizations             
-           }
-
-
-data ReadEnv = 
-    ReadEnv { readConsts :: Map RawVar Core.Lit }
-           
-
--- 2021-02-28; AA 
--- As we traverse the AST we collect information about how 
--- different bindings are used. We distinguish two different 
+data PState
+    = PState
+    { stateMon :: Map MonComponent RawVar -- monitor state
+    , stateLVals :: Map (VarName, LValField) RawVar -- lvalues
+    , stateJoins :: Map (RawVar, RawVar) RawVar -- computed joins
+    , stateSubst :: Subst
+    , stateChange :: ChangeFlag
+    , stateRawVarTypes :: Map RawVar RawType -- for assertions optimizations
+    , stateLValTypes :: Map VarName RawType -- for assertions optimizations
+    }
+
+data ReadEnv
+    = ReadEnv {readConsts :: Map RawVar Core.Lit}
+
+-- 2021-02-28; AA
+-- As we traverse the AST we collect information about how
+-- different bindings are used. We distinguish two different
 -- used collections:
--- 
+--
 -- 1) used lvals,
--- 2) used rawvars, 
+-- 2) used rawvars,
 
--- 
-type Used = (Set VarName, Set RawVar) 
+--
+type Used = (Set VarName, Set RawVar)
 
 type ChangeFlag = Bool
 
 -- Optimization monad: keep track of used variables, to be able to eliminate unused variables.
 type Opt = RWS ReadEnv Used PState
 
-class PEval a where 
-    peval :: a -> Opt a 
-
-class MarkUsed a where 
-  markUsed :: a -> Opt ()
-
-instance MarkUsed VarName where 
-  markUsed vn = tell (Set.singleton vn, Set.empty)
-
-instance MarkUsed RawVar where 
-  markUsed rv = tell (Set.empty, Set.singleton rv)
-
-
-instance MarkUsed VarAccess where 
-  markUsed (VarLocal vn) = markUsed vn 
-  markUsed _ = return ()
-
-instance MarkUsed a => MarkUsed [a] where 
-  markUsed ls = mapM_ markUsed ls
-
-instance MarkUsed RawExpr where 
-  markUsed e = case e of 
-    Bin _ _ x y -> markUsed [x,y]
-    Un _ x -> markUsed x
-    ProjectLVal x _ -> markUsed x
-    ProjectState _ -> return ()
-    Tuple xs -> markUsed xs 
-    Record fields -> markUsed (snd (unzip fields))
-    WithRecord x fields -> do 
-      markUsed x 
-      markUsed (snd (unzip fields))
-    ProjField x _ -> markUsed x
-    ProjIdx x _ -> markUsed x
-    List xs -> markUsed xs
-    ListCons x y -> markUsed x >> markUsed y 
-    Const _ -> return ()
-    Lib _ _ -> return ()
-    Base _ -> return ()    
-    ConstructLVal x y z -> markUsed [x,y,z]
-
-
--- | Apply current substitution of RawVar to other RawVar.
--- use to keep track of which vars can be subst for each other, e.g. after "x=a"
-subst x = do 
-  s <- get 
-  return $ apply (stateSubst s) x
+class PEval a where
+    peval :: a -> Opt a
+
+class MarkUsed a where
+    markUsed :: a -> Opt ()
+
+instance MarkUsed VarName where
+    markUsed vn = tell (Set.singleton vn, Set.empty)
+
+instance MarkUsed RawVar where
+    markUsed rv = tell (Set.empty, Set.singleton rv)
+
+instance MarkUsed VarAccess where
+    markUsed (VarLocal vn) = markUsed vn
+    markUsed _ = return ()
+
+instance (MarkUsed a) => MarkUsed [a] where
+    markUsed ls = mapM_ markUsed ls
+
+instance MarkUsed RawExpr where
+    markUsed e = case e of
+        Bin _ _ x y -> markUsed [x, y]
+        Un _ x -> markUsed x
+        ProjectLVal x _ -> markUsed x
+        ProjectState _ -> return ()
+        Tuple xs -> markUsed xs
+        Record fields -> markUsed (snd (unzip fields))
+        WithRecord x fields -> do
+            markUsed x
+            markUsed (snd (unzip fields))
+        ProjField x _ -> markUsed x
+        ProjIdx x _ -> markUsed x
+        List xs -> markUsed xs
+        ListCons x y -> markUsed x >> markUsed y
+        Const _ -> return ()
+        Lib _ _ -> return ()
+        Base _ -> return ()
+        ConstructLVal x y z -> markUsed [x, y, z]
+
+{- | Apply current substitution of RawVar to other RawVar.
+use to keep track of which vars can be subst for each other, e.g. after "x=a"
+-}
+subst x = do
+    s <- get
+    return $ apply (stateSubst s) x
 
 -- | Remember that have to replace x with y.
-addSubst x y = do 
-  s <- get 
-  let (Subst m) = stateSubst s 
-  put $ s { stateSubst = Subst (Map.insert x y m)}
+addSubst x y = do
+    s <- get
+    let (Subst m) = stateSubst s
+    put $ s{stateSubst = Subst (Map.insert x y m)}
 
 -- | Remember that pc/block (first argument) can be found in variable r (second argument).
-monInsert p r = do 
-  s <- get 
-  let mon = Map.insert p r (stateMon s) 
-  put $ s {stateMon = mon}
+monInsert p r = do
+    s <- get
+    let mon = Map.insert p r (stateMon s)
+    put $ s{stateMon = mon}
 
 monLookup x s = Map.lookup x (stateMon s)
 
 typeOfLit :: Core.Lit -> Maybe RawType
-typeOfLit lit = 
-    case lit of 
-      Core.LUnit -> Just RawUnit
-      Core.LInt _ _ -> Just RawNumber 
-      Core.LString _ -> Just RawString
-      Core.LLabel _ -> Just RawLevel               
-      Core.LBool _ -> Just RawBoolean 
-      Core.LAtom _ -> Nothing
-      Core.LDCLabel _ -> Just RawDCLabel
-      
+typeOfLit lit =
+    case lit of
+        Core.LUnit -> Just RawUnit
+        Core.LInt _ _ -> Just RawNumber
+        Core.LString _ -> Just RawString
+        Core.LLabel _ -> Just RawLevel
+        Core.LBool _ -> Just RawBoolean
+        Core.LAtom _ -> Nothing
+        Core.LDCLabel _ -> Just RawDCLabel
 
 guessType :: RawExpr -> Maybe RawType
 guessType = \case
-  Const lit -> typeOfLit lit
-
-  Bin op _ _ _ -> case op of
-    Basics.Plus -> Just RawNumber
-    Basics.Minus -> Just RawNumber
-    Basics.Div -> Just RawNumber
-    Basics.Mult -> Just RawNumber
-    Basics.Mod -> Just RawNumber
-    Basics.BinAnd -> Just RawNumber
-    Basics.BinXor -> Just RawNumber
-    Basics.BinShiftLeft -> Just RawNumber
-    Basics.BinShiftRight -> Just RawNumber
-    Basics.BinZeroShiftRight -> Just RawNumber
-    Basics.Eq -> Just RawBoolean
-    Basics.Neq -> Just RawBoolean
-    Basics.Le -> Just RawBoolean
-    Basics.Lt -> Just RawBoolean
-    Basics.Ge -> Just RawBoolean
-    Basics.Gt -> Just RawBoolean
-    Basics.And -> Just RawBoolean
-    Basics.Or -> Just RawBoolean
-    Basics.HasField -> Just RawBoolean
-    Basics.Concat -> Just RawString
+    Const lit -> typeOfLit lit
+    Bin op _ _ _ -> case op of
+        Basics.Plus -> Just RawNumber
+        Basics.Minus -> Just RawNumber
+        Basics.Div -> Just RawNumber
+        Basics.Mult -> Just RawNumber
+        Basics.Mod -> Just RawNumber
+        Basics.BinAnd -> Just RawNumber
+        Basics.BinXor -> Just RawNumber
+        Basics.BinShiftLeft -> Just RawNumber
+        Basics.BinShiftRight -> Just RawNumber
+        Basics.BinZeroShiftRight -> Just RawNumber
+        Basics.Eq -> Just RawBoolean
+        Basics.Neq -> Just RawBoolean
+        Basics.Le -> Just RawBoolean
+        Basics.Lt -> Just RawBoolean
+        Basics.Ge -> Just RawBoolean
+        Basics.Gt -> Just RawBoolean
+        Basics.And -> Just RawBoolean
+        Basics.Or -> Just RawBoolean
+        Basics.HasField -> Just RawBoolean
+        Basics.Concat -> Just RawString
+        -- Revision 2023-08: Added missing cases
+        Basics.IntDiv -> Just RawNumber
+        Basics.BinOr -> Just RawNumber
+        Basics.FlowsTo -> Just RawBoolean
+        Basics.LatticeJoin -> Just RawLevel
+        Basics.LatticeMeet -> Just RawLevel
+        Basics.RaisedTo -> Nothing -- depends on operand type
+    Un op x -> case op of
+        Basics.ListLength -> Just RawNumber
+        Basics.TupleLength -> Just RawNumber
+        Basics.RecordSize -> Just RawNumber
+        Basics.UnMinus -> Just RawNumber
+        Basics.IsTuple -> Just RawBoolean
+        Basics.IsList -> Just RawBoolean
+        Basics.IsRecord -> Just RawBoolean
+        -- Revision 2023-08: Added missing cases
+        Basics.Fst -> Nothing
+        Basics.Snd -> Nothing
+        Basics.Head -> Nothing
+        Basics.Tail -> Nothing
+        Basics.LevelOf -> Just RawLevel
+    Tuple _ -> Just RawTuple
+    List _ -> Just RawList
+    ListCons _ _ -> Just RawList
+    Record _ -> Just RawRecord
+    WithRecord _ _ -> Just RawRecord
     -- Revision 2023-08: Added missing cases
-    Basics.IntDiv -> Just RawNumber
-    Basics.BinOr -> Just RawNumber
-    Basics.FlowsTo -> Just RawBoolean
-    Basics.LatticeJoin -> Just RawLevel
-    Basics.LatticeMeet -> Just RawLevel
-    Basics.RaisedTo -> Nothing -- depends on operand type
-
-  Un op x -> case op of
-    Basics.ListLength -> Just RawNumber
-    Basics.TupleLength -> Just RawNumber
-    Basics.RecordSize -> Just RawNumber
-    Basics.UnMinus -> Just RawNumber
-    Basics.IsTuple -> Just RawBoolean
-    Basics.IsList -> Just RawBoolean
-    Basics.IsRecord -> Just RawBoolean
-    -- Revision 2023-08: Added missing cases
-    Basics.Fst -> Nothing
-    Basics.Snd -> Nothing
-    Basics.Head -> Nothing
-    Basics.Tail -> Nothing
-    Basics.LevelOf -> Just RawLevel
-
-  Tuple _ -> Just RawTuple
-  List _ -> Just RawList
-  ListCons _ _ -> Just RawList
-  Record _ -> Just RawRecord
-  WithRecord _ _  -> Just RawRecord
-  -- Revision 2023-08: Added missing cases
-  ProjField _ _ -> Nothing
-  ProjIdx _ _ -> Nothing
-  ProjectLVal VarFunSelfRef FieldValue -> Just RawFunction
-  ProjectLVal _ FieldValLev -> Just RawLevel
-  ProjectLVal _ FieldTypLev -> Just RawLevel
-  ProjectLVal _ FieldValue -> Nothing
-  ProjectState MonPC -> Just RawLevel
-  ProjectState MonBlock -> Just RawLevel
-  ProjectState R0_Lev -> Just RawLevel
-  ProjectState R0_TLev -> Just RawLevel
-  ProjectState R0_Val -> Nothing
-  Lib _ _ -> Nothing
-  Base _ -> Nothing
-  ConstructLVal _ _ _ -> Nothing
-
-_setRawType x t = modify (\pstate -> 
-          pstate { stateRawVarTypes = Map.insert x t (stateRawVarTypes pstate)})
-
-_setLValType x t = modify (\pstate -> 
-          pstate { stateLValTypes = Map.insert x t (stateLValTypes pstate)})
+    ProjField _ _ -> Nothing
+    ProjIdx _ _ -> Nothing
+    ProjectLVal VarFunSelfRef FieldValue -> Just RawFunction
+    ProjectLVal _ FieldValLev -> Just RawLevel
+    ProjectLVal _ FieldTypLev -> Just RawLevel
+    ProjectLVal _ FieldValue -> Nothing
+    ProjectState MonPC -> Just RawLevel
+    ProjectState MonBlock -> Just RawLevel
+    ProjectState R0_Lev -> Just RawLevel
+    ProjectState R0_TLev -> Just RawLevel
+    ProjectState R0_Val -> Nothing
+    Lib _ _ -> Nothing
+    Base _ -> Nothing
+    ConstructLVal _ _ _ -> Nothing
+
+_setRawType x t =
+    modify
+        ( \pstate ->
+            pstate{stateRawVarTypes = Map.insert x t (stateRawVarTypes pstate)}
+        )
+
+_setLValType x t =
+    modify
+        ( \pstate ->
+            pstate{stateLValTypes = Map.insert x t (stateLValTypes pstate)}
+        )
 
 -- Partially evaluate instruction. This is called multiple times in the optimization sequence.
 -- First pass: partially evaluate functions (instructions).
 -- Removes e.g. redundant state projections state (e.g. if multiple in same block).
--- 
-pevalInst:: RawInst -> Opt [RawInst]
-pevalInst i = do 
+--
+pevalInst :: RawInst -> Opt [RawInst]
+pevalInst i = do
     pstate <- get
     i' <- subst i -- apply the collected substitutions
     let _omit x = x >> return []
     let _keep x = x >> return [i']
-             
-    case i' of 
-      AssignRaw r (ProjectState p) -> do
-        case monLookup p pstate of -- lookup the known state of the monitor component
-          Just r' -> _omit $ addSubst r r' -- The state can already be found in r', therefore the assignment to r can be omitted, and we have to remember to substitute r with r'.
-          Nothing -> _keep $ monInsert p r -- remember that PC/block can be found in variable r
-      AssignRaw r (Bin Basics.LatticeJoin (UseNativeBinop False) x y) -> do 
-        if x == y then _omit (addSubst r x) -- trivial join
-        else do
-          case Map.lookup (x,y) (stateJoins pstate) of 
-            Just r' -> _omit $ addSubst r r'
-            Nothing -> case Map.lookup (y,x) (stateJoins pstate) of
-              Just r' -> _omit $ addSubst r r'
-              Nothing -> _keep $ do 
-                markUsed [x,y] 
-                put $ pstate { stateJoins = Map.insert (x,y) r (stateJoins pstate) }
-              
-      AssignLVal v (ConstructLVal r1 r2 r3) -> _keep $ do
-        markUsed [r1, r2, r3]
-        
-        
-        let m0 = stateLVals pstate
-        let m1 = Map.insert (v, FieldValue) r1 m0
-        let m2 = Map.insert (v, FieldValLev) r2 m1 
-        let m3 = Map.insert (v, FieldTypLev) r3 m2        
-        put $ pstate { stateLVals = m3 }        
-      AssignRaw r (ProjectLVal (VarLocal v) field) -> do        
-        case (Map.lookup (v, field) (stateLVals pstate)) of           
-          Just r' -> _omit $ addSubst r r'             
-          Nothing -> _keep $ do 
-            markUsed v
-            let m0 = stateLVals pstate 
-            let m1 = Map.insert (v, field) r m0 
-            put $ pstate { stateLVals = m1 }
-
-            -- 2025-07-31; now also examine the type information 
-            -- which is useful for booleans 
-            case (Map.lookup v (stateLValTypes pstate)) of 
-              Nothing -> return ()
-              Just t  -> _setRawType r t
-
-      AssignRaw r rexpr -> _keep $ do
-        markUsed rexpr 
-        case guessType rexpr of 
-            Nothing -> return ()
-            Just ty -> _setRawType r ty 
-
-      AssignLVal v complexExpr@(Bin op (UseNativeBinop False) r1 r2) 
-          | op `elem` [Basics.Eq, Basics.Neq] -> do
+
+    case i' of
+        AssignRaw r (ProjectState p) -> do
+            case monLookup p pstate of -- lookup the known state of the monitor component
+                Just r' -> _omit $ addSubst r r' -- The state can already be found in r', therefore the assignment to r can be omitted, and we have to remember to substitute r with r'.
+                Nothing -> _keep $ monInsert p r -- remember that PC/block can be found in variable r
+        AssignRaw r (Bin Basics.LatticeJoin (UseNativeBinop False) x y) -> do
+            if x == y
+                then _omit (addSubst r x) -- trivial join
+                else do
+                    case Map.lookup (x, y) (stateJoins pstate) of
+                        Just r' -> _omit $ addSubst r r'
+                        Nothing -> case Map.lookup (y, x) (stateJoins pstate) of
+                            Just r' -> _omit $ addSubst r r'
+                            Nothing -> _keep $ do
+                                markUsed [x, y]
+                                put $ pstate{stateJoins = Map.insert (x, y) r (stateJoins pstate)}
+        AssignLVal v (ConstructLVal r1 r2 r3) -> _keep $ do
+            markUsed [r1, r2, r3]
+
+            let m0 = stateLVals pstate
+            let m1 = Map.insert (v, FieldValue) r1 m0
+            let m2 = Map.insert (v, FieldValLev) r2 m1
+            let m3 = Map.insert (v, FieldTypLev) r3 m2
+            put $ pstate{stateLVals = m3}
+        AssignRaw r (ProjectLVal (VarLocal v) field) -> do
+            case (Map.lookup (v, field) (stateLVals pstate)) of
+                Just r' -> _omit $ addSubst r r'
+                Nothing -> _keep $ do
+                    markUsed v
+                    let m0 = stateLVals pstate
+                    let m1 = Map.insert (v, field) r m0
+                    put $ pstate{stateLVals = m1}
+
+                    -- 2025-07-31; now also examine the type information
+                    -- which is useful for booleans
+                    case (Map.lookup v (stateLValTypes pstate)) of
+                        Nothing -> return ()
+                        Just t -> _setRawType r t
+        AssignRaw r rexpr -> _keep $ do
+            markUsed rexpr
+            case guessType rexpr of
+                Nothing -> return ()
+                Just ty -> _setRawType r ty
+        AssignLVal v complexExpr@(Bin op (UseNativeBinop False) r1 r2)
+            | op `elem` [Basics.Eq, Basics.Neq] -> do
                 _setLValType v RawBoolean
                 a <- isSuitableForNativeEq r1
                 b <- isSuitableForNativeEq r2
-                if  a || b 
-                  then do 
-                    let VN s = v 
-                        r3 = RawVar $ s ++ "$val_opt"
-                        r4 = RawVar $ s ++ "$vlev_opt"
-                        r5 = RawVar $ s ++ "$tlev_opt"
-                    markUsed v 
-                    markUsed [r1, r2, r3, r4, r5]
-                    return $
-                      [ AssignRaw r3 (Bin op (UseNativeBinop True) r1 r2)
-                      , AssignRaw r4 (ProjectState MonPC)
-                      , AssignRaw r5 (ProjectState MonPC)
-                      , AssignLVal v (ConstructLVal r3 r4 r5)
-                      ]
-                  else 
-                    _keep $ markUsed complexExpr
-
-
-      AssignLVal v complexExpr -> 
-        _keep $ markUsed complexExpr
-
-      SetState p r -> _keep $ do 
-        markUsed r
-        monInsert p r        
-      RTAssertion (AssertType r rt) -> do 
-        case Map.lookup r (stateRawVarTypes pstate) of 
-          Just rt' | rt' == rt -> return []
-          _ -> _keep $ _setRawType r rt >> markUsed r        
-      -- RTAssertion (AssertEqTypes opt_ls x y) -> do
-      --   let _m = stateTypes pstate
-      --   let keep = _keep $ markUsed [x,y]
-      --   case (Map.lookup x _m, Map.lookup y _m) of
-      --     (Just t1 , Just t2) | t1 == t2 ->
-      --       case opt_ls of
-      --         Nothing -> return Nothing
-      --         Just (List2OrMore p1 p2 ps) ->
-      --           if t1 `elem` (p1:p2:ps) then
-      --             return Nothing
-      --           else keep
-      --     _ -> keep
-      RTAssertion (AssertTypesBothStringsOrBothNumbers x y) -> do 
-        let _m = stateRawVarTypes pstate 
-        let keep = _keep $ markUsed [x,y]
-        case (Map.lookup x _m, Map.lookup y _m) of 
-          (Just t1 , Just t2) | t1 == t2 -> 
-            if t1 `elem` [RawNumber, RawString]
-            then return []
-            else keep
-          _ -> keep
-      -- TODO track tuple length
-      RTAssertion (AssertTupleLengthGreaterThan r n) -> _keep $ markUsed r
-      -- TODO track record fields
-      RTAssertion (AssertRecordHasField r f) -> _keep $ markUsed r
-      RTAssertion (AssertNotZero r) -> do
-         renv <- ask 
-         case Map.lookup r (readConsts renv) of 
-           Just (Core.LInt x _) | x /= 0 -> return []
-           _ -> _keep $ markUsed r
-      MkFunClosures ee _ -> _keep $ markUsed (snd (unzip ee)) 
-      -- No applicable optimizations.
-      SetBranchFlag -> return [i']
-      InvalidateSparseBit -> return [i']
-
-
-isSuitableForNativeEq r = do 
-  pstate <- get
-  return $ 
-    case Map.lookup r (stateRawVarTypes pstate) of 
-      Nothing -> False 
-      Just t -> case t of 
-          RawNumber -> True 
-          RawString -> True 
-          _ -> False 
-
+                if a || b
+                    then do
+                        let VN s = v
+                            r3 = RawVar $ s ++ "$val_opt"
+                            r4 = RawVar $ s ++ "$vlev_opt"
+                            r5 = RawVar $ s ++ "$tlev_opt"
+                        markUsed v
+                        markUsed [r1, r2, r3, r4, r5]
+                        return $
+                            [ AssignRaw r3 (Bin op (UseNativeBinop True) r1 r2)
+                            , AssignRaw r4 (ProjectState MonPC)
+                            , AssignRaw r5 (ProjectState MonPC)
+                            , AssignLVal v (ConstructLVal r3 r4 r5)
+                            ]
+                    else
+                        _keep $ markUsed complexExpr
+        AssignLVal v complexExpr ->
+            _keep $ markUsed complexExpr
+        SetState p r -> _keep $ do
+            markUsed r
+            monInsert p r
+        RTAssertion (AssertType r rt) -> do
+            case Map.lookup r (stateRawVarTypes pstate) of
+                Just rt' | rt' == rt -> return []
+                _ -> _keep $ _setRawType r rt >> markUsed r
+        -- RTAssertion (AssertEqTypes opt_ls x y) -> do
+        --   let _m = stateTypes pstate
+        --   let keep = _keep $ markUsed [x,y]
+        --   case (Map.lookup x _m, Map.lookup y _m) of
+        --     (Just t1 , Just t2) | t1 == t2 ->
+        --       case opt_ls of
+        --         Nothing -> return Nothing
+        --         Just (List2OrMore p1 p2 ps) ->
+        --           if t1 `elem` (p1:p2:ps) then
+        --             return Nothing
+        --           else keep
+        --     _ -> keep
+        RTAssertion (AssertTypesBothStringsOrBothNumbers x y) -> do
+            let _m = stateRawVarTypes pstate
+            let keep = _keep $ markUsed [x, y]
+            case (Map.lookup x _m, Map.lookup y _m) of
+                (Just t1, Just t2)
+                    | t1 == t2 ->
+                        if t1 `elem` [RawNumber, RawString]
+                            then return []
+                            else keep
+                _ -> keep
+        -- TODO track tuple length
+        RTAssertion (AssertTupleLengthGreaterThan r n) -> _keep $ markUsed r
+        -- TODO track record fields
+        RTAssertion (AssertRecordHasField r f) -> _keep $ markUsed r
+        RTAssertion (AssertNotZero r) -> do
+            renv <- ask
+            case Map.lookup r (readConsts renv) of
+                Just (Core.LInt x _) | x /= 0 -> return []
+                _ -> _keep $ markUsed r
+        MkFunClosures ee _ -> _keep $ markUsed (snd (unzip ee))
+        -- No applicable optimizations.
+        SetBranchFlag -> return [i']
+        InvalidateSparseBit -> return [i']
+
+isSuitableForNativeEq r = do
+    pstate <- get
+    return $
+        case Map.lookup r (stateRawVarTypes pstate) of
+            Nothing -> False
+            Just t -> case t of
+                RawNumber -> True
+                RawString -> True
+                _ -> False
 
 instance PEval RawTerminator where
-  peval tr = do 
-    tr' <- subst tr -- todo: obs complexity :( 2021-02-23; AA
-    case tr' of 
-      If x bb1 bb2 -> do
-        markUsed x
-        s <- get
-        bb1' <- peval bb1
-        -- undo stateful effects before switching to another branch
-        put $ s { stateMon = stateMon s
-                , stateLVals = stateLVals s
-                , stateJoins = stateJoins s
-                }
-        bb2' <- peval bb2         
-        return $ If x bb1' bb2'
-      Call bb1 bb2 -> do
-        s <- get
-        bb1' <- peval bb1
-        put $ s { stateMon = Map.empty
-                , stateLVals = stateLVals s
-                , stateJoins = stateJoins s 
-                } -- reset the monitor state
-        bb2' <- peval bb2
-        return $ Call bb1' bb2'
-      Ret -> do 
-        return tr' 
-      TailCall x -> do 
-        markUsed x
-        return tr' 
-      Error x _ -> do 
-        markUsed x 
-        return tr'
-      LibExport x -> do
-        markUsed x 
-        return tr'
-      
-  
-isLiveInstFwd :: Used -> RawInst -> Bool
-isLiveInstFwd (lvals, rvars) i = 
-  case i of
-    AssignRaw r _ -> Set.member r rvars 
-    AssignLVal v _ -> Set.member v lvals 
-    _ -> True
+    peval tr = do
+        tr' <- subst tr -- todo: obs complexity :( 2021-02-23; AA
+        case tr' of
+            If x bb1 bb2 -> do
+                markUsed x
+                s <- get
+                bb1' <- peval bb1
+                -- undo stateful effects before switching to another branch
+                put $
+                    s
+                        { stateMon = stateMon s
+                        , stateLVals = stateLVals s
+                        , stateJoins = stateJoins s
+                        }
+                bb2' <- peval bb2
+                return $ If x bb1' bb2'
+            Call bb1 bb2 -> do
+                s <- get
+                bb1' <- peval bb1
+                put $
+                    s
+                        { stateMon = Map.empty
+                        , stateLVals = stateLVals s
+                        , stateJoins = stateJoins s
+                        } -- reset the monitor state
+                bb2' <- peval bb2
+                return $ Call bb1' bb2'
+            Ret -> do
+                return tr'
+            TailCall x -> do
+                markUsed x
+                return tr'
+            Error x _ -> do
+                markUsed x
+                return tr'
+            LibExport x -> do
+                markUsed x
+                return tr'
 
+isLiveInstFwd :: Used -> RawInst -> Bool
+isLiveInstFwd (lvals, rvars) i =
+    case i of
+        AssignRaw r _ -> Set.member r rvars
+        AssignLVal v _ -> Set.member v lvals
+        _ -> True
 
 filterInstBwd :: [RawInst] -> ([RawInst], [RawInst])
-filterInstBwd ls = 
-  let f (pc, bl) (i:is) acc = 
-        case i of 
-          SetState MonPC _ -> 
-            if pc /= Nothing
-                  then f (pc, bl) is acc
-                  else f (Just i, bl) is acc
-          SetState MonBlock _ -> 
-            if bl /= Nothing 
-                  then f (pc, bl) is acc 
-                  else f (pc, Just i) is acc
-          _ -> f (pc, bl) is (i:acc)
-      f (pc, bl) [] acc = 
-        let fromJ (Just x) = [x]
-            fromJ Nothing = []
-         in (acc, concat $ map fromJ [pc, bl]) in 
-  f (Nothing, Nothing) (reverse ls) []
-
-
--- | This optimization for 'Call' moves instructions from the continuation to before the 'Call'.
--- This can result in a 'Call' which just contains a 'Ret', which is then optimized away.
--- The optimization compensates for redundant assignments introduced by the translation.
+filterInstBwd ls =
+    let f (pc, bl) (i : is) acc =
+            case i of
+                SetState MonPC _ ->
+                    if pc /= Nothing
+                        then f (pc, bl) is acc
+                        else f (Just i, bl) is acc
+                SetState MonBlock _ ->
+                    if bl /= Nothing
+                        then f (pc, bl) is acc
+                        else f (pc, Just i) is acc
+                _ -> f (pc, bl) is (i : acc)
+        f (pc, bl) [] acc =
+            let fromJ (Just x) = [x]
+                fromJ Nothing = []
+             in (acc, concat $ map fromJ [pc, bl])
+     in f (Nothing, Nothing) (reverse ls) []
+
+{- | This optimization for 'Call' moves instructions from the continuation to before the 'Call'.
+This can result in a 'Call' which just contains a 'Ret', which is then optimized away.
+The optimization compensates for redundant assignments introduced by the translation.
+-}
 hoistCalls :: RawBBTree -> RawBBTree
-hoistCalls bb@(BB insts tr) = 
-  case tr of 
-    -- Here we check which instructions from ii_1 can be moved to before the call
-    Call (BB ii_1 tr_1) bb2 ->
-      let isFrameSpecific i = 
-            case i of 
-              SetBranchFlag -> True
-              SetState _ _ -> True 
-              InvalidateSparseBit -> True -- to be safe, we define this frame-specific
-              _ -> False
-          -- jx_1: non-frame-specific instructions, are moved to before the call
-          -- jx_2: frame-specific instructions, stay under the call's instructions
-          (jx_1, jx_2)  = Data.List.break isFrameSpecific ii_1  
-      in BB (insts ++ jx_1) (Call (BB jx_2 tr_1) bb2) 
-    -- If returning, the current frame will be removed, and thus all PC set instructions
-    -- are redundant and can be removed.
-    Ret -> 
-      let isNotPcSet (SetState MonPC _) = False
-          isNotPcSet _ = True 
-          insts_wo_PCUpd = filter isNotPcSet insts
-      in BB insts_wo_PCUpd tr
-    
-    _ -> bb
-  
+hoistCalls bb@(BB insts tr) =
+    case tr of
+        -- Here we check which instructions from ii_1 can be moved to before the call
+        Call (BB ii_1 tr_1) bb2 ->
+            let isFrameSpecific i =
+                    case i of
+                        SetBranchFlag -> True
+                        SetState _ _ -> True
+                        InvalidateSparseBit -> True -- to be safe, we define this frame-specific
+                        _ -> False
+                -- jx_1: non-frame-specific instructions, are moved to before the call
+                -- jx_2: frame-specific instructions, stay under the call's instructions
+                (jx_1, jx_2) = Data.List.break isFrameSpecific ii_1
+             in BB (insts ++ jx_1) (Call (BB jx_2 tr_1) bb2)
+        -- If returning, the current frame will be removed, and thus all PC set instructions
+        -- are redundant and can be removed.
+        Ret ->
+            let isNotPcSet (SetState MonPC _) = False
+                isNotPcSet _ = True
+                insts_wo_PCUpd = filter isNotPcSet insts
+             in BB insts_wo_PCUpd tr
+        _ -> bb
+
 instOrder ii = work [] ii
- where 
-  work accum [] = reverse accum
-  work accum [i] = work (i:accum) [] 
-  work accum (i1:i2:insts) = 
-    let (defs1, _) = iDefUse i1 
-        (_, uses2) = iDefUse i2 
-        reshuffle =
-          Set.size (Set.intersection defs1 uses2) == 0  
-          && case (instructionType i1, instructionType i2) of 
-                (LabelSpecificInstruction, RegularInstruction RegDestructor) -> True 
-                (LabelSpecificInstruction, RegularInstruction RegOther) -> True 
-                (RegularInstruction RegConstructor, LabelSpecificInstruction) -> True
-                _ -> False
-    in if reshuffle then 
-         case accum of 
-            p : prevs -> 
-              work prevs (p:i2:i1:insts)
-            [] -> 
-              work [i2] (i1:insts)
-       else 
-         work (i1:accum) (i2:insts)
+  where
+    work accum [] = reverse accum
+    work accum [i] = work (i : accum) []
+    work accum (i1 : i2 : insts) =
+        let (defs1, _) = iDefUse i1
+            (_, uses2) = iDefUse i2
+            reshuffle =
+                Set.size (Set.intersection defs1 uses2) == 0
+                    && case (instructionType i1, instructionType i2) of
+                        (LabelSpecificInstruction, RegularInstruction RegDestructor) -> True
+                        (LabelSpecificInstruction, RegularInstruction RegOther) -> True
+                        (RegularInstruction RegConstructor, LabelSpecificInstruction) -> True
+                        _ -> False
+         in if reshuffle
+                then case accum of
+                    p : prevs ->
+                        work prevs (p : i2 : i1 : insts)
+                    [] ->
+                        work [i2] (i1 : insts)
+                else
+                    work (i1 : accum) (i2 : insts)
 
+instance PEval RawBBTree where
+    peval bb@(BB insts tr) = do
+        (BB jj tr'', used) <- listen $ do
+            ii <- concat <$> mapM pevalInst insts
+            tr' <- peval tr
+            return $ BB ii tr'
+        let (insts_no_ret, set_pc_bl) = filterInstBwd (filter (isLiveInstFwd used) jj)
+        let BB insts_ bb_ =
+                case tr'' of
+                    If x (BB i_then tr_then) (BB i_else tr_else) ->
+                        BB insts_no_ret $
+                            If
+                                x
+                                (BB (set_pc_bl ++ i_then) tr_then)
+                                (BB (set_pc_bl ++ i_else) tr_else)
+                    _ -> hoistCalls $ BB (insts_no_ret ++ set_pc_bl) tr''
+        let insts_sorted = instOrder insts_
+        return $ BB insts_sorted bb_
+
+funopt :: FunDef -> FunDef
+funopt (FunDef hfn consts bb ir) =
+    let (m_consts, m_subst) =
+            foldl
+                ( \(m1, m2) (x, lit) ->
+                    case Map.lookup lit m1 of
+                        Just r -> (m1, Map.insert x r m2)
+                        Nothing -> (Map.insert lit x m1, m2)
+                )
+                (Map.empty, Map.empty)
+                consts
+
+        (consts', constTypes) =
+            Map.foldrWithKey
+                ( \lit x (acc, m) ->
+                    let new_acc = (x, lit) : acc
+                        new_m = case typeOfLit lit of
+                            Just t -> Map.insert x t m
+                            Nothing -> m
+                     in (new_acc, new_m)
+                )
+                ([], Map.empty)
+                m_consts
+
+        constTypes_obs =
+            foldl
+                ( \m (x, lit) ->
+                    case typeOfLit lit of
+                        Just t -> Map.insert x t m
+                        Nothing -> m
+                )
+                Map.empty
+                consts
+
+        pstate =
+            PState
+                { stateMon = Map.empty
+                , stateLVals = Map.empty
+                , stateJoins = Map.empty
+                , stateSubst = Subst (m_subst)
+                , stateChange = False
+                , stateRawVarTypes = constTypes
+                , stateLValTypes = Map.empty
+                }
 
+        readenv = ReadEnv{readConsts = Map.fromList consts}
+        (bb', _, (_, used_rvars)) = runRWS (peval bb) readenv pstate
+        const_used = filter (\(x, _) -> Set.member x used_rvars) consts'
+        new = FunDef hfn const_used bb' ir
+     in if bb /= bb' then funopt new else new
 
-instance PEval RawBBTree where
-  peval bb@(BB insts tr) = do 
-    (BB jj tr'', used) <- listen $ do 
-        ii <- concat <$> mapM pevalInst insts
-        tr' <- peval tr 
-        return $ BB ii tr'
-    let (insts_no_ret, set_pc_bl) = filterInstBwd (filter (isLiveInstFwd used) jj)
-    let BB insts_ bb_ =
-          case tr'' of 
-            If x (BB i_then tr_then) (BB i_else tr_else) -> 
-              BB insts_no_ret $ 
-                If x (BB (set_pc_bl ++ i_then) tr_then) 
-                     (BB (set_pc_bl ++ i_else) tr_else)
- 
-            _ -> hoistCalls $ BB (insts_no_ret ++ set_pc_bl) tr''
-    let insts_sorted = instOrder insts_ 
-    return $ BB insts_sorted bb_
-  
-
-
-funopt :: FunDef -> FunDef 
-funopt (FunDef hfn consts bb ir) =  
-  
-  let 
-      (m_consts, m_subst) = foldl (\(m1, m2) (x,lit) -> 
-            case Map.lookup lit m1 of 
-                Just r -> (m1, Map.insert x r m2 )
-                Nothing -> (Map.insert lit x m1, m2 )
-            ) (Map.empty, Map.empty) consts
-
-      (consts', constTypes) = Map.foldrWithKey (\lit x (acc,m) ->
-              let new_acc = (x, lit) : acc
-                  new_m = case typeOfLit lit of 
-                            Just t -> Map.insert x t m 
-                            Nothing -> m   
-              in (new_acc, new_m))
-              ([],Map.empty)
-              m_consts
-
-      constTypes_obs = foldl (\m (x, lit)  -> 
-                              case typeOfLit lit of 
-                                 Just t -> Map.insert x t m
-                                 Nothing -> m 
-                          ) Map.empty consts 
-
-      pstate = PState {stateMon = Map.empty, 
-                       stateLVals = Map.empty,
-                       stateJoins = Map.empty,
-                       stateSubst = Subst (m_subst),
-                       stateChange = False,
-                       stateRawVarTypes = constTypes,
-                       stateLValTypes = Map.empty
-                       }
-      
-      readenv = ReadEnv { readConsts = Map.fromList consts  }
-      (bb', _, (_, used_rvars)) = runRWS (peval bb) readenv pstate
-      const_used = filter (\(x,_) -> Set.member x used_rvars) consts'
-      new = FunDef hfn const_used bb' ir  
-  in if bb /= bb' then funopt new else new
-
-
-
-class RawOptable a where 
-  rawopt :: a -> a 
-
-
-instance RawOptable RawProgram where   
-  rawopt (RawProgram atoms fdefs) = 
-      RawProgram (rawopt atoms)  (map rawopt fdefs)
-
-instance RawOptable FunDef where 
-  rawopt = funopt 
-
-instance RawOptable Core.Atoms where 
-  rawopt = id 
-
-instance RawOptable RawUnit where 
-  rawopt (FunRawUnit f) = FunRawUnit (rawopt f)
-  rawopt (AtomRawUnit c) = AtomRawUnit (rawopt c)
-  rawopt (ProgramRawUnit p) = ProgramRawUnit (rawopt p)
+class RawOptable a where
+    rawopt :: a -> a
+
+instance RawOptable RawProgram where
+    rawopt (RawProgram atoms fdefs) =
+        RawProgram (rawopt atoms) (map rawopt fdefs)
+
+instance RawOptable FunDef where
+    rawopt = funopt
+
+instance RawOptable Core.Atoms where
+    rawopt = id
+
+instance RawOptable RawUnit where
+    rawopt (FunRawUnit f) = FunRawUnit (rawopt f)
+    rawopt (AtomRawUnit c) = AtomRawUnit (rawopt c)
+    rawopt (ProgramRawUnit p) = ProgramRawUnit (rawopt p)
diff --git a/compiler/src/RetCPS.hs b/compiler/src/RetCPS.hs
index 15cec1e4..f05a49e1 100644
--- a/compiler/src/RetCPS.hs
+++ b/compiler/src/RetCPS.hs
@@ -1,38 +1,42 @@
+{-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveTraversable #-}
 
 module RetCPS
 where
 
-import GHC.Generics
 import qualified Data.Serialize as Serialize
+import GHC.Generics
 
-import Basics(BinOp(..),UnaryOp(..),Precedence, opPrec)
+import Basics (BinOp (..), Precedence, UnaryOp (..), opPrec)
 import qualified Basics
-import qualified Core as C
 import Core (ppLit)
-import qualified Text.PrettyPrint.HughesPJ as PP
+import qualified Core as C
+import ShowIndent
 import Text.PrettyPrint.HughesPJ (
-    (<+>), ($$), text, hsep, vcat, nest)
-import           ShowIndent
+    hsep,
+    nest,
+    text,
+    vcat,
+    ($$),
+    (<+>),
+ )
+import qualified Text.PrettyPrint.HughesPJ as PP
 
 import TroupePositionInfo
 
 newtype VarName = VN Basics.VarName
-    deriving (Eq, Ord, Generic)
-
+    deriving (Eq, Generic, Ord)
 
 instance Serialize.Serialize VarName
 instance Show VarName where
-  show (VN x) = show x
+    show (VN x) = show x
 
 -- newtype KontName = K Basics.VarName deriving (Eq,Ord)
 -- instance Show KontName where
 --  show (K k) = "K" ++ k
 
-
 {--
 
 The language here is only the "surface-level" CPS, i.e., it does not contain any
@@ -41,35 +45,36 @@ doing that from this language
 
  -}
 
-data KLambda = Unary VarName KTerm
-             | Nullary KTerm
-  deriving (Eq, Show, Ord)
+data KLambda
+    = Unary VarName KTerm
+    | Nullary KTerm
+    deriving (Eq, Ord, Show)
 
 data SVal
-   = KAbs KLambda
-   | Lit C.Lit
-     deriving (Eq, Show, Ord)
+    = KAbs KLambda
+    | Lit C.Lit
+    deriving (Eq, Ord, Show)
 
 data ContDef = Cont VarName KTerm
-               deriving (Eq, Ord)
+    deriving (Eq, Ord)
 data FunDef = Fun VarName KLambda
-              deriving (Eq, Ord)
+    deriving (Eq, Ord)
 
 type Fields = [(Basics.FieldName, VarName)]
 data SimpleTerm
-   = Bin BinOp VarName VarName
-   | Un UnaryOp VarName
-   | ValSimpleTerm SVal
-   | Tuple [VarName]
-   | Record Fields 
-   | WithRecord VarName Fields
-   | ProjField VarName Basics.FieldName
-   | ProjIdx VarName Word
-   | List [VarName]
-   | ListCons VarName VarName
-   | Base Basics.VarName
-   | Lib Basics.LibName Basics.VarName
-     deriving (Eq, Show, Ord)
+    = Bin BinOp VarName VarName
+    | Un UnaryOp VarName
+    | ValSimpleTerm SVal
+    | Tuple [VarName]
+    | Record Fields
+    | WithRecord VarName Fields
+    | ProjField VarName Basics.FieldName
+    | ProjIdx VarName Word
+    | List [VarName]
+    | ListCons VarName VarName
+    | Base Basics.VarName
+    | Lib Basics.LibName Basics.VarName
+    deriving (Eq, Ord, Show)
 
 data KTerm
     = LetSimple VarName SimpleTerm KTerm
@@ -84,45 +89,46 @@ data KTerm
     -- ; aa; 2018-07-02; bringing Halt back because
     -- of exports
 
-      deriving (Eq, Ord)
+    deriving (Eq, Ord)
 
 data Prog = Prog C.Atoms KTerm
-  deriving (Eq, Show)
+    deriving (Eq, Show)
 
 --------------------------------------------------
 -- show is defined via pretty printing
-instance Show KTerm
-  where show t = PP.render (ppKTerm 0 t)
+instance Show KTerm where
+    show t = PP.render (ppKTerm 0 t)
 
-instance Show ContDef 
-  where show (Cont x t) = PP.render ( ppKTerm 0 t)
+instance Show ContDef where
+    show (Cont x t) = PP.render (ppKTerm 0 t)
 instance ShowIndent Prog where
-  showIndent k p = PP.render (nest k (ppProg p))
+    showIndent k p = PP.render (nest k (ppProg p))
+
 --------------------------------------------------
 -- obs: these functions are not exported
 --
 
 ppProg :: Prog -> PP.Doc
 ppProg (Prog (C.Atoms atoms) kterm) =
-  let ppAtoms =
-        if null atoms
-          then PP.empty
-          else (text "datatype Atoms = ") <+>
-               (hsep $ PP.punctuate (text " |") (map text atoms))
-  in ppAtoms $$ ppKTerm 0 kterm
+    let ppAtoms =
+            if null atoms
+                then PP.empty
+                else
+                    (text "datatype Atoms = ")
+                        <+> (hsep $ PP.punctuate (text " |") (map text atoms))
+     in ppAtoms $$ ppKTerm 0 kterm
 
 ppKTerm :: Precedence -> KTerm -> PP.Doc
-
 ppKTerm parentPrec t =
-   let thisTermPrec = 1000
-   in PP.maybeParens (thisTermPrec < parentPrec   )  $ ppKTerm' t
+    let thisTermPrec = 1000
+     in PP.maybeParens (thisTermPrec < parentPrec) $ ppKTerm' t
 
-   -- uncomment to pretty print explicitly; 2017-10-14: AA
-   -- in PP.maybeParens (thisTermPrec < 10000)  $ ppTerm'       Core.LAtom _ -> Nothingt
+-- uncomment to pretty print explicitly; 2017-10-14: AA
+-- in PP.maybeParens (thisTermPrec < 10000)  $ ppTerm'       Core.LAtom _ -> Nothingt
 
 -- ppLit :: C.Lit -> PP.Doc
--- ppLit = C.ppLit 
--- ppLit  (C.LInt i pi) = PP.integer i 
+-- ppLit = C.ppLit
+-- ppLit  (C.LInt i pi) = PP.integer i
 -- ppLit  (C.LString s)   = PP.doubleQuotes (text s)
 -- ppLit  (C.LLabel s)    = PP.braces (text s)
 -- ppLit  (C.LUnit) = text "()"
@@ -133,57 +139,54 @@ ppKTerm parentPrec t =
 textv (VN x) = text x
 
 ppSimpleTerm :: SimpleTerm -> PP.Doc
-ppSimpleTerm (Bin op (VN v1)  (VN v2)) =
-  text v1 <+> text (show op) <+> text v2
+ppSimpleTerm (Bin op (VN v1) (VN v2)) =
+    text v1 <+> text (show op) <+> text v2
 ppSimpleTerm (Un op (VN v)) =
-  text (show op) <+> text v
+    text (show op) <+> text v
 ppSimpleTerm (ValSimpleTerm (Lit lit)) =
-  ppLit lit
+    ppLit lit
 ppSimpleTerm (ValSimpleTerm (KAbs klam)) =
-  ppKLambda klam
+    ppKLambda klam
 ppSimpleTerm (Tuple vars) =
-  PP.parens $ PP.hsep $ PP.punctuate (text ",") (map textv vars)
+    PP.parens $ PP.hsep $ PP.punctuate (text ",") (map textv vars)
 ppSimpleTerm (List vars) =
-  PP.brackets $ PP.hsep $ PP.punctuate (text ",") (map textv vars)
+    PP.brackets $ PP.hsep $ PP.punctuate (text ",") (map textv vars)
 ppSimpleTerm (ListCons v1 v2) =
-  PP.parens $ textv v1 PP.<> text "::" PP.<> textv v2
+    PP.parens $ textv v1 PP.<> text "::" PP.<> textv v2
 ppSimpleTerm (Base b) = text b PP.<> text "$base"
 ppSimpleTerm (Lib (Basics.LibName lib) v) = text lib <+> text "." <+> text v
-ppSimpleTerm (Record fields) = PP.braces $ qqFields fields 
-ppSimpleTerm (WithRecord x fields) = 
+ppSimpleTerm (Record fields) = PP.braces $ qqFields fields
+ppSimpleTerm (WithRecord x fields) =
     PP.braces $ PP.hsep [textv x, text "with", qqFields fields]
-
 ppSimpleTerm (ProjField x f) =
-  textv x PP.<> text "." PP.<> PP.text f
+    textv x PP.<> text "." PP.<> PP.text f
 ppSimpleTerm (ProjIdx x idx) =
-  textv x PP.<> text "." PP.<> PP.text (show idx)
+    textv x PP.<> text "." PP.<> PP.text (show idx)
 
 qqFields fields =
-  PP.hcat $
-  PP.punctuate (text ",") (map ppField fields)
-    where ppField (name, v) = 
-           PP.hcat [PP.text name, PP.text "=", textv v]
-
+    PP.hcat $
+        PP.punctuate (text ",") (map ppField fields)
+  where
+    ppField (name, v) =
+        PP.hcat [PP.text name, PP.text "=", textv v]
 
 ppKLambda :: KLambda -> PP.Doc
 ppKLambda (Unary pat kt) =
-  text "fn" <+>  textv pat <+> text "=>" <+> ppKTerm 0 kt
+    text "fn" <+> textv pat <+> text "=>" <+> ppKTerm 0 kt
 ppKLambda (Nullary kt) =
-  text "fn" <+> text "()" <+> text "=>" <+> ppKTerm 0 kt
+    text "fn" <+> text "()" <+> text "=>" <+> ppKTerm 0 kt
 
 ppKTerm' :: KTerm -> PP.Doc
-ppKTerm'  (Error v _) = text "error" PP.<> textv v
+ppKTerm' (Error v _) = text "error" PP.<> textv v
 -- ppKTerm'  (Abs lam) = ppLambda lam
 
---ppKTerm' (ApplyKont kname varname) =
+-- ppKTerm' (ApplyKont kname varname) =
 --    text (show kname) <+> textv varname
 
 ppKTerm' (Halt varname) =
-  text "halt" <+> textv varname
-
+    text "halt" <+> textv varname
 ppKTerm' (KontReturn varname) =
-  text "return" <+> textv varname
-
+    text "return" <+> textv varname
 -- ppKTerm' (LetRet kname kterm) =
 --   text "let-ret" <+> (text (show kname)) $$
 --   text "in" <+>
@@ -192,57 +195,49 @@ ppKTerm' (KontReturn varname) =
 
 ppKTerm' (ApplyFun fname varname) =
     textv fname <+> textv varname
-
 ppKTerm' (LetSimple x t k) =
-  text "let-simple" <+>
-  nest 3 (textv x <+> text "=" <+> ppSimpleTerm t) $$
-  text "in" <+>
-  nest 3 (ppKTerm 0 k) $$
-  text "end"
-
+    text "let-simple"
+        <+> nest 3 (textv x <+> text "=" <+> ppSimpleTerm t)
+        $$ text "in"
+            <+> nest 3 (ppKTerm 0 k)
+        $$ text "end"
 ppKTerm' (LetRet (Cont pat kt1) kt2) =
-  text "let-ret" <+>
-  nest 3 (textv pat <+> text "=" <+> ppKTerm' kt1) $$
-  text "in" <+>
-  nest 3 (ppKTerm 0 kt2) $$
-  text "end"
-
+    text "let-ret"
+        <+> nest 3 (textv pat <+> text "=" <+> ppKTerm' kt1)
+        $$ text "in"
+            <+> nest 3 (ppKTerm 0 kt2)
+        $$ text "end"
 ppKTerm' (LetFun fdefs kt) =
-  text "let-fun" <+>
-  nest 3 (ppFuns (map ppFunDecl fdefs)) $$
-  text "in" <+>
-  nest 3 (ppKTerm 0 kt) $$
-  text "end"
+    text "let-fun"
+        <+> nest 3 (ppFuns (map ppFunDecl fdefs))
+        $$ text "in"
+            <+> nest 3 (ppKTerm 0 kt)
+        $$ text "end"
   where
     ppFunDecl (Fun fname (Unary pat body)) =
-       (textv fname  <+> textv pat <+> text "=" , ppKTerm 0 body)
+        (textv fname <+> textv pat <+> text "=", ppKTerm 0 body)
     ppFunDecl (Fun fname (Nullary body)) =
-       (textv fname  <+> text "()" <+> text "=" , ppKTerm 0 body)
-    ppFuns (doc:docs) =
-      let pp' prefix (docHead,docBody) = text prefix  <+> docHead  $$ nest 2 docBody
-          ppFirstFun = pp' "fun"
-          ppOtherFun = pp' "and"
-      in ppFirstFun doc $$ vcat (map ppOtherFun docs)
+        (textv fname <+> text "()" <+> text "=", ppKTerm 0 body)
+    ppFuns (doc : docs) =
+        let pp' prefix (docHead, docBody) = text prefix <+> docHead $$ nest 2 docBody
+            ppFirstFun = pp' "fun"
+            ppOtherFun = pp' "and"
+         in ppFirstFun doc $$ vcat (map ppOtherFun docs)
     ppFuns _ = PP.empty
-
 ppKTerm' (If vname kt1 kt2) =
-  text "if" <+>
-  textv vname $$
-  text "then" <+>
-  ppKTerm 0 kt1 $$
-  text "else" <+>
-  ppKTerm 0 kt2
-
+    text "if"
+        <+> textv vname
+        $$ text "then"
+            <+> ppKTerm 0 kt1
+        $$ text "else"
+            <+> ppKTerm 0 kt2
 ppKTerm' (AssertElseError vname kt1 verr _) =
-  text "assert" <+>
-  textv vname $$
-  text "then" <+>
-  ppKTerm 0 kt1 $$
-  text "elseError" <+>
-  textv verr
-
-
-
+    text "assert"
+        <+> textv vname
+        $$ text "then"
+            <+> ppKTerm 0 kt1
+        $$ text "elseError"
+            <+> textv verr
 
 appPrec :: Precedence
 appPrec = 5000
@@ -254,14 +249,14 @@ maxPrec :: Precedence
 maxPrec = 100000
 
 termPrec :: KTerm -> Precedence
-termPrec (Halt _)       = maxPrec
+termPrec (Halt _) = maxPrec
 termPrec (ApplyFun _ _) = appPrec
-termPrec (KontReturn _)    = appPrec
-termPrec (If _ _ _)        = 0
+termPrec (KontReturn _) = appPrec
+termPrec (If _ _ _) = 0
 termPrec (LetSimple _ _ _) = 0
 -- termPrec (LetCont   _ _)   = 0
-termPrec (LetFun    _ _)   = 0
---termPrec (Case _ _)        = 0
+termPrec (LetFun _ _) = 0
+-- termPrec (Case _ _)        = 0
 termPrec (LetRet _ _) = 0
 termPrec (AssertElseError _ _ _ _) = 0
-termPrec (Error _ _) = 0
\ No newline at end of file
+termPrec (Error _ _) = 0
diff --git a/compiler/src/RetDFCPS.hs b/compiler/src/RetDFCPS.hs
index b7b6e64f..94e56bb5 100644
--- a/compiler/src/RetDFCPS.hs
+++ b/compiler/src/RetDFCPS.hs
@@ -1,11 +1,12 @@
 {-# LANGUAGE TupleSections #-}
+
 module RetDFCPS (transProg) where
 
-import           Basics
-import           Control.Monad.State.Lazy as State
-import           qualified RetCPS as CPS
-import           RetCPS
+import Basics
+import Control.Monad.State.Lazy as State
 import qualified Core
+import RetCPS
+import qualified RetCPS as CPS
 
 type S = State Integer
 
@@ -19,297 +20,291 @@ our RetCPS language
 
 transFunDecs :: [Core.FunDecl] -> S [CPS.FunDef]
 transFunDecs decls = do
-  mapM transFunDecl decls
+    mapM transFunDecl decls
 
 transFunDecl :: Core.FunDecl -> S CPS.FunDef
 transFunDecl (Core.FunDecl fname (Core.Unary pat e)) = do
---  k <- freshK
-  e' <- transExplicit e
-  return $ CPS.Fun (VN fname) (CPS.Unary (VN pat) e')
+    --  k <- freshK
+    e' <- transExplicit e
+    return $ CPS.Fun (VN fname) (CPS.Unary (VN pat) e')
 transFunDecl (Core.FunDecl fname (Core.Nullary e)) = do
---  k <- freshK
-  e' <- transExplicit e
-  return $ CPS.Fun (VN fname) (CPS.Nullary e')
+    --  k <- freshK
+    e' <- transExplicit e
+    return $ CPS.Fun (VN fname) (CPS.Nullary e')
 
 transProg :: Core.Prog -> CPS.Prog
 transProg (Core.Prog imports atoms t) =
-  Prog atoms $ evalState (trans t (\z -> return $ Halt z)) 1
-
-
-transFields k fields context = 
-  transRecord fields [] context
-    where
-      transRecord [] acc context = do
-          v <- freshV
-          e' <- context v
-          return $ LetSimple v (k (reverse acc)) e'
-      transRecord ((f, t):fields) acc context =
-        trans t (\v -> transRecord fields ((f,v):acc) context)
+    Prog atoms $ evalState (trans t (\z -> return $ Halt z)) 1
 
+transFields k fields context =
+    transRecord fields [] context
+  where
+    transRecord [] acc context = do
+        v <- freshV
+        e' <- context v
+        return $ LetSimple v (k (reverse acc)) e'
+    transRecord ((f, t) : fields) acc context =
+        trans t (\v -> transRecord fields ((f, v) : acc) context)
 
 transFieldsExplicit k fields =
-  iter fields []
-    where iter [] acc = do
-              v <- freshV
-              return $ LetSimple v (k (reverse acc)) (KontReturn v)
-          iter ((f,t):fields) acc  =
-              trans t (\v -> iter fields ((f,v):acc))
-
+    iter fields []
+  where
+    iter [] acc = do
+        v <- freshV
+        return $ LetSimple v (k (reverse acc)) (KontReturn v)
+    iter ((f, t) : fields) acc =
+        trans t (\v -> iter fields ((f, v) : acc))
 
 transExplicit :: Core.Term -> S CPS.KTerm
-transExplicit (Core.Var (Core.RegVar x))  = return $ KontReturn (VN x)
-
+transExplicit (Core.Var (Core.RegVar x)) = return $ KontReturn (VN x)
 transExplicit (Core.Var (Core.BaseName baseName)) = do
-  x  <- freshV
-  return $ LetSimple x (Base baseName) (KontReturn x)
-
+    x <- freshV
+    return $ LetSimple x (Base baseName) (KontReturn x)
 transExplicit (Core.Var (Core.LibVar lib v)) = do
-  x <- freshV
-  return $ LetSimple x (Lib lib v) (KontReturn x)
-
+    x <- freshV
+    return $ LetSimple x (Lib lib v) (KontReturn x)
 transExplicit (Core.Lit lit) = do
-  x <- freshV
-  return $ LetSimple x (ValSimpleTerm (CPS.Lit lit)) (KontReturn x)
-
+    x <- freshV
+    return $ LetSimple x (ValSimpleTerm (CPS.Lit lit)) (KontReturn x)
 transExplicit (Core.Error term p) = do
-  trans term (\v -> return $ Error v p)
-
+    trans term (\v -> return $ Error v p)
 transExplicit (Core.App e1 e2) = do
-  trans e1 (\x1 ->
-    trans e2 (\x2 ->
-      return $ ApplyFun x1 x2 ))
-
+    trans
+        e1
+        ( \x1 ->
+            trans
+                e2
+                ( \x2 ->
+                    return $ ApplyFun x1 x2
+                )
+        )
 transExplicit (Core.Bin op e1 e2) = do
-  x <- freshV
-  trans e1 (\x1 ->
-    trans e2 (\x2 ->
-      return $ LetSimple x (CPS.Bin op x1 x2) (KontReturn x)))
-
+    x <- freshV
+    trans
+        e1
+        ( \x1 ->
+            trans
+                e2
+                ( \x2 ->
+                    return $ LetSimple x (CPS.Bin op x1 x2) (KontReturn x)
+                )
+        )
 transExplicit (Core.Un op e) = do
-  x <- freshV
-  trans e (\x' ->
-      return $ LetSimple x (CPS.Un op x') (KontReturn x))
-
+    x <- freshV
+    trans
+        e
+        ( \x' ->
+            return $ LetSimple x (CPS.Un op x') (KontReturn x)
+        )
 transExplicit (Core.Abs (Core.Unary x e)) = do
-  f <- freshV
-  e' <- transExplicit e
-  return $ LetSimple f (ValSimpleTerm (KAbs (Unary (VN x) e'))) (KontReturn f)
-
+    f <- freshV
+    e' <- transExplicit e
+    return $ LetSimple f (ValSimpleTerm (KAbs (Unary (VN x) e'))) (KontReturn f)
 transExplicit (Core.Abs (Core.Nullary e)) = do
-  f <- freshV
-  e' <- transExplicit e
-  return $ LetSimple f (ValSimpleTerm (KAbs (Nullary e'))) (KontReturn f)
-
-transExplicit (Core.Let (Core.ValDecl v e1) e2)  = do
-  e2' <- transExplicit e2
-  e1' <- transExplicit e1
-  return $ LetRet (Cont (VN v) e2') e1'
-
-transExplicit (Core.Let (Core.FunDecs decs) e2)  = do
-  decs' <- transFunDecs decs
-  e2' <- transExplicit e2
-  return $ LetFun decs' e2'
-
-transExplicit (Core.If e0 e1 e2)  = do
-  e1' <- transExplicit e1
-  e2' <- transExplicit e2
-  trans e0 (\z -> return $ If z e1' e2')
-
--- 2018-09-28: AA; gotta double check this part of 
+    f <- freshV
+    e' <- transExplicit e
+    return $ LetSimple f (ValSimpleTerm (KAbs (Nullary e'))) (KontReturn f)
+transExplicit (Core.Let (Core.ValDecl v e1) e2) = do
+    e2' <- transExplicit e2
+    e1' <- transExplicit e1
+    return $ LetRet (Cont (VN v) e2') e1'
+transExplicit (Core.Let (Core.FunDecs decs) e2) = do
+    decs' <- transFunDecs decs
+    e2' <- transExplicit e2
+    return $ LetFun decs' e2'
+transExplicit (Core.If e0 e1 e2) = do
+    e1' <- transExplicit e1
+    e2' <- transExplicit e2
+    trans e0 (\z -> return $ If z e1' e2')
+
+-- 2018-09-28: AA; gotta double check this part of
 -- the translation
 transExplicit (Core.AssertElseError e0 e1 e2 p) = do
-  e1' <- transExplicit e1
-  trans e0 (\v0 ->
-    trans e2 (\v2 ->
-      return $ AssertElseError v0 e1' v2 p))
-
-
-transExplicit (Core.Tuple ts)  =
-  transTuple ts []
+    e1' <- transExplicit e1
+    trans
+        e0
+        ( \v0 ->
+            trans
+                e2
+                ( \v2 ->
+                    return $ AssertElseError v0 e1' v2 p
+                )
+        )
+transExplicit (Core.Tuple ts) =
+    transTuple ts []
   where
     transTuple :: [Core.Term] -> [CPS.VarName] -> S KTerm
-    transTuple [] acc  = do
-      v <- freshV
-      return $ LetSimple v (Tuple (reverse acc)) (KontReturn v)
-    transTuple (t:ts) acc  =
-      trans t (\v -> transTuple ts (v:acc) )
-
-transExplicit (Core.Record fields) = 
-    transFieldsExplicit Record fields 
-  
+    transTuple [] acc = do
+        v <- freshV
+        return $ LetSimple v (Tuple (reverse acc)) (KontReturn v)
+    transTuple (t : ts) acc =
+        trans t (\v -> transTuple ts (v : acc))
+transExplicit (Core.Record fields) =
+    transFieldsExplicit Record fields
 transExplicit (Core.WithRecord e fields) =
-  trans e (\x -> transFieldsExplicit (WithRecord x) fields)
-  
-
-transExplicit (Core.ProjField t f)= do
-  x <- freshV
-  trans t (\x' ->
-    return $ LetSimple x (CPS.ProjField x' f) (KontReturn x))
-
+    trans e (\x -> transFieldsExplicit (WithRecord x) fields)
+transExplicit (Core.ProjField t f) = do
+    x <- freshV
+    trans
+        t
+        ( \x' ->
+            return $ LetSimple x (CPS.ProjField x' f) (KontReturn x)
+        )
 transExplicit (Core.ProjIdx t idx) = do
-  x <- freshV
-  trans t (\x' ->
-    return $ LetSimple x (CPS.ProjIdx x' idx) (KontReturn x))
-
+    x <- freshV
+    trans
+        t
+        ( \x' ->
+            return $ LetSimple x (CPS.ProjIdx x' idx) (KontReturn x)
+        )
 transExplicit (Core.List ts) =
-  transList ts []
+    transList ts []
   where
-    transList [] acc  = do
-      v <- freshV
-      return $ LetSimple v (List (reverse acc)) (KontReturn v)
-    transList (t:ts) acc =
-      trans t (\v -> transList ts (v:acc))
-
+    transList [] acc = do
+        v <- freshV
+        return $ LetSimple v (List (reverse acc)) (KontReturn v)
+    transList (t : ts) acc =
+        trans t (\v -> transList ts (v : acc))
 transExplicit (Core.ListCons h t) = do
-  v <- freshV
-  trans h (\h' -> trans t (\t' -> return $ LetSimple v (ListCons h' t') (KontReturn v)))
+    v <- freshV
+    trans h (\h' -> trans t (\t' -> return $ LetSimple v (ListCons h' t') (KontReturn v)))
 
 transFunDef :: Core.Lambda -> S CPS.KLambda
 transFunDef (Core.Unary x e) = do
-  e' <- transExplicit e
-  return (CPS.Unary (VN x) e')
+    e' <- transExplicit e
+    return (CPS.Unary (VN x) e')
 transFunDef (Core.Nullary e) = do
-  e' <- transExplicit e
-  return (CPS.Nullary e')
+    e' <- transExplicit e
+    return (CPS.Nullary e')
 
 trans :: Core.Term -> (CPS.VarName -> S CPS.KTerm) -> S CPS.KTerm
-
-
 trans (Core.Var (Core.RegVar x)) context = context (VN x)
-
 trans (Core.Var (Core.BaseName baseName)) context = do
-  x <- freshV
-  kterm' <- context x
-  return $ LetSimple x (Base baseName) kterm'
-
-
+    x <- freshV
+    kterm' <- context x
+    return $ LetSimple x (Base baseName) kterm'
 trans (Core.Var (Core.LibVar lib v)) context = do
-  x <- freshV
-  kterm' <- context x
-  return $ LetSimple x (Lib lib v) kterm'
-
-
+    x <- freshV
+    kterm' <- context x
+    return $ LetSimple x (Lib lib v) kterm'
 trans (Core.Lit i) context =
-  do x <- freshV
-     kterm' <- context x
-     return $ LetSimple x (ValSimpleTerm (CPS.Lit i)) kterm'
-
+    do
+        x <- freshV
+        kterm' <- context x
+        return $ LetSimple x (ValSimpleTerm (CPS.Lit i)) kterm'
 trans (Core.Error e p) context = do
-  x  <- freshV
-  kterm <- context x
-  trans e (\z -> return $ LetRet (Cont x kterm) (Error z p))
-
+    x <- freshV
+    kterm <- context x
+    trans e (\z -> return $ LetRet (Cont x kterm) (Error z p))
 trans (Core.App e1 e2) context = do
-  x  <- freshV
-  kterm <- context x
-  trans e1 (\z1 ->
-    trans e2 (\z2 ->
-      return $ LetRet (Cont x kterm) (ApplyFun z1 z2)))
-
+    x <- freshV
+    kterm <- context x
+    trans
+        e1
+        ( \z1 ->
+            trans
+                e2
+                ( \z2 ->
+                    return $ LetRet (Cont x kterm) (ApplyFun z1 z2)
+                )
+        )
 trans (Core.Bin op e1 e2) context = do
-  x <- freshV
-  kterm <- context x
-  trans e1 (\z1 ->
-    trans e2 (\z2 ->
-      return $ LetSimple x (CPS.Bin op z1 z2) kterm))
-
+    x <- freshV
+    kterm <- context x
+    trans
+        e1
+        ( \z1 ->
+            trans
+                e2
+                ( \z2 ->
+                    return $ LetSimple x (CPS.Bin op z1 z2) kterm
+                )
+        )
 trans (Core.Un op e) context = do
-  x <- freshV
-  kterm <- context x
-  trans e (\z -> return $ LetSimple x (CPS.Un op z) kterm)
-
+    x <- freshV
+    kterm <- context x
+    trans e (\z -> return $ LetSimple x (CPS.Un op z) kterm)
 trans (Core.Abs (Core.Unary x e)) context = do
-  f <- freshV
-  kterm <- context f
-  e' <- transExplicit e
-  return $ LetSimple f (ValSimpleTerm (KAbs (Unary (VN x) e'))) kterm
-
+    f <- freshV
+    kterm <- context f
+    e' <- transExplicit e
+    return $ LetSimple f (ValSimpleTerm (KAbs (Unary (VN x) e'))) kterm
 trans (Core.Abs (Core.Nullary e)) context = do
-  f <- freshV
-  kterm <- context f
-  e' <- transExplicit e
-  return $ LetSimple f (ValSimpleTerm (KAbs (Nullary e'))) kterm
-
+    f <- freshV
+    kterm <- context f
+    e' <- transExplicit e
+    return $ LetSimple f (ValSimpleTerm (KAbs (Nullary e'))) kterm
 trans (Core.Let (Core.ValDecl v e1) e2) context = do
-  e2' <- trans e2 context
-  e1' <- transExplicit e1
-  return $ LetRet (Cont (VN v) e2') e1'
-
+    e2' <- trans e2 context
+    e1' <- transExplicit e1
+    return $ LetRet (Cont (VN v) e2') e1'
 trans (Core.Let (Core.FunDecs decs) e2) context = do
-  decs' <- transFunDecs decs
-  e2' <- trans e2 context
-  return $ LetFun decs' e2'
-
+    decs' <- transFunDecs decs
+    e2' <- trans e2 context
+    return $ LetFun decs' e2'
 trans (Core.If e0 e1 e2) context = do
-  v <- freshV
-  kterm <- context v
-  e1' <- transExplicit e1
-  e2' <- transExplicit e2
-  trans e0 (\z -> return $ LetRet (Cont v kterm) (If z e1' e2'))
-
-
+    v <- freshV
+    kterm <- context v
+    e1' <- transExplicit e1
+    e2' <- transExplicit e2
+    trans e0 (\z -> return $ LetRet (Cont v kterm) (If z e1' e2'))
 trans (Core.AssertElseError e0 e1 e2 p) context = do
-  x <- freshV
-  kterm <- context x
-  e1' <- transExplicit e1
-  trans e0 (\z ->
-    trans e2 (\z2 ->
-      return $ LetRet (Cont x kterm) (AssertElseError z e1' z2 p)))
-
-
-
+    x <- freshV
+    kterm <- context x
+    e1' <- transExplicit e1
+    trans
+        e0
+        ( \z ->
+            trans
+                e2
+                ( \z2 ->
+                    return $ LetRet (Cont x kterm) (AssertElseError z e1' z2 p)
+                )
+        )
 trans (Core.Tuple ts) context =
-  transTuple ts [] context
+    transTuple ts [] context
   where
     transTuple [] acc context = do
-      v <- freshV
-      e' <- context v
-      return $ LetSimple v (Tuple (reverse acc)) e'
-    transTuple (t:ts) acc context =
-      trans t (\v -> transTuple ts (v:acc) context)
-
+        v <- freshV
+        e' <- context v
+        return $ LetSimple v (Tuple (reverse acc)) e'
+    transTuple (t : ts) acc context =
+        trans t (\v -> transTuple ts (v : acc) context)
 trans (Core.Record fields) context = transFields Record fields context
-
-trans (Core.WithRecord  e fields) context = 
-  trans e (\ rr -> transFields (WithRecord rr) fields context )
-    
-
+trans (Core.WithRecord e fields) context =
+    trans e (\rr -> transFields (WithRecord rr) fields context)
 trans (Core.ProjField t f) context = do
-  x <- freshV
-  kterm <- context x
-  trans t (\z -> return $ LetSimple x (CPS.ProjField z f) kterm)
-
+    x <- freshV
+    kterm <- context x
+    trans t (\z -> return $ LetSimple x (CPS.ProjField z f) kterm)
 trans (Core.ProjIdx t idx) context = do
-  x <- freshV
-  kterm <- context x
-  trans t (\z -> return $ LetSimple x (CPS.ProjIdx z idx) kterm)
-
+    x <- freshV
+    kterm <- context x
+    trans t (\z -> return $ LetSimple x (CPS.ProjIdx z idx) kterm)
 trans (Core.List ts) context =
-  transList ts [] context
+    transList ts [] context
   where
     transList [] acc context = do
-      v <- freshV
-      e' <- context v
-      return $ LetSimple v (List (reverse acc)) e'
-    transList (t:ts) acc context =
-      trans t (\v -> transList ts (v:acc) context)
-
+        v <- freshV
+        e' <- context v
+        return $ LetSimple v (List (reverse acc)) e'
+    transList (t : ts) acc context =
+        trans t (\v -> transList ts (v : acc) context)
 trans (Core.ListCons h t) context = do
-  v <- freshV
-  e' <- context v
-  trans h (\h' -> trans t (\t' -> return $ LetSimple v (ListCons h' t') e'))
-
+    v <- freshV
+    e' <- context v
+    trans h (\h' -> trans t (\t' -> return $ LetSimple v (ListCons h' t') e'))
 
 freshSymbol :: S String
 freshSymbol = do
-  n <- State.get
-  put (n + 1)
-  return $ ("gensym" ++ show n)
+    n <- State.get
+    put (n + 1)
+    return $ ("gensym" ++ show n)
 
 freshV :: S CPS.VarName
 freshV = do
-      s <- freshSymbol
-      return $ VN s
+    s <- freshSymbol
+    return $ VN s
 
 -- freshK :: S KontName
 -- freshK = do
diff --git a/compiler/src/RetFreeVars.hs b/compiler/src/RetFreeVars.hs
index ff24c221..2068c748 100644
--- a/compiler/src/RetFreeVars.hs
+++ b/compiler/src/RetFreeVars.hs
@@ -1,25 +1,24 @@
 module RetFreeVars where
 
 import qualified Basics
-import RetCPS as CPS
+import Control.Monad.Identity
+import Control.Monad.Trans.Maybe
 import qualified Core as C
 import Data.List
-import Data.Map.Lazy(Map)
+import Data.Map.Lazy (Map)
 import qualified Data.Map.Lazy as Map
-import Control.Monad.Trans.Maybe
-import Control.Monad.Identity
 import Data.Set (Set)
 import qualified Data.Set as Set
+import RetCPS as CPS
 
 newtype FreeVars = FreeVars (Set VarName)
 
 class FreeNames a where
-  freeVars :: a -> FreeVars
-
+    freeVars :: a -> FreeVars
 
 unionFreeVars :: FreeVars -> FreeVars -> FreeVars
 unionFreeVars (FreeVars s) (FreeVars u) =
-   FreeVars (s `Set.union` u)
+    FreeVars (s `Set.union` u)
 
 emptyFreeVars = FreeVars Set.empty
 
@@ -28,67 +27,61 @@ unionMany :: [FreeVars] -> FreeVars
 unionMany = foldl unionFreeVars emptyFreeVars
 
 restrictFree x vs =
-  let FreeVars (fv) = freeVars x
-  in FreeVars ( fv Set.\\ Set.fromList vs )
-
+    let FreeVars (fv) = freeVars x
+     in FreeVars (fv Set.\\ Set.fromList vs)
 
 instance FreeNames KLambda where
-  freeVars (Unary vn kt) = restrictFree kt [vn]
-  freeVars (Nullary  kt) = restrictFree kt []
+    freeVars (Unary vn kt) = restrictFree kt [vn]
+    freeVars (Nullary kt) = restrictFree kt []
 
 instance FreeNames SVal where
-  freeVars (KAbs klam) = freeVars klam
-  freeVars (Lit (C.LAtom nm)) = FreeVars (Set.singleton $ VN nm)
-  freeVars _ = emptyFreeVars
+    freeVars (KAbs klam) = freeVars klam
+    freeVars (Lit (C.LAtom nm)) = FreeVars (Set.singleton $ VN nm)
+    freeVars _ = emptyFreeVars
 
 instance FreeNames ContDef where
-  freeVars  (Cont vn kt) = restrictFree kt [vn]
+    freeVars (Cont vn kt) = restrictFree kt [vn]
 
 instance FreeNames FunDef where
-  freeVars (Fun fn klam) = restrictFree klam [fn]
+    freeVars (Fun fn klam) = restrictFree klam [fn]
 
 instance FreeNames SimpleTerm where
-  freeVars (Bin _ v1 v2) = FreeVars (Set.fromList [v1, v2])
-  freeVars (Un _ v) = FreeVars (Set.singleton v)
-  freeVars (ValSimpleTerm sval) = freeVars sval
-  freeVars (Tuple vs) = FreeVars (Set.fromList vs)
-  freeVars (List vs)  = FreeVars (Set.fromList vs)
-  freeVars (ListCons v1 v2) = FreeVars (Set.fromList [v1, v2])
-  freeVars (Base _ ) = FreeVars $ Set.empty
-  freeVars (Lib _ _) = FreeVars $ Set.empty
-  freeVars (Record fields) = unionMany $ 
-      map (\(f,x) -> FreeVars (if x == VN f then Set.empty else Set.singleton x))
-      fields
-  freeVars (WithRecord x fields) = 
-    let _f = map (\(f,x) -> FreeVars ( if x == VN f then Set.empty else Set.singleton x)) fields in 
-    unionMany $ (FreeVars (Set.singleton x)): _f
-  freeVars (ProjField x _) = FreeVars (Set.singleton x)
-  freeVars (ProjIdx x _) = FreeVars (Set.singleton x)
+    freeVars (Bin _ v1 v2) = FreeVars (Set.fromList [v1, v2])
+    freeVars (Un _ v) = FreeVars (Set.singleton v)
+    freeVars (ValSimpleTerm sval) = freeVars sval
+    freeVars (Tuple vs) = FreeVars (Set.fromList vs)
+    freeVars (List vs) = FreeVars (Set.fromList vs)
+    freeVars (ListCons v1 v2) = FreeVars (Set.fromList [v1, v2])
+    freeVars (Base _) = FreeVars $ Set.empty
+    freeVars (Lib _ _) = FreeVars $ Set.empty
+    freeVars (Record fields) =
+        unionMany $
+            map
+                (\(f, x) -> FreeVars (if x == VN f then Set.empty else Set.singleton x))
+                fields
+    freeVars (WithRecord x fields) =
+        let _f = map (\(f, x) -> FreeVars (if x == VN f then Set.empty else Set.singleton x)) fields
+         in unionMany $ (FreeVars (Set.singleton x)) : _f
+    freeVars (ProjField x _) = FreeVars (Set.singleton x)
+    freeVars (ProjIdx x _) = FreeVars (Set.singleton x)
 
 freeOfLet d vs kt =
-   (freeVars d) `unionFreeVars` (restrictFree kt vs)
+    (freeVars d) `unionFreeVars` (restrictFree kt vs)
 
 instance FreeNames KTerm where
-  freeVars (Error v _) = FreeVars (Set.singleton v)
-
-  freeVars (LetSimple vn st kt) = freeOfLet st [vn] kt
-
-  freeVars (LetRet (Cont vn kt')  kt) = freeOfLet kt [vn] kt'
-
-  freeVars (LetFun fdefs kt) =
-     (unionMany (map freeVars fdefs)) `unionFreeVars` (restrictFree kt  (map fname fdefs))
-        where fname (Fun n _) = n
-
-  freeVars (KontReturn v) = FreeVars (Set.singleton v)
-
---   freeVars (LetRet cdef@(Cont vn _) kt) =  freeOfLet cdef [vn] kt
-
-  freeVars (ApplyFun fn vn) = FreeVars (Set.fromList [fn, vn])
-
-  freeVars (If vn k1 k2) =
-     unionMany [freeVars k1, freeVars k2, FreeVars (Set.singleton vn)]
-
-  freeVars (AssertElseError vn k ve _) =
-     unionMany [freeVars k, FreeVars $ Set.fromList [vn, ve] ]
-
-  freeVars (Halt x) = FreeVars (Set.singleton x)
+    freeVars (Error v _) = FreeVars (Set.singleton v)
+    freeVars (LetSimple vn st kt) = freeOfLet st [vn] kt
+    freeVars (LetRet (Cont vn kt') kt) = freeOfLet kt [vn] kt'
+    freeVars (LetFun fdefs kt) =
+        (unionMany (map freeVars fdefs)) `unionFreeVars` (restrictFree kt (map fname fdefs))
+      where
+        fname (Fun n _) = n
+    freeVars (KontReturn v) = FreeVars (Set.singleton v)
+    --   freeVars (LetRet cdef@(Cont vn _) kt) =  freeOfLet cdef [vn] kt
+
+    freeVars (ApplyFun fn vn) = FreeVars (Set.fromList [fn, vn])
+    freeVars (If vn k1 k2) =
+        unionMany [freeVars k1, freeVars k2, FreeVars (Set.singleton vn)]
+    freeVars (AssertElseError vn k ve _) =
+        unionMany [freeVars k, FreeVars $ Set.fromList [vn, ve]]
+    freeVars (Halt x) = FreeVars (Set.singleton x)
diff --git a/compiler/src/RetRewrite.hs b/compiler/src/RetRewrite.hs
index cb18eb73..d8a0e9c2 100644
--- a/compiler/src/RetRewrite.hs
+++ b/compiler/src/RetRewrite.hs
@@ -1,271 +1,230 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 {-- Obs: 2018-02-16: beacuse of the RetCPS representation, we currently
 have very few rewrites that actually kick-in; we should be able to
 rectify them with some more work, but that's postponed for now; AA
 --}
 
-
-module RetRewrite(rewrite) where
+module RetRewrite (rewrite) where
 
 -- todo: consider renaming this to CPSRewrite
 
-
 import qualified Basics
-import RetCPS as CPS
-import qualified Core as C
+import Control.Monad.Identity
 import Control.Monad.RWS
+import Control.Monad.Reader
 import Control.Monad.State
+import Control.Monad.Trans.Maybe
 import Control.Monad.Writer
-import Control.Monad.Reader
+import qualified Core as C
 import Data.List
-import Data.Map.Lazy(Map)
+import Data.Map.Lazy (Map)
 import qualified Data.Map.Lazy as Map
-import Control.Monad.Trans.Maybe
-import Control.Monad.Identity
 import Data.Set (Set)
 import qualified Data.Set as Set
+import RetCPS as CPS
 import RetFreeVars as FreeVars
 import TroupePositionInfo
 
-
 -- substitution is a collection of both variable substitutions and
 -- kont substitutions; 2018-01-23; AA (this is a rather awkward
 -- construction; we should have better software engineering)
 
-
 newtype Subst = Subst (Map VarName VarName)
 
 class Substitutable a where
-  apply :: Subst -> a -> a
+    apply :: Subst -> a -> a
 
 idSubst :: Subst
 idSubst = Subst (Map.empty)
 
-
 instance Substitutable KLambda where
-  apply subst@(Subst (varmap)) kl =
-    case kl of
-      Unary vn kt ->
-        let subst' = Subst (Map.delete vn varmap)
-        in  Unary vn (apply subst' kt)
-      Nullary kt ->
-        let subst' = Subst (varmap)
-        in Nullary (apply subst' kt)
-
+    apply subst@(Subst (varmap)) kl =
+        case kl of
+            Unary vn kt ->
+                let subst' = Subst (Map.delete vn varmap)
+                 in Unary vn (apply subst' kt)
+            Nullary kt ->
+                let subst' = Subst (varmap)
+                 in Nullary (apply subst' kt)
 
 instance Substitutable SVal where
-  apply _ (Lit lit) = Lit lit
-  apply subst (KAbs klambda) = KAbs (apply subst klambda)
-
+    apply _ (Lit lit) = Lit lit
+    apply subst (KAbs klambda) = KAbs (apply subst klambda)
 
 instance Substitutable SimpleTerm where
-  apply subst@(Subst varmap) simpleTerm =
-    case simpleTerm of
-      Bin op v1 v2 -> Bin op (fwd v1) (fwd v2)
-      Un op v -> Un op (fwd v)
-      Tuple vs -> Tuple (map fwd vs)
-      Record fields -> Record $ fwdFields fields
-      WithRecord x fields -> WithRecord (fwd x) $ fwdFields fields
-      ProjField x f -> ProjField (fwd x) f
-      ProjIdx x idx -> ProjIdx (fwd x) idx
-      List vs -> List (map fwd vs)
-      ListCons v v' -> ListCons (fwd v) (fwd v')
-      ValSimpleTerm sv -> ValSimpleTerm (apply subst sv)
-      Base v -> Base v
-      Lib l v -> Lib l v 
-    where fwd x = Map.findWithDefault x x varmap
-          fwdFields fields = map (\(f, x) -> (f, fwd x)) fields
+    apply subst@(Subst varmap) simpleTerm =
+        case simpleTerm of
+            Bin op v1 v2 -> Bin op (fwd v1) (fwd v2)
+            Un op v -> Un op (fwd v)
+            Tuple vs -> Tuple (map fwd vs)
+            Record fields -> Record $ fwdFields fields
+            WithRecord x fields -> WithRecord (fwd x) $ fwdFields fields
+            ProjField x f -> ProjField (fwd x) f
+            ProjIdx x idx -> ProjIdx (fwd x) idx
+            List vs -> List (map fwd vs)
+            ListCons v v' -> ListCons (fwd v) (fwd v')
+            ValSimpleTerm sv -> ValSimpleTerm (apply subst sv)
+            Base v -> Base v
+            Lib l v -> Lib l v
+      where
+        fwd x = Map.findWithDefault x x varmap
+        fwdFields fields = map (\(f, x) -> (f, fwd x)) fields
 
 instance Substitutable ContDef where
-  apply subst@(Subst varmap) (Cont vn kt) =
-     let subst' = Subst (Map.delete vn varmap)
-     in Cont vn (apply subst' kt)
+    apply subst@(Subst varmap) (Cont vn kt) =
+        let subst' = Subst (Map.delete vn varmap)
+         in Cont vn (apply subst' kt)
 
 instance Substitutable FunDef where
-  apply subst@(Subst varmap) (Fun vn klam) =
-    let subst' = Subst (Map.delete vn varmap)
-    in Fun vn (apply subst' klam)
-
+    apply subst@(Subst varmap) (Fun vn klam) =
+        let subst' = Subst (Map.delete vn varmap)
+         in Fun vn (apply subst' klam)
 
 instance Substitutable KTerm where
-  apply subst@(Subst varmap) kontTerm =
-    case kontTerm of
-      LetSimple x st kt ->
-        LetSimple (vfwd x) (apply subst st) (apply subst kt)
-
-      LetRet kdef@(Cont _ _) kt ->
-        let kdef' = apply subst kdef
-            kt'   = apply subst kt
-        in LetRet kdef' kt'
-
-      LetFun fdefs kt ->
-         let fnames = map (\(Fun v _) -> v) fdefs
-             subst' = Subst ( foldl (\m v -> Map.delete v m) varmap fnames)
-             kt' = apply subst' kt
-             fdefs' = map (apply subst') fdefs
-         in LetFun fdefs' kt'
-
-
-      -- LetRet k kt -> LetRet (kfwd k) (apply subst kt)
-
-      Halt v -> Halt (vfwd v)
-
-      KontReturn v  -> KontReturn (vfwd v)
-
-      ApplyFun fn argn -> ApplyFun (vfwd fn) (vfwd argn)
-
-      If v k1 k2 -> If (vfwd v) (apply subst k1) (apply subst k2)
-
-      AssertElseError v k1 z p -> AssertElseError (vfwd v) (apply subst k1) (vfwd z) p
-
-      Error x p -> Error (vfwd x) p
-
-   where vfwd x = Map.findWithDefault x x varmap
-         -- kfwd x = Map.findWithDefault x x kontmap
-
+    apply subst@(Subst varmap) kontTerm =
+        case kontTerm of
+            LetSimple x st kt ->
+                LetSimple (vfwd x) (apply subst st) (apply subst kt)
+            LetRet kdef@(Cont _ _) kt ->
+                let kdef' = apply subst kdef
+                    kt' = apply subst kt
+                 in LetRet kdef' kt'
+            LetFun fdefs kt ->
+                let fnames = map (\(Fun v _) -> v) fdefs
+                    subst' = Subst (foldl (\m v -> Map.delete v m) varmap fnames)
+                    kt' = apply subst' kt
+                    fdefs' = map (apply subst') fdefs
+                 in LetFun fdefs' kt'
+            -- LetRet k kt -> LetRet (kfwd k) (apply subst kt)
+
+            Halt v -> Halt (vfwd v)
+            KontReturn v -> KontReturn (vfwd v)
+            ApplyFun fn argn -> ApplyFun (vfwd fn) (vfwd argn)
+            If v k1 k2 -> If (vfwd v) (apply subst k1) (apply subst k2)
+            AssertElseError v k1 z p -> AssertElseError (vfwd v) (apply subst k1) (vfwd z) p
+            Error x p -> Error (vfwd x) p
+      where
+        vfwd x = Map.findWithDefault x x varmap
+
+-- kfwd x = Map.findWithDefault x x kontmap
 
 data Context -- note this is not an exhaustive set of possible contexts; 2018-01-25; AA
-  = CtxtHole
-  | CtxtLetSimple VarName SimpleTerm Context
-  | CtxtLetCont ContDef Context
-  | CtxtLetFunK [FunDef] Context
-  | CtxtAssert VarName VarName PosInf Context
---  | CtxtLetRet KontName Context
-  deriving (Eq)
+    = CtxtHole
+    | CtxtLetSimple VarName SimpleTerm Context
+    | CtxtLetCont ContDef Context
+    | CtxtLetFunK [FunDef] Context
+    | CtxtAssert VarName VarName PosInf Context
+    --  | CtxtLetRet KontName Context
+    deriving (Eq)
 
 retUnchanged :: Context -> Bool
-retUnchanged CtxtHole  = True
-retUnchanged (CtxtLetSimple  _ _ ctxt) = retUnchanged ctxt
+retUnchanged CtxtHole = True
+retUnchanged (CtxtLetSimple _ _ ctxt) = retUnchanged ctxt
 retUnchanged (CtxtLetCont _ _) = True
-retUnchanged (CtxtLetFunK _ ctxt) =  retUnchanged ctxt
+retUnchanged (CtxtLetFunK _ ctxt) = retUnchanged ctxt
 retUnchanged (CtxtAssert _ _ _ ctxt) = retUnchanged ctxt
 
-
-data SearchPat = PatReturn
-               | PatLetRet
-               | PatFunApply VarName
-
+data SearchPat
+    = PatReturn
+    | PatLetRet
+    | PatFunApply VarName
 
 matchterm :: KTerm -> SearchPat -> Maybe (Context, KTerm)
-
-matchterm found@(LetRet _ _) (PatLetRet)  =
-  return (CtxtHole, found)
-
-matchterm (LetRet _ _) PatReturn = Nothing  
-
+matchterm found@(LetRet _ _) (PatLetRet) =
+    return (CtxtHole, found)
+matchterm (LetRet _ _) PatReturn = Nothing
 matchterm found@(KontReturn _) (PatReturn) =
-  return (CtxtHole, found)
-
-matchterm found@(ApplyFun fn argn) (PatFunApply fn') | fn == fn' =
-  return (CtxtHole, found)
-
-
-
+    return (CtxtHole, found)
+matchterm found@(ApplyFun fn argn) (PatFunApply fn')
+    | fn == fn' =
+        return (CtxtHole, found)
 matchterm (LetSimple vn st kt) searchTerm = do
-  (ctxt, found) <- matchterm kt searchTerm
-  return $ (CtxtLetSimple vn st ctxt, found)
-
+    (ctxt, found) <- matchterm kt searchTerm
+    return $ (CtxtLetSimple vn st ctxt, found)
 matchterm (LetFun fdefs kt) searchTerm = do
-  (ctxt, found) <- matchterm kt searchTerm
-  return $ (CtxtLetFunK fdefs ctxt, found)
-
+    (ctxt, found) <- matchterm kt searchTerm
+    return $ (CtxtLetFunK fdefs ctxt, found)
 matchterm (LetRet kdef kt) searchTerm = do
-  (ctxt, found) <- matchterm kt searchTerm
-  return $ (CtxtLetCont kdef ctxt, found)
-
-matchterm (AssertElseError vn kt vn' pos) searchTerm = do 
-  (ctxt, found) <- matchterm kt searchTerm
-  return $ (CtxtAssert vn vn' pos ctxt, found)
-
-
+    (ctxt, found) <- matchterm kt searchTerm
+    return $ (CtxtLetCont kdef ctxt, found)
+matchterm (AssertElseError vn kt vn' pos) searchTerm = do
+    (ctxt, found) <- matchterm kt searchTerm
+    return $ (CtxtAssert vn vn' pos ctxt, found)
 matchterm _ _ = Nothing
 
-
-
-
 --- this is the inverse of match: allows us to reconstruct the term back
 --- from the contxt and the term inside
 
 reconstructTerm :: Context -> KTerm -> KTerm
-reconstructTerm CtxtHole kt  = kt
+reconstructTerm CtxtHole kt = kt
 reconstructTerm (CtxtLetSimple vn st ctxt) kt =
-  LetSimple vn st (reconstructTerm ctxt kt)
+    LetSimple vn st (reconstructTerm ctxt kt)
 reconstructTerm (CtxtLetCont kdef ctxt) kt =
-  LetRet kdef (reconstructTerm ctxt kt)
+    LetRet kdef (reconstructTerm ctxt kt)
 reconstructTerm (CtxtLetFunK fdefs ctxt) kt =
-  LetFun fdefs (reconstructTerm ctxt kt)
-reconstructTerm (CtxtAssert vn vn' pos ctxt) kt = 
-  AssertElseError vn (reconstructTerm ctxt kt) vn' pos
-
+    LetFun fdefs (reconstructTerm ctxt kt)
+reconstructTerm (CtxtAssert vn vn' pos ctxt) kt =
+    AssertElseError vn (reconstructTerm ctxt kt) vn' pos
 
 class KWalkable a b where
-  walk :: (b -> Bool) -> (b -> b) -> a -> a
+    walk :: (b -> Bool) -> (b -> b) -> a -> a
 
 instance (KWalkable KTerm KTerm) where
-  walk pred f kt =
-    if pred kt then f kt
-    else
-      let w' = walk pred f
-      in
-       case kt of
-         LetSimple vn st kt' -> LetSimple vn (walk pred f st) (w' kt')
-         LetRet cdef kt'    -> LetRet  (walk pred f cdef) (w' kt')
-         LetFun fdefs kt'    -> LetFun (map (walk pred f) fdefs) (w' kt')
-         If v k1 k2          -> If v (w' k1) (w' k2)
-         AssertElseError v k1 z p -> AssertElseError v (w' k1) z p
-         -- LetRet kn kt'       -> LetRet kn (w' kt')
-         -- these do not modify anything
-         KontReturn v   -> KontReturn v
-         Halt v -> Halt v
-         ApplyFun v a1 -> ApplyFun v a1
-         Error x p -> Error x p
-
-
+    walk pred f kt =
+        if pred kt
+            then f kt
+            else
+                let w' = walk pred f
+                 in case kt of
+                        LetSimple vn st kt' -> LetSimple vn (walk pred f st) (w' kt')
+                        LetRet cdef kt' -> LetRet (walk pred f cdef) (w' kt')
+                        LetFun fdefs kt' -> LetFun (map (walk pred f) fdefs) (w' kt')
+                        If v k1 k2 -> If v (w' k1) (w' k2)
+                        AssertElseError v k1 z p -> AssertElseError v (w' k1) z p
+                        -- LetRet kn kt'       -> LetRet kn (w' kt')
+                        -- these do not modify anything
+                        KontReturn v -> KontReturn v
+                        Halt v -> Halt v
+                        ApplyFun v a1 -> ApplyFun v a1
+                        Error x p -> Error x p
 
 instance (KWalkable KLambda KTerm) where
-  walk pred f (Unary vn kt) =
-    Unary vn (walk pred f kt)
-  walk pred f (Nullary kt) =
-    Nullary (walk pred f kt)
-
+    walk pred f (Unary vn kt) =
+        Unary vn (walk pred f kt)
+    walk pred f (Nullary kt) =
+        Nullary (walk pred f kt)
 
 instance (KWalkable SimpleTerm KTerm) where
-  walk pred f st =
-    case st of
-        ValSimpleTerm (KAbs klam) ->
-          ValSimpleTerm (KAbs (walk pred f klam))
-        _ -> st
+    walk pred f st =
+        case st of
+            ValSimpleTerm (KAbs klam) ->
+                ValSimpleTerm (KAbs (walk pred f klam))
+            _ -> st
 
 instance KWalkable ContDef KTerm where
-  walk pred f (Cont vn kt) = Cont vn (walk pred f kt)
-
+    walk pred f (Cont vn kt) = Cont vn (walk pred f kt)
 
 instance KWalkable FunDef KTerm where
-  walk pred f (Fun v klam) = Fun v (walk pred f klam)
-
-
+    walk pred f (Fun v klam) = Fun v (walk pred f klam)
 
 --------------------------------------------------
 -- free vars
 --------------------------------------------------
 
-
-
-
 instance FreeNames Context where
-  freeVars CtxtHole = emptyFreeVars
-  freeVars (CtxtLetSimple vn st ctxt) = freeOfLet st [vn] ctxt
-  freeVars (CtxtLetCont cdef@(Cont vn kt') ctxt) = freeOfLet cdef [vn] ctxt
-  freeVars (CtxtLetFunK fdefs ctxt) =
-      (unionMany (map freeVars fdefs)) `unionFreeVars` (restrictFree ctxt  (map fname fdefs))
-        where fname (Fun n _) = n
-  freeVars (CtxtAssert vn1 vn2 _ ctxt) = unionMany [freeVars ctxt, FreeVars $ Set.fromList [vn1, vn2]]
+    freeVars CtxtHole = emptyFreeVars
+    freeVars (CtxtLetSimple vn st ctxt) = freeOfLet st [vn] ctxt
+    freeVars (CtxtLetCont cdef@(Cont vn kt') ctxt) = freeOfLet cdef [vn] ctxt
+    freeVars (CtxtLetFunK fdefs ctxt) =
+        (unionMany (map freeVars fdefs)) `unionFreeVars` (restrictFree ctxt (map fname fdefs))
+      where
+        fname (Fun n _) = n
+    freeVars (CtxtAssert vn1 vn2 _ ctxt) = unionMany [freeVars ctxt, FreeVars $ Set.fromList [vn1, vn2]]
 
 -- todo: eliminate redundancy in code ; 2018-01-25 ; aa
 
-
 --------------------------------------------------
 -- REWRITES
 --------------------------------------------------
@@ -273,20 +232,18 @@ instance FreeNames Context where
 betaContPred (LetRet _ _) = True
 betaContPred _ = False
 
-
 betaCont :: KTerm -> KTerm
 betaCont (LetRet cdef@(Cont xn kt) kt') =
-  let cdef' = walk betaContPred betaCont cdef
-  in
-    case matchterm kt' PatReturn of
-                  Just (ctxt, KontReturn yn) ->
-                       let kt'' = let subst = Subst ( Map.fromList ([(xn, yn)] ) )
-                                  in reconstructTerm ctxt (apply subst kt)
-                       in if retUnchanged ctxt
-                          then kt''
-                          else LetRet cdef' kt''
-                  _ -> LetRet cdef'  (walk betaContPred betaCont kt')
-
+    let cdef' = walk betaContPred betaCont cdef
+     in case matchterm kt' PatReturn of
+            Just (ctxt, KontReturn yn) ->
+                let kt'' =
+                        let subst = Subst (Map.fromList ([(xn, yn)]))
+                         in reconstructTerm ctxt (apply subst kt)
+                 in if retUnchanged ctxt
+                        then kt''
+                        else LetRet cdef' kt''
+            _ -> LetRet cdef' (walk betaContPred betaCont kt')
 betaCont _ = error "should not be called here"
 
 --------------------------------------------------
@@ -303,77 +260,65 @@ deadContPred _ = False
 --            let cdef' = walk deadContPred deadCont cdef
 --            in LetRet cdef' (walk deadContPred deadCont kt')
 
-
 --------------------------------------------------
 -- β-Fun (-Lin)
 --------------------------------------------------
 
-betaFunPred (LetFun [Fun fn (Unary vn kt')] kt) = True 
-betaFunPred (LetSimple fn (ValSimpleTerm (KAbs (Unary vn kt')))  kt) = True
+betaFunPred (LetFun [Fun fn (Unary vn kt')] kt) = True
+betaFunPred (LetSimple fn (ValSimpleTerm (KAbs (Unary vn kt'))) kt) = True
 betaFunPred _ = False
 
 betaFun :: KTerm -> KTerm
 betaFun (LetFun [Fun fn klam@(Unary xn kt)] kt') =
-  let klam' = walk betaFunPred betaFun klam
-      noChange = LetFun [Fun fn klam'] (walk betaFunPred betaFun kt')
-  in
-     case matchterm kt' (PatFunApply fn) of
-       Just (ctxt, ApplyFun _ yn) ->
-          let kt'' = let subst = Subst (Map.fromList [(xn, yn)])
-                     in reconstructTerm ctxt (apply subst kt)
-              FreeVars ( freeVsCtxt ) = freeVars ctxt
-              FreeVars ( freeVsKt ) = freeVars kt
-
-          in if (not (Set.member fn (freeVsCtxt `Set.union` freeVsKt))) && ( fn /= yn)
-             then kt''
-             else noChange
-       _ -> noChange
-
-
-betaFun (LetSimple fn (ValSimpleTerm (KAbs klam@(Unary xn kt))) kt') = 
-  let klam' = walk betaFunPred betaFun klam
-      noChange = LetSimple fn (ValSimpleTerm (KAbs klam')) (walk betaFunPred betaFun kt')
-  in
-     case matchterm kt' (PatFunApply fn) of
-       Just (ctxt, ApplyFun _ yn) ->
-          let kt'' = let subst = Subst (Map.fromList [(xn, yn)])
-                     in reconstructTerm ctxt (apply subst kt)
-              FreeVars ( freeVsCtxt ) = freeVars ctxt
-              FreeVars ( freeVsKt ) = freeVars kt
-
-          in if (not (Set.member fn (freeVsCtxt `Set.union` freeVsKt))) && ( fn /= yn)
-             then kt''
-             else noChange
-       _ -> noChange
-
-
-
+    let klam' = walk betaFunPred betaFun klam
+        noChange = LetFun [Fun fn klam'] (walk betaFunPred betaFun kt')
+     in case matchterm kt' (PatFunApply fn) of
+            Just (ctxt, ApplyFun _ yn) ->
+                let kt'' =
+                        let subst = Subst (Map.fromList [(xn, yn)])
+                         in reconstructTerm ctxt (apply subst kt)
+                    FreeVars (freeVsCtxt) = freeVars ctxt
+                    FreeVars (freeVsKt) = freeVars kt
+                 in if (not (Set.member fn (freeVsCtxt `Set.union` freeVsKt))) && (fn /= yn)
+                        then kt''
+                        else noChange
+            _ -> noChange
+betaFun (LetSimple fn (ValSimpleTerm (KAbs klam@(Unary xn kt))) kt') =
+    let klam' = walk betaFunPred betaFun klam
+        noChange = LetSimple fn (ValSimpleTerm (KAbs klam')) (walk betaFunPred betaFun kt')
+     in case matchterm kt' (PatFunApply fn) of
+            Just (ctxt, ApplyFun _ yn) ->
+                let kt'' =
+                        let subst = Subst (Map.fromList [(xn, yn)])
+                         in reconstructTerm ctxt (apply subst kt)
+                    FreeVars (freeVsCtxt) = freeVars ctxt
+                    FreeVars (freeVsKt) = freeVars kt
+                 in if (not (Set.member fn (freeVsCtxt `Set.union` freeVsKt))) && (fn /= yn)
+                        then kt''
+                        else noChange
+            _ -> noChange
 betaFun _ = error "this should not be called"
 
-
 --------------------------------------------------
 -- putting it all together ...
 
-
-
-contextualRewrites = [ (betaFunPred, betaFun)
-                     , (betaContPred, betaCont)
-                     -- ,(deadContPred, deadCont)
-                     ]
-
+contextualRewrites =
+    [ (betaFunPred, betaFun)
+    , (betaContPred, betaCont)
+    -- ,(deadContPred, deadCont)
+    ]
 
 ktWalk :: KTerm -> KTerm
 ktWalk kt =
-   let rewrites = 
-          map (\(pred, f) -> walk pred f) contextualRewrites
-   in
-    foldl (\t rwrt -> rwrt t) kt rewrites
-
+    let rewrites =
+            map (\(pred, f) -> walk pred f) contextualRewrites
+     in foldl (\t rwrt -> rwrt t) kt rewrites
 
 ktWalkFix kt =
     let kt' = ktWalk kt
-    in if kt' == kt then kt
-       else ktWalkFix kt'
+     in if kt' == kt
+            then kt
+            else ktWalkFix kt'
 
 rewrite :: Prog -> Prog
 rewrite (Prog atoms kterm) = Prog atoms (ktWalkFix kterm)
diff --git a/compiler/src/ShowIndent.hs b/compiler/src/ShowIndent.hs
index a718773b..a4438729 100644
--- a/compiler/src/ShowIndent.hs
+++ b/compiler/src/ShowIndent.hs
@@ -1,5 +1,4 @@
 module ShowIndent where
 
 class ShowIndent a where
-  showIndent :: Int -> a -> String
-  
+    showIndent :: Int -> a -> String
diff --git a/compiler/src/Stack.hs b/compiler/src/Stack.hs
index 6427a452..81139f52 100644
--- a/compiler/src/Stack.hs
+++ b/compiler/src/Stack.hs
@@ -1,178 +1,177 @@
 {-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
-
-module Stack 
+module Stack
 where
 
-
 import qualified Basics
-import           RetCPS (VarName (..))
-import           IR ( Identifier(..)
-                    , VarAccess(..), HFN (..), Fields (..), Ident
-                    , ppId,ppFunCall,ppArgs
-                    )
+import IR (
+    Fields (..),
+    HFN (..),
+    Ident,
+    Identifier (..),
+    VarAccess (..),
+    ppArgs,
+    ppFunCall,
+    ppId,
+ )
 import qualified IR (FunDef (..))
-import Raw (RawExpr (..), RawType(..), RawVar (..), MonComponent(..),
-            ppRawExpr, Assignable (..), Consts, ppConsts, RTAssertion(..), ppRTAssertion)
-
-import qualified Core                      as C
-import qualified RetCPS                    as CPS
-
-
-import           Control.Monad.Except
-import           Control.Monad.Reader
-import           Control.Monad.RWS
-import           Control.Monad.State
-import           Control.Monad.Writer
-import           Data.List
-import qualified Data.ByteString           as BS
-
-import           CompileMode
-import           Text.PrettyPrint.HughesPJ (hsep, nest, text, vcat, ($$), (<+>))
+import Raw (
+    Assignable (..),
+    Consts,
+    MonComponent (..),
+    RTAssertion (..),
+    RawExpr (..),
+    RawType (..),
+    RawVar (..),
+    ppConsts,
+    ppRTAssertion,
+    ppRawExpr,
+ )
+import RetCPS (VarName (..))
+
+import qualified Core as C
+import qualified RetCPS as CPS
+
+import Control.Monad.Except
+import Control.Monad.RWS
+import Control.Monad.Reader
+import Control.Monad.State
+import Control.Monad.Writer
+import qualified Data.ByteString as BS
+import Data.List
+
+import CompileMode
+import Text.PrettyPrint.HughesPJ (hsep, nest, text, vcat, ($$), (<+>))
 import qualified Text.PrettyPrint.HughesPJ as PP
-import           TroupePositionInfo
-
-
+import TroupePositionInfo
 
 data StackBBTree = BB [StackInst] StackTerminator deriving (Eq, Show)
 
-
-
 data StackTerminator
-  = TailCall RawVar
-  | Ret 
-  | If RawVar StackBBTree StackBBTree
-  | LibExport VarAccess
-  | Error RawVar PosInf
-  | Call  StackBBTree StackBBTree
-  deriving (Eq, Show)
-
-
+    = TailCall RawVar
+    | Ret
+    | If RawVar StackBBTree StackBBTree
+    | LibExport VarAccess
+    | Error RawVar PosInf
+    | Call StackBBTree StackBBTree
+    deriving (Eq, Show)
 
 type StackPos = Int
-data EscapesBlock = NotEscaping
-            | Escaping StackPos
-            deriving (Eq, Show)
-
+data EscapesBlock
+    = NotEscaping
+    | Escaping StackPos
+    deriving (Eq, Show)
 
 data RawAssignType = AssignConst | AssignLet | AssignMut deriving (Eq, Ord, Show)
 
-
 data StackInst
-  = AssignRaw RawAssignType RawVar RawExpr
-  | LabelGroup [StackInst]
-  | AssignLVal VarName RawExpr
-  | FetchStack Assignable StackPos
-  | StoreStack Assignable StackPos
-  | SetState MonComponent RawVar 
-  | SetBranchFlag 
-  | InvalidateSparseBit
-  | MkFunClosures [(VarName, VarAccess)] [(VarName, HFN)]
-  | RTAssertion RTAssertion
-   deriving (Eq, Show)
+    = AssignRaw RawAssignType RawVar RawExpr
+    | LabelGroup [StackInst]
+    | AssignLVal VarName RawExpr
+    | FetchStack Assignable StackPos
+    | StoreStack Assignable StackPos
+    | SetState MonComponent RawVar
+    | SetBranchFlag
+    | InvalidateSparseBit
+    | MkFunClosures [(VarName, VarAccess)] [(VarName, HFN)]
+    | RTAssertion RTAssertion
+    deriving (Eq, Show)
 
 -- Function definition
-data FunDef = FunDef 
-                    HFN         -- name of the function     
-                    Int         -- frame size     
-                    Raw.Consts      -- constant literars
-                    StackBBTree    -- body
-                    IR.FunDef    -- original definition for serialization
-                deriving (Eq)
-
--- An IR program is just a collection of atoms declarations 
+data FunDef
+    = FunDef
+        HFN -- name of the function
+        Int -- frame size
+        Raw.Consts -- constant literars
+        StackBBTree -- body
+        IR.FunDef -- original definition for serialization
+    deriving (Eq)
+
+-- An IR program is just a collection of atoms declarations
 -- and function definitions
-data StackProgram = StackProgram C.Atoms [FunDef] 
+data StackProgram = StackProgram C.Atoms [FunDef]
 
-data StackUnit 
-  = FunStackUnit FunDef 
-  | AtomStackUnit C.Atoms 
-  | ProgramStackUnit StackProgram
+data StackUnit
+    = FunStackUnit FunDef
+    | AtomStackUnit C.Atoms
+    | ProgramStackUnit StackProgram
 
 -----------------------------------------------------------
 -- PRETTY PRINTING
 -----------------------------------------------------------
 
 ppProg (StackProgram atoms funs) =
-  vcat $ (map ppFunDef funs)
+    vcat $ (map ppFunDef funs)
 
 instance Show StackProgram where
-  show = PP.render.ppProg
-
-ppFunDef ( FunDef hfn _ consts insts _ )
-  = vcat [ text "func" <+> ppFunCall (ppId hfn) [] <+> text "{"
-         , nest 2 (ppConsts consts)
-         , nest 2 (ppBB insts)
-         , text "}"]
-
+    show = PP.render . ppProg
 
+ppFunDef (FunDef hfn _ consts insts _) =
+    vcat
+        [ text "func" <+> ppFunCall (ppId hfn) [] <+> text "{"
+        , nest 2 (ppConsts consts)
+        , nest 2 (ppBB insts)
+        , text "}"
+        ]
 
 qqFields fields =
-  PP.hsep $ PP.punctuate (text ",") (map ppField fields)
-    where 
-      ppField (name, v) = 
+    PP.hsep $ PP.punctuate (text ",") (map ppField fields)
+  where
+    ppField (name, v) =
         PP.hcat [PP.text name, PP.text "=", ppId v]
 
 ppEsc esc =
-  case esc of 
-    NotEscaping -> PP.empty
-    Escaping x -> PP.text "*" <+> PP.text (show x )
-
+    case esc of
+        NotEscaping -> PP.empty
+        Escaping x -> PP.text "*" <+> PP.text (show x)
 
 ppIR :: StackInst -> PP.Doc
 ppIR SetBranchFlag = text "<setbranchflag>"
 ppIR InvalidateSparseBit = text "<invalidate sparse bit>"
-ppIR (AssignRaw  _ vn st) = ppId vn <+> text "=" <+> ppRawExpr st
-ppIR (AssignLVal vn expr) = 
-  ppId vn <+> text "=" <+> ppRawExpr expr
+ppIR (AssignRaw _ vn st) = ppId vn <+> text "=" <+> ppRawExpr st
+ppIR (AssignLVal vn expr) =
+    ppId vn <+> text "=" <+> ppRawExpr expr
 ppIR (RTAssertion a) = ppRTAssertion a
-
-ppIR (SetState comp v) = 
-  ppId comp <+> text "<-" <+> ppId v
-ppIR (FetchStack x i) = 
-  ppId x <+> text "<- $STACK[" PP.<> text (show i) PP.<> text "]"
-ppIR (StoreStack x i) = 
-  text "$STACK[" PP.<> text (show i) PP.<> text "] = " <+> ppId x 
-
-
-ppIR (MkFunClosures varmap fdefs) = 
+ppIR (SetState comp v) =
+    ppId comp <+> text "<-" <+> ppId v
+ppIR (FetchStack x i) =
+    ppId x <+> text "<- $STACK[" PP.<> text (show i) PP.<> text "]"
+ppIR (StoreStack x i) =
+    text "$STACK[" PP.<> text (show i) PP.<> text "] = " <+> ppId x
+ppIR (MkFunClosures varmap fdefs) =
     let vs = hsepc $ ppEnvIds varmap
-        ppFdefs = map (\((VN x), HFN y) ->  text x <+> text "= mkClos" <+> text y ) fdefs 
+        ppFdefs = map (\((VN x), HFN y) -> text x <+> text "= mkClos" <+> text y) fdefs
      in text "with env:=" <+> PP.brackets vs $$ nest 2 (vcat ppFdefs)
-    where ppEnvIds ls =
-            map (\(a,b) -> (ppId a) PP.<+> text "->" <+> ppId b ) ls
-          hsepc ls = PP.hsep (PP.punctuate (text ",") ls)
-
-    
-ppIR (LabelGroup insts) = 
- text "group" $$ nest 2 (vcat (map ppIR insts))
+  where
+    ppEnvIds ls =
+        map (\(a, b) -> (ppId a) PP.<+> text "->" <+> ppId b) ls
+    hsepc ls = PP.hsep (PP.punctuate (text ",") ls)
+ppIR (LabelGroup insts) =
+    text "group" $$ nest 2 (vcat (map ppIR insts))
 
 ppTr (Call bb1 bb2) = (text "= call" $$ nest 2 (ppBB bb1)) $$ (ppBB bb2)
-
-
--- ppTr (AssertElseError va ir va2 _) 
+-- ppTr (AssertElseError va ir va2 _)
 --   = text "assert" <+> PP.parens (ppId va) <+>
 --     text "{" $$
 --     nest 2 (ppBB ir) $$
 --     text "}" $$
 --     text "elseError" <+> (ppId va2)
 
-
-ppTr (If va ir1 ir2)
-  = text "if" <+> PP.parens (ppId va) <+>
-    text "{" $$
-    nest 2 (ppBB ir1) $$
-    text "}" $$
-    text "else {" $$
-    nest 2 (ppBB ir2) $$
-    text "}"
-ppTr (TailCall va1 ) = ppFunCall (text "tail") [ppId va1]
-ppTr (Ret)  = ppFunCall (text "ret") []
+ppTr (If va ir1 ir2) =
+    text "if"
+        <+> PP.parens (ppId va)
+        <+> text "{"
+        $$ nest 2 (ppBB ir1)
+        $$ text "}"
+        $$ text "else {"
+        $$ nest 2 (ppBB ir2)
+        $$ text "}"
+ppTr (TailCall va1) = ppFunCall (text "tail") [ppId va1]
+ppTr (Ret) = ppFunCall (text "ret") []
 ppTr (LibExport va) = ppFunCall (text "export") [ppId va]
-ppTr (Error va _)  = (text "error") <> (ppId va)
-
+ppTr (Error va _) = (text "error") <> (ppId va)
 
 ppBB (BB insts tr) = vcat $ (map ppIR insts) ++ [ppTr tr]
diff --git a/compiler/src/Stack2JS.hs b/compiler/src/Stack2JS.hs
index 5717b99f..4f53f982 100644
--- a/compiler/src/Stack2JS.hs
+++ b/compiler/src/Stack2JS.hs
@@ -1,4 +1,5 @@
-{-- 
+{-# LANGUAGE DeriveGeneric #-}
+{--
 Translation from Stack to JS code.
 The names of most runtime functions are specified at the respective place here.
 However, those for 'RTAssertion' are defined via 'ppRTAssertion'.
@@ -7,313 +8,340 @@ TODO
 - Port the code for serialization (AA; 2020-12-04)
 
 --}
-
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
 module Stack2JS where
--- import qualified IR2JS 
 
-import IR (SerializationUnit(..), HFN(..)
-          , ppFunCall, ppArgs, Fields (..), Ident
-          , serializeFunDef
-          , serializeAtoms )
+-- import qualified IR2JS
+
 import qualified Data.ByteString.Lazy.Char8 as BL
+import IR (
+    Fields (..),
+    HFN (..),
+    Ident,
+    SerializationUnit (..),
+    ppArgs,
+    ppFunCall,
+    serializeAtoms,
+    serializeFunDef,
+ )
 import qualified IR
 import qualified Raw
 
-import Raw (RawExpr (..), RawType(..), RawVar (..), MonComponent(..), RTAssertion(..),
-            ppRawExpr, ppRTAssertionCode)
+import Raw (
+    MonComponent (..),
+    RTAssertion (..),
+    RawExpr (..),
+    RawType (..),
+    RawVar (..),
+    ppRTAssertionCode,
+    ppRawExpr,
+ )
 
 import Stack
 
+import Basics (BinOp (..), UnaryOp (..))
 import qualified Basics
-import           Basics(BinOp(..), UnaryOp(..))
+import CompileMode
+import Control.Monad.RWS
+import Control.Monad.Reader
+import Control.Monad.State
+import Control.Monad.Writer
+import Core (ppLit)
 import qualified Core as C
-import           Core (ppLit)
-import           RetCPS(VarName(..))
-import qualified RetCPS as CPS
-import           Control.Monad.RWS
-import           Control.Monad.State
-import           Control.Monad.Writer
-import           Control.Monad.Reader
-import           Data.List
-import qualified Data.Text as T
-import           Data.Text.Encoding
-import           Data.ByteString.Lazy (ByteString)
-import           Data.ByteString.Base64 (encode,decode)
-import           CompileMode
-import           TroupePositionInfo
 import qualified Data.Aeson as Aeson
-import           GHC.Generics (Generic)
-
+import Data.ByteString.Base64 (decode, encode)
+import Data.ByteString.Lazy (ByteString)
+import Data.List
+import qualified Data.Text as T
+import Data.Text.Encoding
+import GHC.Generics (Generic)
+import RetCPS (VarName (..))
+import qualified RetCPS as CPS
+import TroupePositionInfo
 
-import qualified Text.PrettyPrint.HughesPJ as PP
-import Text.PrettyPrint.HughesPJ (
-    (<+>), ($$), text, hsep, vcat, nest)
-import Data.Aeson (ToJSON(toJSON), Value)
 import DCLabels (dcLabelExpToDCLabel)
-
+import Data.Aeson (ToJSON (toJSON), Value)
+import Text.PrettyPrint.HughesPJ (
+    hsep,
+    nest,
+    text,
+    vcat,
+    ($$),
+    (<+>),
+ )
+import qualified Text.PrettyPrint.HughesPJ as PP
 
 data LibAccess = LibAccess Basics.LibName Basics.VarName
-   deriving (Eq, Show,Generic)
-
+    deriving (Eq, Generic, Show)
 
-data JSOutput = JSOutput { libs :: [LibAccess] 
-                         , fname:: Maybe String 
-                         , code :: String 
-                         , atoms :: [Basics.AtomName]
-                         } deriving (Show, Generic)
+data JSOutput = JSOutput
+    { libs :: [LibAccess]
+    , fname :: Maybe String
+    , code :: String
+    , atoms :: [Basics.AtomName]
+    }
+    deriving (Generic, Show)
 
-instance Aeson.ToJSON Basics.LibName 
+instance Aeson.ToJSON Basics.LibName
 instance Aeson.ToJSON LibAccess
 instance Aeson.ToJSON JSOutput
 
 ppLibAccess :: LibAccess -> PP.Doc
-ppLibAccess (LibAccess (Basics.LibName libname) varname) = PP.braces $
-  PP.text "lib:" <+> (PP.doubleQuotes. PP.text) libname <+> PP.text "," <+>
-  PP.text "decl:" <+> (PP.doubleQuotes. PP.text) varname
-
+ppLibAccess (LibAccess (Basics.LibName libname) varname) =
+    PP.braces $
+        PP.text "lib:"
+            <+> (PP.doubleQuotes . PP.text) libname
+            <+> PP.text ","
+            <+> PP.text "decl:"
+            <+> (PP.doubleQuotes . PP.text) varname
 
 ppLibs :: [LibAccess] -> PP.Doc
-ppLibs libs = PP.brackets $
-                vcat $ PP.punctuate (text ",")
-                  $ map ppLibAccess (nub libs)
-
-jsLoadLibs = vcat $ map text [
-  "this.libSet = new Set ()",
-  "this.libs = []",
-  "this.addLib = function (lib, decl) { if (!this.libSet.has (lib +'.'+decl)) { this.libSet.add (lib +'.'+decl); this.libs.push ({lib:lib, decl:decl})} }",
-  "this.loadlibs = function (cb) { rt.linkLibs (this.libs, this, cb) }" ]
-                            
-      
+ppLibs libs =
+    PP.brackets $
+        vcat $
+            PP.punctuate (text ",") $
+                map ppLibAccess (nub libs)
+
+jsLoadLibs =
+    vcat $
+        map
+            text
+            [ "this.libSet = new Set ()"
+            , "this.libs = []"
+            , "this.addLib = function (lib, decl) { if (!this.libSet.has (lib +'.'+decl)) { this.libSet.add (lib +'.'+decl); this.libs.push ({lib:lib, decl:decl})} }"
+            , "this.loadlibs = function (cb) { rt.linkLibs (this.libs, this, cb) }"
+            ]
+
 addOneLib (LibAccess (Basics.LibName libname) varname) =
-  let args = (PP.doubleQuotes.PP.text) libname <+> text "," <+> (PP.doubleQuotes. PP.text) varname
-  in text "this.addLib " <+> PP.parens args
+    let args = (PP.doubleQuotes . PP.text) libname <+> text "," <+> (PP.doubleQuotes . PP.text) varname
+     in text "this.addLib " <+> PP.parens args
 
 addLibs xs = vcat $ nub (map addOneLib xs)
 
-
-data TheState = TheState { freshCounter :: Integer
-                         , frameSize    :: Int
-                         , sparseSlot    :: Int
-                         , consts       :: Raw.Consts
-                         , stHFN        :: IR.HFN }
+data TheState = TheState
+    { freshCounter :: Integer
+    , frameSize :: Int
+    , sparseSlot :: Int
+    , consts :: Raw.Consts
+    , stHFN :: IR.HFN
+    }
 
 type RetKontText = PP.Doc
 
-type W = RWS Bool  ([LibAccess], [Basics.AtomName], [RetKontText]) TheState
-
-
-initState = TheState { freshCounter = 0
-                     , frameSize = error "frameSize should not be accessed yet"
-                     , sparseSlot = error "sparseSlot should not be accessed yet"
-                     , consts = error "consts should not be accessed yet"
-                     , stHFN = error "stHFN should not be accessed yet"
-                     }
-
-a $$+ b  = a $$ (nest 2 b)
+type W = RWS Bool ([LibAccess], [Basics.AtomName], [RetKontText]) TheState
 
+initState =
+    TheState
+        { freshCounter = 0
+        , frameSize = error "frameSize should not be accessed yet"
+        , sparseSlot = error "sparseSlot should not be accessed yet"
+        , consts = error "consts should not be accessed yet"
+        , stHFN = error "stHFN should not be accessed yet"
+        }
 
+a $$+ b = a $$ (nest 2 b)
 
 class Identifier a where
-  ppId :: a ->  PP.Doc
-
+    ppId :: a -> PP.Doc
 
 instance Identifier VarName where
-  ppId = IR.ppVarName
+    ppId = IR.ppVarName
 
 -- instance Identifier IR.VarAccess where
 --   ppId = IR.ppVarAccess
 
 instance Identifier HFN where
-  ppId (HFN n) = text n
+    ppId (HFN n) = text n
 
-instance Identifier Basics.LibName where 
-  ppId (Basics.LibName s) = text s
+instance Identifier Basics.LibName where
+    ppId (Basics.LibName s) = text s
 
-instance Identifier Basics.AtomName where 
-  ppId = text
+instance Identifier Basics.AtomName where
+    ppId = text
 
-instance Identifier RawVar where 
-  ppId (RawVar x) = text x
+instance Identifier RawVar where
+    ppId (RawVar x) = text x
 
-instance Identifier Raw.Assignable where 
-  ppId (Raw.AssignableRaw x) = ppId x 
-  ppId (Raw.AssignableLVal x) = ppId x 
-  ppId (Raw.Env) = text "$env"
+instance Identifier Raw.Assignable where
+    ppId (Raw.AssignableRaw x) = ppId x
+    ppId (Raw.AssignableLVal x) = ppId x
+    ppId (Raw.Env) = text "$env"
 
 -- | Translation monad collecting the generated JS parts when passing through the 'StackProgram' tree.
 class ToJS a where
-   toJS :: a -> W PP.Doc
-
-
+    toJS :: a -> W PP.Doc
 
 irProg2JSString :: CompileMode -> Bool -> StackProgram -> String
 irProg2JSString compileMode debugOut ir =
-  let (fns, _, (_,_,konts)) = runRWS (toJS ir) debugOut initState
-      inner = vcat (fns:konts)
-      outer = vcat $
-        stdlib
-        ++
-        [ "function" <+> ppNamespaceName <+> text "(rt) {" ]
-        ++
-        [ nest 2 inner
-        , text "}" ]
-        ++
-        suffix
-  in      
-    PP.render $
-      case compileMode of
-         Normal -> outer
-         Export -> inner
-
+    let (fns, _, (_, _, konts)) = runRWS (toJS ir) debugOut initState
+        inner = vcat (fns : konts)
+        outer =
+            vcat $
+                stdlib
+                    ++ ["function" <+> ppNamespaceName <+> text "(rt) {"]
+                    ++ [ nest 2 inner
+                       , text "}"
+                       ]
+                    ++ suffix
+     in PP.render $
+            case compileMode of
+                Normal -> outer
+                Export -> inner
 
 stack2JSString :: StackUnit -> String
 stack2JSString x =
-  let (inner, _, (libs, atoms, konts)) = runRWS (toJS x) False initState
-  in PP.render (addLibs libs $$ (vcat (inner:konts)))
-
-
+    let (inner, _, (libs, atoms, konts)) = runRWS (toJS x) False initState
+     in PP.render (addLibs libs $$ (vcat (inner : konts)))
 
 stack2JSON :: StackUnit -> ByteString
 stack2JSON (ProgramStackUnit _) = error "needs to be ported"
-stack2JSON x = 
-  let (inner, _, (libs, atoms, konts)) = runRWS (toJS x) False initState
-  in Aeson.encode $ JSOutput { libs = libs
-                             , fname = case x of FunStackUnit (FunDef (HFN n)_ _ _ _) -> Just n
-                                                 _ -> Nothing
-                             , atoms = atoms                              
-                             , code = PP.render (addLibs libs $$ (vcat (inner:konts))) 
-                             } 
-
+stack2JSON x =
+    let (inner, _, (libs, atoms, konts)) = runRWS (toJS x) False initState
+     in Aeson.encode $
+            JSOutput
+                { libs = libs
+                , fname = case x of
+                    FunStackUnit (FunDef (HFN n) _ _ _ _) -> Just n
+                    _ -> Nothing
+                , atoms = atoms
+                , code = PP.render (addLibs libs $$ (vcat (inner : konts)))
+                }
 
 instance ToJS StackUnit where
-  toJS (FunStackUnit fdecl) = toJS fdecl
-  toJS (AtomStackUnit ca) = toJS ca
-  toJS (ProgramStackUnit p) = error "not implemented"
-
-instance ToJS IR.VarAccess where 
-  toJS (IR.VarLocal vn) = return $ IR.ppVarName vn 
-  toJS (IR.VarEnv vn) = return $ text "$env." PP.<> (IR.ppVarName vn)
-  toJS (IR.VarFunSelfRef) = do 
-    HFN (fname) <- gets stHFN 
-    return $ text fname 
-
-
--- instance (Identifier a) => ToJS a where 
+    toJS (FunStackUnit fdecl) = toJS fdecl
+    toJS (AtomStackUnit ca) = toJS ca
+    toJS (ProgramStackUnit p) = error "not implemented"
+
+instance ToJS IR.VarAccess where
+    toJS (IR.VarLocal vn) = return $ IR.ppVarName vn
+    toJS (IR.VarEnv vn) = return $ text "$env." PP.<> (IR.ppVarName vn)
+    toJS (IR.VarFunSelfRef) = do
+        HFN (fname) <- gets stHFN
+        return $ text fname
+
+-- instance (Identifier a) => ToJS a where
 --   toJS x = return $ ppId x
 
-ppNamespaceName = text "Top"  -- should be generating a new namespace per received blob
-
+ppNamespaceName = text "Top" -- should be generating a new namespace per received blob
 
 irProg2JsWrapped prog = do
     inner <- toJS prog
     return $
-       text "function" <+> ppNamespaceName <+> text "(rt) {"
-       $$ nest 2 inner
-       $$ text "}"
-
-
+        text "function" <+> ppNamespaceName <+> text "(rt) {"
+            $$ nest 2 inner
+            $$ text "}"
 
 instance ToJS StackProgram where
-  toJS (StackProgram atoms funs) = do
-     jjA <- toJS atoms
-     (jjF, (libsF, atoms', _)) <- listen $ mapM toJS funs
-     
-     return $
-          vcat $ [ jsLoadLibs
-                 , addLibs libsF
-                 , jjA
-                 ] ++ jjF
-
-          
+    toJS (StackProgram atoms funs) = do
+        jjA <- toJS atoms
+        (jjF, (libsF, atoms', _)) <- listen $ mapM toJS funs
 
+        return $
+            vcat $
+                [ jsLoadLibs
+                , addLibs libsF
+                , jjA
+                ]
+                    ++ jjF
 
 instance ToJS C.Atoms where
-  toJS catoms@(C.Atoms atoms) = return $
-    vcat [ vcat $ (map  (\a -> hsep ["const"
-                                    , text a
-                                    , "= new rt.Atom"
-                                                  , (PP.parens ( (PP.doubleQuotes.text) a))]) atoms)
-         , text "this.serializedatoms =" <+> (pickle.serializeAtoms) catoms]
-
+    toJS catoms@(C.Atoms atoms) =
+        return $
+            vcat
+                [ vcat $
+                    ( map
+                        ( \a ->
+                            hsep
+                                [ "const"
+                                , text a
+                                , "= new rt.Atom"
+                                , (PP.parens ((PP.doubleQuotes . text) a))
+                                ]
+                        )
+                        atoms
+                    )
+                , text "this.serializedatoms =" <+> (pickle . serializeAtoms) catoms
+                ]
 
 jsonValueToString :: Value -> String
 jsonValueToString val = BL.unpack (Aeson.encode val)
 
 lit2JS C.LUnit = text "rt.__unitbase"
 lit2JS (C.LLabel s) = text "rt.mkV1Label" <> (PP.parens . PP.doubleQuotes) (text s)
-lit2JS (C.LDCLabel dc) = 
-  text "rt.mkDCLabel" <> (PP.parens.text.jsonValueToString.toJSON.dcLabelExpToDCLabel) dc 
-
+lit2JS (C.LDCLabel dc) =
+    text "rt.mkDCLabel" <> (PP.parens . text . jsonValueToString . toJSON . dcLabelExpToDCLabel) dc
 lit2JS lit = ppLit lit
 
-constsToJS consts = 
-     vcat $ map toJsConst consts 
-               where toJsConst (x,lit) = hsep ["const", ppId x , text "=", lit2JS lit ]
+constsToJS consts =
+    vcat $ map toJsConst consts
+  where
+    toJsConst (x, lit) = hsep ["const", ppId x, text "=", lit2JS lit]
 
-instance ToJS FunDef where 
+instance ToJS FunDef where
     toJS fdef@(FunDef hfn stacksize consts bb irfdef) = do
-       {--
-          |  |  | ... | <sparse slot> | 
-          ^           ^
-          |           |
-          SP          stacksize 
-       
-       --}       
-       let _frameSize = stacksize + 1 
-
-       modify (\s -> s { frameSize = _frameSize, sparseSlot = stacksize, stHFN = hfn, consts = consts } ) -- + 1 for the sparse flag; 2021-03-17; AA
-       let lits = constsToJS consts
-       jj <- toJS bb
-       debug <- ask
-       let (irdeps, libdeps, atomdeps ) = IR.ppDeps irfdef
-       sparseSlotIdxPP <- ppSparseSlotIdx
-
-       return $
-          vcat [text "this." PP.<>  ppId hfn <+> text "=" <+> ppArgs ["$env"] <+> text "=> {"
-               , if debug then nest 2 $ text "rt.debug" <+> (PP.parens . PP.doubleQuotes.  ppId) hfn
-                          else PP.empty 
-               , nest 2 $ vcat $ [ 
-                  "let _T = rt.runtime.$t",
-                  "let _STACK = _T.callStack",
-                  "let _SP = _T._sp",
-                  "let _SP_OLD",
-                  -- Update sparse bit at function entry:
-                  -- Check whether environment's data level, and the label and data level of R0 are bound by PC.
-                  -- Requires sparseSlot to be updated first.
-                  "_T.sparseSlot = " <+> sparseSlotIdxPP,
-                  "_T.updateSparseBitOnEntry($env.__dataLevel)",
-                  lits,
-                  jj]
-               , text "}"
-               , semi $ text "this." PP.<> ppId hfn PP.<> text ".deps =" <+> irdeps
-               , semi $ text "this." PP.<> ppId hfn PP.<> text ".libdeps =" <+> libdeps
-               , semi $ text "this." PP.<> ppId hfn PP.<> text ".serialized =" <+> (pickle.serializeFunDef) irfdef
-               , semi $ text "this." PP.<> ppId hfn PP.<> text ".framesize =" <+> (PP.int stacksize) ]
-
-
-
-instance ToJS StackBBTree where 
---  toJS = bb2js
+        {--
+           |  |  | ... | <sparse slot> |
+           ^           ^
+           |           |
+           SP          stacksize
+
+        --}
+        let _frameSize = stacksize + 1
+
+        modify (\s -> s{frameSize = _frameSize, sparseSlot = stacksize, stHFN = hfn, consts = consts}) -- + 1 for the sparse flag; 2021-03-17; AA
+        let lits = constsToJS consts
+        jj <- toJS bb
+        debug <- ask
+        let (irdeps, libdeps, atomdeps) = IR.ppDeps irfdef
+        sparseSlotIdxPP <- ppSparseSlotIdx
 
-    toJS (BB ins tr) = do
-      jj  <- mapM toJS ins
-      j'  <- toJS tr
-      return $ vcat $ jj ++ [j']
+        return $
+            vcat
+                [ text "this." PP.<> ppId hfn <+> text "=" <+> ppArgs ["$env"] <+> text "=> {"
+                , if debug
+                    then nest 2 $ text "rt.debug" <+> (PP.parens . PP.doubleQuotes . ppId) hfn
+                    else PP.empty
+                , nest 2 $
+                    vcat $
+                        [ "let _T = rt.runtime.$t"
+                        , "let _STACK = _T.callStack"
+                        , "let _SP = _T._sp"
+                        , "let _SP_OLD"
+                        , -- Update sparse bit at function entry:
+                          -- Check whether environment's data level, and the label and data level of R0 are bound by PC.
+                          -- Requires sparseSlot to be updated first.
+                          "_T.sparseSlot = " <+> sparseSlotIdxPP
+                        , "_T.updateSparseBitOnEntry($env.__dataLevel)"
+                        , lits
+                        , jj
+                        ]
+                , text "}"
+                , semi $ text "this." PP.<> ppId hfn PP.<> text ".deps =" <+> irdeps
+                , semi $ text "this." PP.<> ppId hfn PP.<> text ".libdeps =" <+> libdeps
+                , semi $ text "this." PP.<> ppId hfn PP.<> text ".serialized =" <+> (pickle . serializeFunDef) irfdef
+                , semi $ text "this." PP.<> ppId hfn PP.<> text ".framesize =" <+> (PP.int stacksize)
+                ]
+
+instance ToJS StackBBTree where
+    --  toJS = bb2js
 
+    toJS (BB ins tr) = do
+        jj <- mapM toJS ins
+        j' <- toJS tr
+        return $ vcat $ jj ++ [j']
 
 instance ToJS StackInst where
-  toJS = ir2js
+    toJS = ir2js
 
-instance ToJS StackTerminator where 
-  toJS = tr2js
+instance ToJS StackTerminator where
+    toJS = tr2js
 
-binOpToJS :: BinOp -> Raw.UseNativeBinop ->  String
-binOpToJS op (Raw.UseNativeBinop isNative) = case op of 
+binOpToJS :: BinOp -> Raw.UseNativeBinop -> String
+binOpToJS op (Raw.UseNativeBinop isNative) = case op of
     -- JS binary operators (some not implemented in IR2Raw)
     Plus -> "+"
     Minus -> "-"
@@ -365,332 +393,338 @@ unaryOpToJS = \case
 
 {-- INSTRUCTIONS --}
 
-
--- omit _ = PP.empty 
+-- omit _ = PP.empty
 
 ir2js :: StackInst -> W PP.Doc
 ir2js (AssignRaw tt vn e) = do
-  jj <- toJS e
-  let pfx = case tt of 
-               AssignConst -> text "const"
-               AssignLet   -> text "let"
-               AssignMut   -> PP.empty 
-  return $ semi $ pfx <+> ppId vn <+> text "=" <+> jj 
+    jj <- toJS e
+    let pfx = case tt of
+            AssignConst -> text "const"
+            AssignLet -> text "let"
+            AssignMut -> PP.empty
+    return $ semi $ pfx <+> ppId vn <+> text "=" <+> jj
 
 -- Note: Technically this is handled in the same way as 'AssignRaw' (with 'AssignConst'),
 -- because in JS it is just an assignment to a variable.
 -- The only difference to AssignRaw is the type of variable name (here 'VarName', there 'RawVar') (even though both are wrappers for String)
 ir2js (AssignLVal vn cexpr) = do
-  d <- toJS cexpr
-  return $ semi $ ppLet vn <+> d
-
-
-ir2js (FetchStack x i) = return $ 
-   ppLet x <+> text "_STACK[ _SP + " PP.<> text (show i) PP.<> text "]"
-
-ir2js (StoreStack x i) = return $ 
-   text "_STACK[ _SP + " PP.<> text (show i) PP.<> text "] = " <+> ppId x 
-
-
+    d <- toJS cexpr
+    return $ semi $ ppLet vn <+> d
+ir2js (FetchStack x i) =
+    return $
+        ppLet x <+> text "_STACK[ _SP + " PP.<> text (show i) PP.<> text "]"
+ir2js (StoreStack x i) =
+    return $
+        text "_STACK[ _SP + " PP.<> text (show i) PP.<> text "] = " <+> ppId x
 ir2js (MkFunClosures envBindings funBindings) = do
     -- Create new environment
     env <- freshEnvVar
     dd_env_ids <- ppEnvIds env envBindings
-    let ppEnv = vcat [ semi $ hsep [ ppLet env
-                                   , text "new rt.Env()"]
-                     , dd_env_ids]
+    let ppEnv =
+            vcat
+                [ semi $
+                    hsep
+                        [ ppLet env
+                        , text "new rt.Env()"
+                        ]
+                , dd_env_ids
+                ]
     let ppFF = map (\(v, f) -> jsClosure v env f) funBindings
     return $ vcat (ppEnv : ppFF)
-
-       where ppEnvIds :: VarName ->  [(VarName, IR.VarAccess)] -> W PP.Doc
-             ppEnvIds env ls = do 
-               let penv = ppId env 
-               d1 <- mapM (\(a,b) -> do 
-                                  d_b <- toJS b
-                                  return $ semi $ penv PP.<> text "." PP.<> (ppId a) <+> text "=" <+> d_b
-                          ) 
-                          ls
-               d3 <- mapM (\(_, b) -> do 
-                              d_b <- toJS b 
-                              return $ d_b <> text ".dataLevel") ls
-               let d2 = penv PP.<> text ".__dataLevel = " 
-                        <+> jsFunCall (text $ binOpToJS Basics.LatticeJoin (Raw.UseNativeBinop False)) d3
-                                
-               return $ vcat ( d1 ++ [d2])
-             hsepc ls = semi $ PP.hsep (PP.punctuate (text ",") ls)
-
-
+  where
+    ppEnvIds :: VarName -> [(VarName, IR.VarAccess)] -> W PP.Doc
+    ppEnvIds env ls = do
+        let penv = ppId env
+        d1 <-
+            mapM
+                ( \(a, b) -> do
+                    d_b <- toJS b
+                    return $ semi $ penv PP.<> text "." PP.<> (ppId a) <+> text "=" <+> d_b
+                )
+                ls
+        d3 <-
+            mapM
+                ( \(_, b) -> do
+                    d_b <- toJS b
+                    return $ d_b <> text ".dataLevel"
+                )
+                ls
+        let d2 =
+                penv
+                    PP.<> text ".__dataLevel = "
+                    <+> jsFunCall (text $ binOpToJS Basics.LatticeJoin (Raw.UseNativeBinop False)) d3
+
+        return $ vcat (d1 ++ [d2])
+    hsepc ls = semi $ PP.hsep (PP.punctuate (text ",") ls)
 ir2js (SetState c x) = return $ semi $ monStateToJs c <+> "=" <+> ppId x
-
 ir2js (RTAssertion a) = return $ ppRTAssertionCode jsFunCall a
-
 ir2js (LabelGroup ii) = do
-  ii' <- mapM ppLevelOp ii
-  sparseSlot <- ppSparseSlot
-  return $ vcat $
-           [ -- "if (! _T.getSparseBit()) {" -- Alternative, but involves extra call to RT
-             "if (!" <+> sparseSlot <+> ") {"
-           , nest 2 (vcat ii')
-           , text "}"
-           ]
-    where ppLevelOp (AssignRaw tt vn e) = do
-            jj <- toJS e
-            let pfx = if tt == AssignConst then text "const" else PP.empty 
-            return $ semi $ pfx <+> ppId vn <+> text "=" <+> jj 
-          ppLevelOp x = toJS x  
-
-ir2js (SetBranchFlag) = return $
-  text "_T.setBranchFlag()"
-ir2js InvalidateSparseBit = return $
-  text "rt.raw_invalidateSparseBit()"
-
-
+    ii' <- mapM ppLevelOp ii
+    sparseSlot <- ppSparseSlot
+    return $
+        vcat $
+            [ -- "if (! _T.getSparseBit()) {" -- Alternative, but involves extra call to RT
+              "if (!" <+> sparseSlot <+> ") {"
+            , nest 2 (vcat ii')
+            , text "}"
+            ]
+  where
+    ppLevelOp (AssignRaw tt vn e) = do
+        jj <- toJS e
+        let pfx = if tt == AssignConst then text "const" else PP.empty
+        return $ semi $ pfx <+> ppId vn <+> text "=" <+> jj
+    ppLevelOp x = toJS x
+ir2js (SetBranchFlag) =
+    return $
+        text "_T.setBranchFlag()"
+ir2js InvalidateSparseBit =
+    return $
+        text "rt.raw_invalidateSparseBit()"
 
 -- ir2js x = error $ "ir instruction translation not implemented: " ++ (show x)
 
-
 {-- TERMINATORS --}
 
-
 tr2js (Call bb bb2) = do
     _frameSize <- gets frameSize
     _sparseSlot <- gets sparseSlot
     _consts <- gets consts
-    modify (\s -> s {frameSize = 0, sparseSlot = _sparseSlot - _frameSize - 5})
-        -- AA; 2021-04-24; Because 
+    modify (\s -> s{frameSize = 0, sparseSlot = _sparseSlot - _frameSize - 5})
+    -- AA; 2021-04-24; Because
     js <- toJS bb
-    modify (\s -> s { frameSize = _frameSize, sparseSlot = _sparseSlot })
-        -- TODO: AA; 2021-04-24; we should really be using a reader monad here for frame size
-        -- #codedebt
+    modify (\s -> s{frameSize = _frameSize, sparseSlot = _sparseSlot})
+    -- TODO: AA; 2021-04-24; we should really be using a reader monad here for frame size
+    -- #codedebt
     js2 <- toJS bb2
     kname <- freshKontName
     sparseSlotIdxPP <- ppSparseSlotIdx
     let jsKont =
-           vcat ["this." PP.<> ppId kname <+> text "= () => {",
-                  nest 2 $
-                        vcat [
-                          "let _T = rt.runtime.$t",
-                          "let _STACK = _T.callStack",
-                          "let _SP = _T._sp",
-                          -- TODO Do we need this? It seems to be only used zero or one time in the generated places.
+            vcat
+                [ "this." PP.<> ppId kname <+> text "= () => {"
+                , nest 2 $
+                    vcat
+                        [ "let _T = rt.runtime.$t"
+                        , "let _STACK = _T.callStack"
+                        , "let _SP = _T._sp"
+                        , -- TODO Do we need this? It seems to be only used zero or one time in the generated places.
                           -- So we could instead just use the let where it is actually set.
-                          "let _SP_OLD",
-                          -- Check data bound at return point (could have received labelled information or raised).
+                          "let _SP_OLD"
+                        , -- Check data bound at return point (could have received labelled information or raised).
                           -- Requires sparseSlot to be updated first.
-                          "_T.sparseSlot =" <+> sparseSlotIdxPP,
-                          "_T.updateSparseBitOnReturn()",
-                          constsToJS _consts , -- 2021-05-18; TODO: optimize by including only the _used_ constants
-                          js2
-                        ],
-                    "}"
-                    -- debug support; 2021-04-24; AA                    
-                    , "this." PP.<> ppId kname PP.<> text ".debugname = \"" PP.<> ppId kname PP.<> "\""                
-                    ]
-
-
-    tell ([], [], [jsKont] )
-    return $ vcat [
-      "_SP_OLD = _SP; ", -- 2021-04-23; hack ! ;AA
-      "_SP = _SP + " <+> text (show (_frameSize + 5)) <+> ";",
-      "_STACK[_SP - 5] = _SP_OLD;",
-      "_STACK[_SP - 4] = _T.pc;", 
-      "_STACK[_SP - 3] = this." PP.<> ppId kname, 
-      "_STACK[_SP - 2] = _T.mailbox.mclear;", 
-      "_STACK[_SP - 1] = false;",
-      "_T._sp = _SP;", 
-      js
-      ] 
-  --  return $ jsFunCall (text "_T.pushFrame") [ text "this." PP.<> ppId kname, (text.show) _frameSize ] $$ js
-
-
-
+                          "_T.sparseSlot =" <+> sparseSlotIdxPP
+                        , "_T.updateSparseBitOnReturn()"
+                        , constsToJS _consts -- 2021-05-18; TODO: optimize by including only the _used_ constants
+                        , js2
+                        ]
+                , "}"
+                , -- debug support; 2021-04-24; AA
+                  "this." PP.<> ppId kname PP.<> text ".debugname = \"" PP.<> ppId kname PP.<> "\""
+                ]
+
+    tell ([], [], [jsKont])
+    return $
+        vcat
+            [ "_SP_OLD = _SP; " -- 2021-04-23; hack ! ;AA
+            , "_SP = _SP + " <+> text (show (_frameSize + 5)) <+> ";"
+            , "_STACK[_SP - 5] = _SP_OLD;"
+            , "_STACK[_SP - 4] = _T.pc;"
+            , "_STACK[_SP - 3] = this." PP.<> ppId kname
+            , "_STACK[_SP - 2] = _T.mailbox.mclear;"
+            , "_STACK[_SP - 1] = false;"
+            , "_T._sp = _SP;"
+            , js
+            ]
+--  return $ jsFunCall (text "_T.pushFrame") [ text "this." PP.<> ppId kname, (text.show) _frameSize ] $$ js
 
 tr2js (If va bb1 bb2) = do
-  js1 <- toJS bb1
-  js2 <- toJS bb2
-  return $
-    vcat [ 
-      -- jsFunCall (text "rt.branch") [ppId va],
-      text "if" <+> PP.parens ( ppId va) <+> text "{",
-      nest 2 js1,
-      text "} else {",
-      nest 2 js2,
-      text "}"
-    ]
-
-    
-
-tr2js (Ret) = return $
-  jsFunCall (text "return _T.returnImmediate") []
-
-tr2js (Error va pos) = return $
-  (jsFunCall (text "rt.rawErrorPos")) [ppId va, ppPosInfo pos]
-
-tr2js (TailCall va1 ) = return $
-    "return" <+> ppId va1 
-
+    js1 <- toJS bb1
+    js2 <- toJS bb2
+    return $
+        vcat
+            [ -- jsFunCall (text "rt.branch") [ppId va],
+              text "if" <+> PP.parens (ppId va) <+> text "{"
+            , nest 2 js1
+            , text "} else {"
+            , nest 2 js2
+            , text "}"
+            ]
+tr2js (Ret) =
+    return $
+        jsFunCall (text "return _T.returnImmediate") []
+tr2js (Error va pos) =
+    return $
+        (jsFunCall (text "rt.rawErrorPos")) [ppId va, ppPosInfo pos]
+tr2js (TailCall va1) =
+    return $
+        "return" <+> ppId va1
 tr2js (LibExport va) = do
-  d <- toJS va 
-  return $ jsFunCall (text "return") [d]
-
-
-monStateToJs c = 
-  text "_T." PP.<>
-      case c of 
-        MonPC -> text "pc"
-        MonBlock -> text "bl"
-        R0_Val -> text "r0_val"
-        R0_Lev -> text "r0_lev"
-        R0_TLev -> text "r0_tlev"
-
+    d <- toJS va
+    return $ jsFunCall (text "return") [d]
+
+monStateToJs c =
+    text "_T."
+        PP.<> case c of
+            MonPC -> text "pc"
+            MonBlock -> text "bl"
+            R0_Val -> text "r0_val"
+            R0_Lev -> text "r0_lev"
+            R0_TLev -> text "r0_tlev"
 
 ppSparseSlotIdx :: W PP.Doc
 ppSparseSlotIdx = do
-  s <- gets sparseSlot
-  return $ text "_SP + " PP.<+> PP.int s
+    s <- gets sparseSlot
+    return $ text "_SP + " PP.<+> PP.int s
 
-ppSparseSlot :: W PP.Doc 
-ppSparseSlot = do    
-   idx <- ppSparseSlotIdx
-   return $ text "_STACK[ "  PP.<> idx PP.<> text "]"
+ppSparseSlot :: W PP.Doc
+ppSparseSlot = do
+    idx <- ppSparseSlotIdx
+    return $ text "_STACK[ " PP.<> idx PP.<> text "]"
 
 -----------------------------------------------------------
 
-
-fieldToJS :: ToJS a => (String, a) -> W PP.Doc
-fieldToJS (f, v) = do 
-    d <- toJS v 
+fieldToJS :: (ToJS a) => (String, a) -> W PP.Doc
+fieldToJS (f, v) = do
+    d <- toJS v
     return $ PP.brackets $ PP.doubleQuotes (text f) <> text "," <> d
 
-fieldsToJS :: ToJS a => [(String, a)] -> W [PP.Doc]
-fieldsToJS fs = do 
-    dd <- mapM fieldToJS fs 
+fieldsToJS :: (ToJS a) => [(String, a)] -> W [PP.Doc]
+fieldsToJS fs = do
+    dd <- mapM fieldToJS fs
     return $ PP.punctuate (text ",") dd
 
 instance ToJS RawExpr where
-  toJS x = do 
-    HFN (fname) <- gets stHFN
-    let ppFunSelfRef = text "$env." PP.<> ppId fname 
-    let ppVarName IR.VarFunSelfRef = ppFunSelfRef
-        ppVarName x = IR.ppVarAccess x
-        
-    case x of 
-      ProjectState c -> return $ monStateToJs c
-      ProjectLVal IR.VarFunSelfRef lf -> return (
-        case lf of 
-           Raw.FieldValue ->  ppFunSelfRef PP.<> 
-                                text "." PP.<> PP.text (show Raw.FieldValue)
-           Raw.FieldValLev -> monStateToJs MonPC
-           Raw.FieldTypLev -> monStateToJs MonPC)
-      e@(ProjectLVal _ _) -> return $ ppRawExpr e
-      Bin binop use_native va1 va2 -> return $
-        let text' = text (binOpToJS binop use_native) in
-          if isInfixBinop binop use_native
-          then hsep [ ppId va1, text', ppId va2 ]
-          else jsFunCall text' [ppId va1, ppId va2]
-      Un op v -> return $ text (unaryOpToJS op) <> PP.parens (ppId v)
-      Tuple vars -> return $
-        text "rt.mkTuple" <> PP.parens (PP.brackets $ PP.hsep $ PP.punctuate (text ",") (map ppVarName vars))
-      Record fields -> do
-        jsFields <- fieldsToJS fields 
-        return $
-          PP.parens $ text "rt.mkRecord" <> PP.parens (PP.brackets $ PP.hsep $ jsFields )
-      WithRecord r fields -> do 
-        jsFields <- fieldsToJS fields 
-        return $
-          text "rt.withRecord" <> PP.parens (
-            PP.hsep [ppId r, text ",", PP.brackets $ PP.hsep $ jsFields ])
-      ProjField x f -> return $
-        text "rt.getField" <> PP.parens (ppId x <> text "," <>  PP.doubleQuotes (text f ) )
-      ProjIdx x idx -> return $
-        text "rt.raw_indexTuple" <> PP.parens (ppId x <> text "," <>  text (show idx) )
-      List vars -> return $
-        PP.parens $   text "rt.mkList" <> PP.parens (PP.brackets $ PP.hsep $ PP.punctuate (text ",") (map ppVarName vars))
-      ListCons v1 v2 -> return $
-        text "rt.cons" <>  PP.parens (ppVarName v1 <> text "," <> ppId v2)
-      Const C.LUnit -> return $ text "rt.__unitbase"
-      Const (C.LLabel s) -> return $
-        text "rt.mkV1Label" <> (PP.parens . PP.doubleQuotes) (text s)
-      Const lit -> do
-        case lit of
-          C.LAtom atom -> tell ([], [atom], [])
-          _ -> return ()
-        return $ ppLit lit
-      Lib lib'@(Basics.LibName libname) varname -> do
-        tell ([LibAccess lib' varname], [], [])
-        return $
-          text "rt.loadLib" <> PP.parens ((PP.doubleQuotes.text) libname <> text ", " <> (PP.doubleQuotes.text) varname <> text ", this")
-      ConstructLVal r1 r2 r3 -> return $
-        ppFunCall  (text "rt.constructLVal")  (map ppId [r1,r2,r3])
-      Base b -> return $ text "rt." <+> text b -- Note: The "$$authorityarg" case is handled in IR2Raw
-
-
-
+    toJS x = do
+        HFN (fname) <- gets stHFN
+        let ppFunSelfRef = text "$env." PP.<> ppId fname
+        let ppVarName IR.VarFunSelfRef = ppFunSelfRef
+            ppVarName x = IR.ppVarAccess x
+
+        case x of
+            ProjectState c -> return $ monStateToJs c
+            ProjectLVal IR.VarFunSelfRef lf ->
+                return
+                    ( case lf of
+                        Raw.FieldValue ->
+                            ppFunSelfRef
+                                PP.<> text "."
+                                PP.<> PP.text (show Raw.FieldValue)
+                        Raw.FieldValLev -> monStateToJs MonPC
+                        Raw.FieldTypLev -> monStateToJs MonPC
+                    )
+            e@(ProjectLVal _ _) -> return $ ppRawExpr e
+            Bin binop use_native va1 va2 ->
+                return $
+                    let text' = text (binOpToJS binop use_native)
+                     in if isInfixBinop binop use_native
+                            then hsep [ppId va1, text', ppId va2]
+                            else jsFunCall text' [ppId va1, ppId va2]
+            Un op v -> return $ text (unaryOpToJS op) <> PP.parens (ppId v)
+            Tuple vars ->
+                return $
+                    text "rt.mkTuple" <> PP.parens (PP.brackets $ PP.hsep $ PP.punctuate (text ",") (map ppVarName vars))
+            Record fields -> do
+                jsFields <- fieldsToJS fields
+                return $
+                    PP.parens $
+                        text "rt.mkRecord" <> PP.parens (PP.brackets $ PP.hsep $ jsFields)
+            WithRecord r fields -> do
+                jsFields <- fieldsToJS fields
+                return $
+                    text "rt.withRecord"
+                        <> PP.parens
+                            (PP.hsep [ppId r, text ",", PP.brackets $ PP.hsep $ jsFields])
+            ProjField x f ->
+                return $
+                    text "rt.getField" <> PP.parens (ppId x <> text "," <> PP.doubleQuotes (text f))
+            ProjIdx x idx ->
+                return $
+                    text "rt.raw_indexTuple" <> PP.parens (ppId x <> text "," <> text (show idx))
+            List vars ->
+                return $
+                    PP.parens $
+                        text "rt.mkList" <> PP.parens (PP.brackets $ PP.hsep $ PP.punctuate (text ",") (map ppVarName vars))
+            ListCons v1 v2 ->
+                return $
+                    text "rt.cons" <> PP.parens (ppVarName v1 <> text "," <> ppId v2)
+            Const C.LUnit -> return $ text "rt.__unitbase"
+            Const (C.LLabel s) ->
+                return $
+                    text "rt.mkV1Label" <> (PP.parens . PP.doubleQuotes) (text s)
+            Const lit -> do
+                case lit of
+                    C.LAtom atom -> tell ([], [atom], [])
+                    _ -> return ()
+                return $ ppLit lit
+            Lib lib'@(Basics.LibName libname) varname -> do
+                tell ([LibAccess lib' varname], [], [])
+                return $
+                    text "rt.loadLib" <> PP.parens ((PP.doubleQuotes . text) libname <> text ", " <> (PP.doubleQuotes . text) varname <> text ", this")
+            ConstructLVal r1 r2 r3 ->
+                return $
+                    ppFunCall (text "rt.constructLVal") (map ppId [r1, r2, r3])
+            Base b -> return $ text "rt." <+> text b -- Note: The "$$authorityarg" case is handled in IR2Raw
 
 -----------------------------------------------------------
-ppPosInfo :: GetPosInfo a => a -> PP.Doc 
-ppPosInfo  = PP.doubleQuotes . text . show . posInfo
+ppPosInfo :: (GetPosInfo a) => a -> PP.Doc
+ppPosInfo = PP.doubleQuotes . text . show . posInfo
 
-pickle = PP.doubleQuotes.text.T.unpack.decodeUtf8.encode
+pickle = PP.doubleQuotes . text . T.unpack . decodeUtf8 . encode
 stdlib = [] -- "let runtime = require('../runtimeMonitored.js')"]
-suffix  = [ "module.exports = Top "]
-
+suffix = ["module.exports = Top "]
 
 jsClosure var env f =
-     vcat [ ppLet var <+> ((text "rt.mkVal") <> (PP.parens ((text "rt.RawClosure") <> (PP.parens (PP.hsep $ PP.punctuate "," [ppId env, text "this", text "this." PP.<> ppId f])))))
-          , semi $ ppId env PP.<> PP.text "." PP.<> (ppId var ) <+> PP.text "=" <+> ppId var
-          , semi $ ppId env PP.<> PP.text "." PP.<> (ppId var ) PP.<> text ".selfpointer = true"
-          ]
+    vcat
+        [ ppLet var <+> ((text "rt.mkVal") <> (PP.parens ((text "rt.RawClosure") <> (PP.parens (PP.hsep $ PP.punctuate "," [ppId env, text "this", text "this." PP.<> ppId f])))))
+        , semi $ ppId env PP.<> PP.text "." PP.<> (ppId var) <+> PP.text "=" <+> ppId var
+        , semi $ ppId env PP.<> PP.text "." PP.<> (ppId var) PP.<> text ".selfpointer = true"
+        ]
 
-ppLet x =  text "const" <+> ppId x <+> text "="
+ppLet x = text "const" <+> ppId x <+> text "="
 
 semi t = t PP.<> text ";"
 jsFunCall a b = semi $ ppFunCall a b
 
-
 freshEnvVar :: W VarName
 freshEnvVar = do
     k <- gets freshCounter
-    modify (\s -> s { freshCounter = k + 1  } )
-    return $ VN  $ "$$$env" ++ (show k)
-
+    modify (\s -> s{freshCounter = k + 1})
+    return $ VN $ "$$$env" ++ (show k)
 
 freshKontName :: W VarName
 freshKontName = do
     j <- gets freshCounter
     HFN s <- gets stHFN
-    modify (\s -> s { freshCounter = j + 1})
-    return $ VN $  "$$$" ++ s ++ "$$$kont" ++ (show j)
-
+    modify (\s -> s{freshCounter = j + 1})
+    return $ VN $ "$$$" ++ s ++ "$$$kont" ++ (show j)
 
 isInfixBinop :: Basics.BinOp -> Raw.UseNativeBinop -> Bool
-isInfixBinop op (Raw.UseNativeBinop use_native) = case op of 
-  -- Infix
-  Plus -> True
-  Minus -> True
-  Mult -> True
-  Div -> True
-  Mod -> True
-  Le -> True
-  Lt -> True
-  Ge -> True
-  Gt -> True
-  And -> True
-  Or -> True
-  Concat -> True
-  BinAnd -> True
-  BinOr -> True
-  BinXor -> True
-  BinShiftLeft -> True
-  BinShiftRight -> True
-  BinZeroShiftRight -> True
-  -- Flag dependent 
-  Eq -> use_native
-  Neq -> use_native 
-  -- Not infix
-  RaisedTo -> False
-  FlowsTo -> False
-  IntDiv -> False
-  HasField -> False
-  LatticeJoin -> False
-  LatticeMeet -> False
+isInfixBinop op (Raw.UseNativeBinop use_native) = case op of
+    -- Infix
+    Plus -> True
+    Minus -> True
+    Mult -> True
+    Div -> True
+    Mod -> True
+    Le -> True
+    Lt -> True
+    Ge -> True
+    Gt -> True
+    And -> True
+    Or -> True
+    Concat -> True
+    BinAnd -> True
+    BinOr -> True
+    BinXor -> True
+    BinShiftLeft -> True
+    BinShiftRight -> True
+    BinZeroShiftRight -> True
+    -- Flag dependent
+    Eq -> use_native
+    Neq -> use_native
+    -- Not infix
+    RaisedTo -> False
+    FlowsTo -> False
+    IntDiv -> False
+    HasField -> False
+    LatticeJoin -> False
+    LatticeMeet -> False
diff --git a/compiler/src/TroupePositionInfo.hs b/compiler/src/TroupePositionInfo.hs
index e4ae7ec0..2ea497f0 100644
--- a/compiler/src/TroupePositionInfo.hs
+++ b/compiler/src/TroupePositionInfo.hs
@@ -1,31 +1,27 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 module TroupePositionInfo
+where
 
-
-where 
-
-
-import GHC.Generics(Generic)
 import Data.Serialize (Serialize)
+import GHC.Generics (Generic)
 
-data PosInf = SrcPosInf String Int Int
-            | RTGen String
-            | NoPos
-            deriving (Eq, Ord, Generic)
-
+data PosInf
+    = SrcPosInf String Int Int
+    | RTGen String
+    | NoPos
+    deriving (Eq, Generic, Ord)
 
 instance Serialize PosInf
 
-instance Show PosInf
-  where show (SrcPosInf filename row col) = filename ++ ":" ++ (show row) ++ ":" ++ (show col)
-        show (RTGen s) = "RTGen<" ++ s ++ ">"
-        show NoPos = ""
-
+instance Show PosInf where
+    show (SrcPosInf filename row col) = filename ++ ":" ++ (show row) ++ ":" ++ (show col)
+    show (RTGen s) = "RTGen<" ++ s ++ ">"
+    show NoPos = ""
 
-class GetPosInfo a where 
-         posInfo :: a -> PosInf
+class GetPosInfo a where
+    posInfo :: a -> PosInf
 
-instance GetPosInfo PosInf where 
-         posInfo x = x
\ No newline at end of file
+instance GetPosInfo PosInf where
+    posInfo x = x
diff --git a/compiler/test/Golden.hs b/compiler/test/Golden.hs
index 41c51009..8a04e67e 100644
--- a/compiler/test/Golden.hs
+++ b/compiler/test/Golden.hs
@@ -1,68 +1,67 @@
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE RecordWildCards #-}
 
-import Test.Tasty (defaultMain, TestTree, testGroup, defaultMainWithIngredients, defaultIngredients, askOption, includingOptions)
-import Test.Tasty.Golden (goldenVsStringDiff,  goldenVsString, findByExtension)
-import Test.Tasty.Options (IsOption(..), OptionDescription(..), safeRead, flagCLParser)
-import Data.Typeable (Typeable)
-import Data.Tagged
+import qualified Data.ByteString.Char8
+import qualified Data.ByteString.Lazy as LBS
 import Data.Proxy
+import Data.Tagged
+import Data.Typeable (Typeable)
 import Options.Applicative
 import System.Directory
+import System.Environment (getArgs, getEnv)
+import System.Exit
+import System.FilePath (replaceExtension, takeBaseName)
+import System.Info
 import System.Process
-import System.Exit 
-import System.FilePath (takeBaseName, replaceExtension)
-import qualified Data.ByteString.Lazy as LBS 
-import qualified Data.ByteString.Char8
-import System.Info 
-import System.Environment (getEnv, getArgs)
+import Test.Tasty (TestTree, askOption, defaultIngredients, defaultMain, defaultMainWithIngredients, includingOptions, testGroup)
+import Test.Tasty.Golden (findByExtension, goldenVsString, goldenVsStringDiff)
+import Test.Tasty.Options (IsOption (..), OptionDescription (..), flagCLParser, safeRead)
+
 -- import qualified System.IO.Strict
 
 -- When having multiple optimizations / optional compiler stages or
 -- other flags changing the output, probably want to generate all combinations
 -- and run the tests on them.
-data TestConfig = TestConfig 
+data TestConfig = TestConfig
     { tcRawOpt :: Bool
-    , tcNoColor :: Bool 
+    , tcNoColor :: Bool
     }
 
 -- Custom option for no-color mode
 newtype NoColorOption = NoColorOption Bool
-  deriving (Eq, Ord, Typeable)
+    deriving (Eq, Ord, Typeable)
 
 instance IsOption NoColorOption where
-  defaultValue = NoColorOption False
-  parseValue = fmap NoColorOption . safeRead
-  optionName = return "no-color"
-  optionHelp = return "Disable colored output (generates .nocolor.golden files)"
-  optionCLParser = flagCLParser Nothing (NoColorOption True)
-
+    defaultValue = NoColorOption False
+    parseValue = fmap NoColorOption . safeRead
+    optionName = return "no-color"
+    optionHelp = return "Disable colored output (generates .nocolor.golden files)"
+    optionCLParser = flagCLParser Nothing (NoColorOption True)
 
 ppTestConfig TestConfig{..} =
-    (if tcRawOpt then "Raw optimized" else "Raw NOT optimized") ++
-    (if tcNoColor then ", No color" else ", With color")
+    (if tcRawOpt then "Raw optimized" else "Raw NOT optimized")
+        ++ (if tcNoColor then ", No color" else ", With color")
 
-
-getOptionalInput :: String -> IO String 
-getOptionalInput testfile = do 
+getOptionalInput :: String -> IO String
+getOptionalInput testfile = do
     inputExists <- doesFileExist $ testfile ++ ".input"
-    if inputExists then do 
-        s <- readFile (testfile ++ ".input")
-        return s 
-    else 
-        return ""        
-
+    if inputExists
+        then do
+            s <- readFile (testfile ++ ".input")
+            return s
+        else
+            return ""
 
 goldenFileName :: String -> TestConfig -> String
-goldenFileName troupeFile TestConfig{..} = 
-    if tcNoColor 
-    then replaceExtension troupeFile ".nocolor.golden"
-    else replaceExtension troupeFile ".golden"
+goldenFileName troupeFile TestConfig{..} =
+    if tcNoColor
+        then replaceExtension troupeFile ".nocolor.golden"
+        else replaceExtension troupeFile ".golden"
 
 mkRunArgs :: TestConfig -> [String]
 mkRunArgs TestConfig{..} =
-    (if tcRawOpt then [] else ["--no-rawopt"]) ++
-    (if tcNoColor then ["--no-color"] else [])
+    (if tcRawOpt then [] else ["--no-rawopt"])
+        ++ (if tcNoColor then ["--no-color"] else [])
 
 runLocal :: String -> TestConfig -> IO (ExitCode, String, String)
 runLocal testname tc = do
@@ -77,129 +76,131 @@ runTimeout n testname tc = do
     let timeout = if os == "darwin" then "gtimeout" else "timeout"
     readProcessWithExitCode timeout ([show n, "./local.sh"] ++ mkRunArgs tc ++ [testname]) ""
 
-
 runPositiveTimeout :: Int -> String -> TestConfig -> IO LBS.ByteString
 runPositiveTimeout t testname tc = do
     (code, out, err) <- runTimeout t testname tc
-    case code of 
+    case code of
         ExitFailure _ -> return $ (LBS.fromStrict . Data.ByteString.Char8.pack) (out ++ err)
-        ExitSuccess -> fail testname 
-        
-
+        ExitSuccess -> fail testname
 
 runPositive :: String -> TestConfig -> IO LBS.ByteString
 runPositive testname tc = do
     (code, out, err) <- runLocal testname tc
-    case code of 
+    case code of
         ExitSuccess -> return $ (LBS.fromStrict . Data.ByteString.Char8.pack) out
-        ExitFailure _ -> fail testname 
-
+        ExitFailure _ -> fail testname
 
 runNegative :: String -> TestConfig -> IO LBS.ByteString
 runNegative testname tc = do
     (code, out, err) <- runLocal testname tc
-    case code of 
+    case code of
         ExitFailure _ -> return $ (LBS.fromStrict . Data.ByteString.Char8.pack) err
-        ExitSuccess -> fail testname 
-        
+        ExitSuccess -> fail testname
 
-main :: IO () 
+main :: IO ()
 main = do
     troupeDir <- getEnv "TROUPE"
     setCurrentDirectory troupeDir
-    
+
     -- Pre-generate all test configurations
-    testsWithColor <- sequence
-      [ goldenTests (TestConfig True False)   -- Raw opt, with color
-      , goldenTests (TestConfig False False)  -- No raw opt, with color  
-      ]
-    testsNoColor <- sequence
-      [ goldenTests (TestConfig True True)    -- Raw opt, no color
-      , goldenTests (TestConfig False True)   -- No raw opt, no color
-      ]
-    
+    testsWithColor <-
+        sequence
+            [ goldenTests (TestConfig True False) -- Raw opt, with color
+            , goldenTests (TestConfig False False) -- No raw opt, with color
+            ]
+    testsNoColor <-
+        sequence
+            [ goldenTests (TestConfig True True) -- Raw opt, no color
+            , goldenTests (TestConfig False True) -- No raw opt, no color
+            ]
+
     defaultMainWithIngredients ings $
-      askOption $ \(NoColorOption noColor) ->
-        testGroup "Troupe golden tests" $
-          if noColor then testsNoColor else testsWithColor
+        askOption $ \(NoColorOption noColor) ->
+            testGroup "Troupe golden tests" $
+                if noColor then testsNoColor else testsWithColor
   where
     ings = includingOptions [Option (Proxy :: Proxy NoColorOption)] : defaultIngredients
 
-
 goldenTests :: TestConfig -> IO TestTree
 goldenTests tc = do
-    let extensions =  [".trp", ".pico", ".atto", ".picox", ".femto"] 
+    let extensions = [".trp", ".pico", ".atto", ".picox", ".femto"]
     negativeTestsForCompiler <- findByExtension extensions "tests/cmp"
-    positiveTestsForRuntime  <- findByExtension extensions "tests/rt/pos"
-    negativeTestsForRuntime  <- findByExtension extensions "tests/rt/neg"
-    warningTestsForRuntime   <- findByExtension extensions "tests/rt/warn"
-    timeoutTestsForRuntime   <- findByExtension extensions "tests/rt/timeout/blocking"
+    positiveTestsForRuntime <- findByExtension extensions "tests/rt/pos"
+    negativeTestsForRuntime <- findByExtension extensions "tests/rt/neg"
+    warningTestsForRuntime <- findByExtension extensions "tests/rt/warn"
+    timeoutTestsForRuntime <- findByExtension extensions "tests/rt/timeout/blocking"
     divergingTestsForRuntime <- findByExtension extensions "tests/rt/timeout/diverging"
-    testsForLib              <- findByExtension extensions "tests/lib"
-
-    return $ (testGroup ("Troupe golden tests (" ++ ppTestConfig tc ++ ")") $ map ($ tc)
-                                [ compilerTests negativeTestsForCompiler
-                                , runtimeTests $ concat [positiveTestsForRuntime, negativeTestsForRuntime, warningTestsForRuntime]
-                                , timeoutTests timeoutTestsForRuntime
-                                , divergingTests divergingTestsForRuntime
-                                , libTests testsForLib] )
-
+    testsForLib <- findByExtension extensions "tests/lib"
+
+    return $
+        ( testGroup ("Troupe golden tests (" ++ ppTestConfig tc ++ ")") $
+            map
+                ($ tc)
+                [ compilerTests negativeTestsForCompiler
+                , runtimeTests $ concat [positiveTestsForRuntime, negativeTestsForRuntime, warningTestsForRuntime]
+                , timeoutTests timeoutTestsForRuntime
+                , divergingTests divergingTestsForRuntime
+                , libTests testsForLib
+                ]
+        )
 
 compilerTests testFiles tc =
-    testGroup "Compiler (negative) tests"
-        [goldenVsString 
-            troupeFile 
+    testGroup
+        "Compiler (negative) tests"
+        [ goldenVsString
+            troupeFile
             (goldenFileName troupeFile tc)
             (runNegative troupeFile tc)
-        | troupeFile <- testFiles 
+        | troupeFile <- testFiles
         ]
 
 -- OBS: 2019-03-02: we are using a diff wrapper because the library used by
 -- tasty-golden for starting a subprocess escapes quotes, making it impossible
 -- to pass the regex arguments to diff, which is what we use to ignore logging
--- (through timestamps) and uuids when diffing. 
+-- (through timestamps) and uuids when diffing.
 
-diff ref new = ["tests/_util/diff.sh", ref, new ]
+diff ref new = ["tests/_util/diff.sh", ref, new]
 
-diff_n ref new = ["tests/_util/diff_n.sh", ref, new ]
+diff_n ref new = ["tests/_util/diff_n.sh", ref, new]
 
-
--- 2019-03-04: AA: we should probably use type classes... 
+-- 2019-03-04: AA: we should probably use type classes...
 
 runtimeTests testFiles tc =
-    testGroup "Runtime tests" 
-        [ goldenVsStringDiff  
+    testGroup
+        "Runtime tests"
+        [ goldenVsStringDiff
             troupeFile
-            diff 
+            diff
             (goldenFileName troupeFile tc)
             (runPositive troupeFile tc)
-        | troupeFile <- testFiles 
-        ] 
-
+        | troupeFile <- testFiles
+        ]
 
 timeoutTests testFiles tc =
-    testGroup "Timeout tests" 
-        [ goldenVsStringDiff  
-            troupeFile            
-            diff 
+    testGroup
+        "Timeout tests"
+        [ goldenVsStringDiff
+            troupeFile
+            diff
             (goldenFileName troupeFile tc)
             (runPositiveTimeout 8 troupeFile tc)
-        | troupeFile <- testFiles 
-        ] 
-
+        | troupeFile <- testFiles
+        ]
 
 divergingTests testFiles tc =
-    testGroup "Diverging tests" 
-        [ goldenVsStringDiff  
-            troupeFile            
+    testGroup
+        "Diverging tests"
+        [ goldenVsStringDiff
+            troupeFile
             diff_n
             (goldenFileName troupeFile tc)
             (runPositiveTimeout 8 troupeFile tc)
-        | troupeFile <- testFiles 
+        | troupeFile <- testFiles
         ]
 
 libTests testFiles tc =
-    testGroup "Library tests"
+    testGroup
+        "Library tests"
         [ goldenVsStringDiff
             troupeFile
             diff
@@ -207,4 +208,3 @@ libTests testFiles tc =
             (runPositive troupeFile tc)
         | troupeFile <- testFiles
         ]
-
diff --git a/compiler/test/ir2raw-test/IR2RawTest.hs b/compiler/test/ir2raw-test/IR2RawTest.hs
index 4e027035..4cc222b3 100644
--- a/compiler/test/ir2raw-test/IR2RawTest.hs
+++ b/compiler/test/ir2raw-test/IR2RawTest.hs
@@ -9,29 +9,34 @@
    to ir2raw-out/.
 -}
 
-import Data.Functor
-import Control.Monad
 import Control.Arrow
+import Control.Monad
+import Data.Functor
 
 import Util.FileUtil
 
+import qualified Core
 import IR
 import IR2Raw
-import RetCPS (VarName(..))
-import qualified Core
+import RetCPS (VarName (..))
 
-import qualified TR
 import qualified Expr
 import qualified Inst
-import qualified Tree
 import qualified RawOpt
+import qualified TR
+import qualified Tree
 
 main :: IO ()
 main = do
-    let rawProgs = map (second (\ir ->
-          let raw = prog2raw ir in
-            (raw, RawOpt.rawopt raw)
-          )) (TR.tcs ++ Expr.tcs ++ Inst.tcs ++ Tree.tcs)
-    forM_ rawProgs $ \(n,(raw, rawopt)) -> do
-      writeFileD ("ir2raw-out/" ++ n ++ ".raw") (show raw)
-      writeFileD ("ir2raw-out/" ++ n ++ ".rawopt") (show rawopt)
\ No newline at end of file
+    let rawProgs =
+            map
+                ( second
+                    ( \ir ->
+                        let raw = prog2raw ir
+                         in (raw, RawOpt.rawopt raw)
+                    )
+                )
+                (TR.tcs ++ Expr.tcs ++ Inst.tcs ++ Tree.tcs)
+    forM_ rawProgs $ \(n, (raw, rawopt)) -> do
+        writeFileD ("ir2raw-out/" ++ n ++ ".raw") (show raw)
+        writeFileD ("ir2raw-out/" ++ n ++ ".rawopt") (show rawopt)
diff --git a/compiler/test/ir2raw-test/Util.hs b/compiler/test/ir2raw-test/Util.hs
index 94417b39..3b26228e 100644
--- a/compiler/test/ir2raw-test/Util.hs
+++ b/compiler/test/ir2raw-test/Util.hs
@@ -1,6 +1,6 @@
 module Util where
 
 import qualified IR
-import RetCPS (VarName(..))
+import RetCPS (VarName (..))
 
-mkV s = IR.VarLocal (VN s)
\ No newline at end of file
+mkV s = IR.VarLocal (VN s)
diff --git a/compiler/test/ir2raw-test/testcases/Expr.hs b/compiler/test/ir2raw-test/testcases/Expr.hs
index 1cc519ae..ffc10030 100644
--- a/compiler/test/ir2raw-test/testcases/Expr.hs
+++ b/compiler/test/ir2raw-test/testcases/Expr.hs
@@ -2,45 +2,46 @@
 
 module Expr where
 
-import Data.Functor
 import Control.Arrow
+import Data.Functor
 
-import Util
-import RetCPS (VarName(..))
-import IR
+import Basics
 import qualified Core
+import IR
+import RetCPS (VarName (..))
 import TroupePositionInfo
-import Basics
-
+import Util
 
 mkP :: IRExpr -> IRProgram
 mkP e = IRProgram (Core.Atoms []) [FunDef (HFN "main") (VN "arg") [] body]
-  where body = BB [Assign (VN "r") e] (LibExport (mkV "r")) -- need to use assigned variable so that it is not optimized away
+  where
+    body = BB [Assign (VN "r") e] (LibExport (mkV "r")) -- need to use assigned variable so that it is not optimized away
 
 tcs :: [(String, IRProgram)]
-tcs = map (second mkP) $
-  (implBinops <&> \op -> (show op, Bin op (mkV "x") (mkV "y"))) ++
-  (implUnops <&> \op -> (show op, Un op (mkV "x"))) ++
-  [ ("Const", Const (Core.LString "testlit"))
-  , ("Base (authorityarg)", Base "$$authorityarg")
-  , ("Base (general)", Base "somevar")
-  , ("Tuple0", Tuple [])
-  , ("Tuple1", Tuple [mkV "v"])
-  , ("Tuple2", Tuple [mkV "v1", mkV "v2"])
-  , ("List0", List [])
-  , ("List1", List [mkV "v"])
-  , ("List2", List [mkV "v1", mkV "v2"])
-  , ("Record0", Record [])
-  , ("Record1", Record [("field1", mkV "v1")])
-  , ("Record2", Record [("field1", mkV "v1"), ("field2", mkV "v2")])
-  , ("ListCons", ListCons (mkV "x") (mkV "xs"))
-  , ("WithRecord0", WithRecord (mkV "x") [])
-  , ("WithRecord1", WithRecord (mkV "x") [("field1", mkV "v1")])
-  , ("WithRecord2", WithRecord (mkV "x") [("field1", mkV "v1"), ("field2", mkV "v2")])
-  , ("ProjField", ProjField (mkV "x") "field1")
-  , ("ProjIdx", ProjIdx (mkV "x") 123)
-  , ("Lib", Lib (LibName "string") "charAt")
-  ]
+tcs =
+    map (second mkP) $
+        (implBinops <&> \op -> (show op, Bin op (mkV "x") (mkV "y")))
+            ++ (implUnops <&> \op -> (show op, Un op (mkV "x")))
+            ++ [ ("Const", Const (Core.LString "testlit"))
+               , ("Base (authorityarg)", Base "$$authorityarg")
+               , ("Base (general)", Base "somevar")
+               , ("Tuple0", Tuple [])
+               , ("Tuple1", Tuple [mkV "v"])
+               , ("Tuple2", Tuple [mkV "v1", mkV "v2"])
+               , ("List0", List [])
+               , ("List1", List [mkV "v"])
+               , ("List2", List [mkV "v1", mkV "v2"])
+               , ("Record0", Record [])
+               , ("Record1", Record [("field1", mkV "v1")])
+               , ("Record2", Record [("field1", mkV "v1"), ("field2", mkV "v2")])
+               , ("ListCons", ListCons (mkV "x") (mkV "xs"))
+               , ("WithRecord0", WithRecord (mkV "x") [])
+               , ("WithRecord1", WithRecord (mkV "x") [("field1", mkV "v1")])
+               , ("WithRecord2", WithRecord (mkV "x") [("field1", mkV "v1"), ("field2", mkV "v2")])
+               , ("ProjField", ProjField (mkV "x") "field1")
+               , ("ProjIdx", ProjIdx (mkV "x") 123)
+               , ("Lib", Lib (LibName "string") "charAt")
+               ]
 
 deriving instance Enum BinOp
 deriving instance Bounded BinOp
@@ -55,7 +56,7 @@ unops = enumFrom minBound
 
 -- TODO remove when implemented
 notimplBinops :: [BinOp]
-notimplBinops =  [And, Or, BinAnd, BinOr, BinXor, BinShiftLeft, BinShiftRight, BinZeroShiftRight, FlowsTo, LatticeJoin, LatticeMeet]
+notimplBinops = [And, Or, BinAnd, BinOr, BinXor, BinShiftLeft, BinShiftRight, BinZeroShiftRight, FlowsTo, LatticeJoin, LatticeMeet]
 
 notimplUnops :: [UnaryOp]
 notimplUnops = [Fst, Snd, LevelOf]
diff --git a/compiler/test/ir2raw-test/testcases/Inst.hs b/compiler/test/ir2raw-test/testcases/Inst.hs
index 9336d1a1..52b6b2f0 100644
--- a/compiler/test/ir2raw-test/testcases/Inst.hs
+++ b/compiler/test/ir2raw-test/testcases/Inst.hs
@@ -1,33 +1,36 @@
 module Inst where
 
-import Util
-import RetCPS (VarName(..))
-import IR
-import qualified Core
+import qualified Basics
 import Control.Arrow
+import qualified Core
+import IR
+import RetCPS (VarName (..))
 import TroupePositionInfo
-import qualified Basics
-
+import Util
 
 mkP :: IRInst -> IRProgram
 mkP inst = IRProgram (Core.Atoms []) [FunDef (HFN "main") (VN "arg") [] body]
-  where body = BB [inst] (LibExport (mkV "r"))
+  where
+    body = BB [inst] (LibExport (mkV "r"))
 
 tcs :: [(String, IRProgram)]
-tcs = map (second mkP)
-  [ ( "AssignSimple"
-    , Assign (VN "r") (Const $ Core.LInt 123 NoPos)
-    )
-  ,
-    ( "AssignOp"
-    , Assign (VN "r") (Bin Basics.Plus (mkV "x") (mkV "y"))
-    )
-  ,
-    ( "AssignEq"
-    , Assign (VN "r") (Bin Basics.Eq (mkV "x") (mkV "y"))
-    )
-  ,
-    ( "MkFunClosures"
-    , MkFunClosures [(VN "x", mkV "r")] [(VN "f", HFN "f123")]
-    )
-  ]
+tcs =
+    map
+        (second mkP)
+        [
+            ( "AssignSimple"
+            , Assign (VN "r") (Const $ Core.LInt 123 NoPos)
+            )
+        ,
+            ( "AssignOp"
+            , Assign (VN "r") (Bin Basics.Plus (mkV "x") (mkV "y"))
+            )
+        ,
+            ( "AssignEq"
+            , Assign (VN "r") (Bin Basics.Eq (mkV "x") (mkV "y"))
+            )
+        ,
+            ( "MkFunClosures"
+            , MkFunClosures [(VN "x", mkV "r")] [(VN "f", HFN "f123")]
+            )
+        ]
diff --git a/compiler/test/ir2raw-test/testcases/TR.hs b/compiler/test/ir2raw-test/testcases/TR.hs
index 4800b478..10e0aae5 100644
--- a/compiler/test/ir2raw-test/testcases/TR.hs
+++ b/compiler/test/ir2raw-test/testcases/TR.hs
@@ -1,44 +1,54 @@
 module TR where
 
-import Util
-import RetCPS (VarName(..))
-import IR
-import qualified Core
 import Control.Arrow
+import qualified Core
+import IR
+import RetCPS (VarName (..))
 import TroupePositionInfo
-
+import Util
 
 mkP :: IRTerminator -> IRProgram
 mkP tr = IRProgram (Core.Atoms []) [FunDef (HFN "main") (VN "arg") [] body]
-  where body = BB [] tr
+  where
+    body = BB [] tr
 
 tcs :: [(String, IRProgram)]
-tcs = map (second mkP)
-  [
-  ( "TailCall"
-  , TailCall (mkV "x") (mkV "y")
-  ),
-  ( "Ret"
-  , Ret (mkV "x")
-  ),
-  ( "LibExport"
-  , LibExport (mkV "x")
-  ),
-  -- NOTE: We use libexport as terminator because it generates least extra code
-  ( "If"
-  , If (mkV "x")
-       (BB [Assign (VN "b1") (Base "v1") ] (LibExport (mkV "b1")))
-       (BB [Assign (VN "b2") (Base "v2") ] (LibExport (mkV "b2")))
-  ),
-  ( "Call"
-  , Call (VN "x")
-       (BB [Assign (VN "b1") (Base "v1") ] (LibExport (mkV "b1")))
-       (BB [Assign (VN "b2") (Base "v2") ] (LibExport (mkV "b2")))
-  ),
-  ( "AssertElseError"
-  , AssertElseError (mkV "x") (BB [Assign (VN "b") (Base "v")] (LibExport (mkV "b"))) (mkV "verr") NoPos
-  ),
-  ( "Error"
-  , Error (mkV "verr") NoPos
-  )
-  ]
+tcs =
+    map
+        (second mkP)
+        [
+            ( "TailCall"
+            , TailCall (mkV "x") (mkV "y")
+            )
+        ,
+            ( "Ret"
+            , Ret (mkV "x")
+            )
+        ,
+            ( "LibExport"
+            , LibExport (mkV "x")
+            )
+        , -- NOTE: We use libexport as terminator because it generates least extra code
+
+            ( "If"
+            , If
+                (mkV "x")
+                (BB [Assign (VN "b1") (Base "v1")] (LibExport (mkV "b1")))
+                (BB [Assign (VN "b2") (Base "v2")] (LibExport (mkV "b2")))
+            )
+        ,
+            ( "Call"
+            , Call
+                (VN "x")
+                (BB [Assign (VN "b1") (Base "v1")] (LibExport (mkV "b1")))
+                (BB [Assign (VN "b2") (Base "v2")] (LibExport (mkV "b2")))
+            )
+        ,
+            ( "AssertElseError"
+            , AssertElseError (mkV "x") (BB [Assign (VN "b") (Base "v")] (LibExport (mkV "b"))) (mkV "verr") NoPos
+            )
+        ,
+            ( "Error"
+            , Error (mkV "verr") NoPos
+            )
+        ]
diff --git a/compiler/test/ir2raw-test/testcases/Tree.hs b/compiler/test/ir2raw-test/testcases/Tree.hs
index d57f0a4a..8d472982 100644
--- a/compiler/test/ir2raw-test/testcases/Tree.hs
+++ b/compiler/test/ir2raw-test/testcases/Tree.hs
@@ -1,25 +1,26 @@
-
 module Tree where
 
-import Util
-import RetCPS (VarName(..))
-import IR
-import qualified Core
+import qualified Basics
 import Control.Arrow
+import qualified Core
+import IR
+import RetCPS (VarName (..))
 import TroupePositionInfo
-import qualified Basics
-
+import Util
 
 mkP :: IRBBTree -> IRProgram
 mkP tree = IRProgram (Core.Atoms []) [FunDef (HFN "main") (VN "arg") [] tree]
 
 tcs :: [(String, IRProgram)]
-tcs = map (second mkP)
-  [ ( "TreeEmpty"
-    , BB [] (Ret (mkV "r"))
-    )
-  ,
-    ( "TreeAssign"
-    , BB [Assign (VN "r") (Tuple [])] (Ret (mkV "r"))
-    )
-  ]
+tcs =
+    map
+        (second mkP)
+        [
+            ( "TreeEmpty"
+            , BB [] (Ret (mkV "r"))
+            )
+        ,
+            ( "TreeAssign"
+            , BB [Assign (VN "r") (Tuple [])] (Ret (mkV "r"))
+            )
+        ]