6 files changed, 0 insertions, 768 deletions
diff --git a/fig-bless/src/Fig/Bless.hs b/fig-bless/src/Fig/Bless.hs
deleted file mode 100644
index 1005a49..0000000
--- a/fig-bless/src/Fig/Bless.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-module Fig.Bless
-  ( module Fig.Bless.Syntax
-  , module Fig.Bless.Runtime
-  , module Fig.Bless.Builtins
-  , module Fig.Bless.Types
-  , module Fig.Bless.TypeChecker
-  )
-where
-
-import Fig.Bless.Syntax
-import Fig.Bless.Runtime
-import Fig.Bless.Builtins
-import Fig.Bless.Types
-import Fig.Bless.TypeChecker
diff --git a/fig-bless/src/Fig/Bless/Builtins.hs b/fig-bless/src/Fig/Bless/Builtins.hs
deleted file mode 100644
index 8e199d7..0000000
--- a/fig-bless/src/Fig/Bless/Builtins.hs
+++ /dev/null
@@ -1,154 +0,0 @@
-{-# Language ImplicitParams #-}
-
-module Fig.Bless.Builtins
-  ( builtins
-  ) where
-
-import Fig.Prelude
-
-import Control.Monad.State.Strict (execStateT, StateT)
-
-import qualified Data.Map.Strict as Map
-import qualified Data.Text as Text
-
-import qualified Fig.Bless.Syntax as Syn
-import Fig.Bless.Types
-import Fig.Bless.Runtime
-
--- * Helper functions
-stateful :: Running m t => [BType] -> [BType] -> StateT (VM m t) m a -> Builtin m t
-stateful inp out f = (execStateT f, BProgType {..})
-
-push :: (Running m t, MonadState (VM m' t) m) => ValueF t -> m ()
-push v = state \vm -> ((), vm { stack = v : vm.stack })
-
-pop :: (Running m t, MonadState (VM m' t) m) => m (ValueF t)
-pop = get >>= \case
-  vm | x:xs <- vm.stack -> do
-         put vm { stack = xs }
-         pure x
-     | otherwise -> throwM $ RuntimeErrorStackUnderflow ?term
-
-effect :: (Running m t, MonadState (VM m' t) m) => EffectF t -> m ()
-effect e = state \vm -> ((), vm { effects = e : vm.effects })
-
-int :: Running m t => ValueF t -> m Integer
-int (ValueInteger i) = pure i
-int v = throwM $ RuntimeErrorSortMismatch ?term ValueSortInteger (valueSort v)
-
-double :: Running m t => ValueF t -> m Double
-double (ValueDouble d) = pure d
-double v = throwM $ RuntimeErrorSortMismatch ?term ValueSortDouble (valueSort v)
-
-string :: Running m t => ValueF t -> m Text
-string (ValueString s) = pure s
-string v = throwM $ RuntimeErrorSortMismatch ?term ValueSortString (valueSort v)
-
-program :: Running m t => ValueF t -> m (Syn.ProgramF t)
-program (ValueProgram p) = pure p
-program v = throwM $ RuntimeErrorSortMismatch ?term ValueSortProgram (valueSort v)
-
-array :: Running m t => ValueF t -> m [ValueF t]
-array (ValueArray a) = pure a
-array v = throwM $ RuntimeErrorSortMismatch ?term ValueSortProgram (valueSort v)
-
--- * Stack operations
-stackOps :: RunningTop m t => Builtins m t
-stackOps t = let ?term = t in Map.fromList
-  [ ( "dup", stateful [BTypeVariable "a"] [BTypeVariable "a", BTypeVariable "a"] do
-        x <- pop
-        push x
-        push x
-    )
-  , ( "swap", stateful [BTypeVariable "a", BTypeVariable "b"] [BTypeVariable "b", BTypeVariable "a"] do
-        x <- pop
-        y <- pop
-        push x
-        push y
-    )
-  ]
-
--- * Arithmetic builtins
-add :: Running m t => Builtin m t
-add = stateful [BTypeInteger, BTypeInteger] [BTypeInteger] do
-  y <- int =<< pop
-  x <- int =<< pop
-  push . ValueInteger $ x + y
-
-mul :: Running m t => Builtin m t
-mul = stateful [BTypeInteger, BTypeInteger] [BTypeInteger] do
-  y <- int =<< pop
-  x <- int =<< pop
-  push . ValueInteger $ x * y
-
-sub :: Running m t => Builtin m t
-sub = stateful [BTypeInteger, BTypeInteger] [BTypeInteger] do
-  y <- int =<< pop
-  x <- int =<< pop
-  push . ValueInteger $ x - y
-
-div :: Running m t => Builtin m t
-div = stateful [BTypeInteger, BTypeInteger] [BTypeInteger] do
-  y <- int =<< pop
-  x <- int =<< pop
-  push . ValueInteger $ quot x y
-
-arithmeticOps :: RunningTop m t => Builtins m t
-arithmeticOps t = let ?term = t in Map.fromList
-  [ ("+", add)
-  , ("*", mul)
-  , ("-", sub)
-  , ("/", div)
-  ]
-
--- * String builtins
-stringOps :: RunningTop m t => Builtins m t
-stringOps t = let ?term = t in Map.fromList
-  [ ( "s-append", stateful [BTypeString, BTypeString] [BTypeString] do
-        y <- string =<< pop
-        x <- string =<< pop
-        push . ValueString $ x <> y
-    )
-  , ( "s-split", stateful [BTypeString, BTypeString] [BTypeArray BTypeString] do
-        sep <- string =<< pop
-        s <- string =<< pop
-        push . ValueArray $ ValueString <$> Text.splitOn sep s
-    )
-  ]
-
--- * Array builtins
-arrayOps :: RunningTop m t => Builtins m t
-arrayOps t = let ?term = t in Map.fromList
-  [ ( "a-append", stateful [BTypeArray (BTypeVariable "a"), BTypeArray (BTypeVariable "a")] [BTypeArray (BTypeVariable "a")] do
-        y <- array =<< pop
-        x <- array =<< pop
-        push . ValueArray $ x <> y
-    )
-  ]
-
--- * Side effects
-sideeffectOps :: RunningTop m t => Builtins m t
-sideeffectOps t = let ?term = t in Map.fromList
-  [ ( "print", stateful [BTypeVariable "a"] [] do
-        x <- pop
-        effect $ EffectPrint x
-    )
-  , ( "soundboard", stateful [BTypeString] [] do
-        x <- pop
-        effect $ EffectSoundboard x
-    )
-  , ( "toggle", stateful [BTypeString] [] do
-        x <- pop
-        effect $ EffectModelToggle x
-    )
-  ]
-
--- * All builtins
-builtins :: RunningTop m t => Builtins m t
-builtins t = Map.unions @[]
-  [ stackOps t
-  , arithmeticOps t
-  , stringOps t
-  , arrayOps t
-  , sideeffectOps t
-  ]
diff --git a/fig-bless/src/Fig/Bless/Runtime.hs b/fig-bless/src/Fig/Bless/Runtime.hs
deleted file mode 100644
index 4de75e0..0000000
--- a/fig-bless/src/Fig/Bless/Runtime.hs
+++ /dev/null
@@ -1,167 +0,0 @@
-{-# Language ImplicitParams #-}
-
-module Fig.Bless.Runtime
-  ( ValueF(..)
-  , EffectF(..)
-  , ValueSort(..), valueSort
-  , RuntimeError(..)
-  , RunningTop, Running
-  , BuiltinProgram, Builtin, Builtins
-  , VM(..)
-  , initialize
-  , runProgram, runWord, run
-  ) where
-
-import Fig.Prelude
-
-import Control.Exception.Safe (Typeable)
-
-import qualified Data.Text as Text
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-
-import qualified Data.Aeson as Aeson
-
-import Fig.Bless.Types
-import qualified Fig.Bless.Syntax as Syn
-
-data ValueF t
-  = ValueInteger Integer
-  | ValueDouble Double
-  | ValueString Text
-  | ValueProgram (Syn.ProgramF t)
-  | ValueArray [ValueF t]
-  deriving (Show, Eq, Ord, Generic)
-instance Aeson.ToJSON t => Aeson.ToJSON (ValueF t)
-instance Pretty t => Pretty (ValueF t) where
-  pretty (ValueInteger i) = tshow i
-  pretty (ValueDouble d) = tshow d
-  pretty (ValueString s) = tshow s
-  pretty (ValueProgram p) = pretty p
-  pretty (ValueArray vs) = mconcat
-    [ "{"
-    , unwords $ pretty <$> vs
-    , "}"
-    ]
-
-data EffectF t
-  = EffectPrint (ValueF t)
-  | EffectPrintBackwards (ValueF t)
-  | EffectSoundboard (ValueF t)
-  | EffectModelToggle (ValueF t)
-  deriving (Show, Eq, Ord, Generic)
-instance Aeson.ToJSON t => Aeson.ToJSON (EffectF t)
-instance Pretty t => Pretty (EffectF t) where
-  pretty (EffectPrint x) =  "(print " <> pretty x <> ")"
-  pretty (EffectPrintBackwards x) =  "(print-backwards " <> pretty x <> ")"
-  pretty (EffectSoundboard x) =  "(soundboard " <> pretty x <> ")"
-  pretty (EffectModelToggle x) =  "(moddle-toggle " <> pretty x <> ")"
-
-data ValueSort
-  = ValueSortInteger
-  | ValueSortDouble
-  | ValueSortString
-  | ValueSortWord
-  | ValueSortProgram
-  | ValueSortArray
-  deriving (Show, Eq, Ord, Generic)
-instance Aeson.ToJSON ValueSort
-instance Pretty ValueSort where
-  pretty ValueSortInteger = "integer"
-  pretty ValueSortDouble = "double"
-  pretty ValueSortString = "string"
-  pretty ValueSortWord = "word"
-  pretty ValueSortProgram = "program"
-  pretty ValueSortArray = "list"
-valueSort :: ValueF t -> ValueSort
-valueSort (ValueInteger _) = ValueSortInteger
-valueSort (ValueDouble _) = ValueSortDouble
-valueSort (ValueString _) = ValueSortString
-valueSort (ValueProgram _) = ValueSortProgram
-valueSort (ValueArray _) = ValueSortArray
-
-data RuntimeError t
-  = RuntimeErrorWordNotFound (Maybe t) Syn.Word
-  | RuntimeErrorOutOfFuel (Maybe t)
-  | RuntimeErrorStackUnderflow (Maybe t)
-  | RuntimeErrorSortMismatch (Maybe t) ValueSort ValueSort
-  deriving (Show, Eq, Ord, Generic)
-instance (Show t, Typeable t) => Exception (RuntimeError t)
-instance Aeson.ToJSON t => Aeson.ToJSON (RuntimeError t)
-runtimeErrorPrefix :: Pretty t => Maybe t -> Text
-runtimeErrorPrefix Nothing = ""
-runtimeErrorPrefix (Just t) = mconcat
-  [ "while evaluating term: ", pretty t, "\n"
-  ]
-instance Pretty t => Pretty (RuntimeError t) where
-  pretty (RuntimeErrorWordNotFound t w) = mconcat
-    [ runtimeErrorPrefix t
-    , "word definition not found for: ", pretty w
-    ]
-  pretty (RuntimeErrorOutOfFuel t) = mconcat
-    [ runtimeErrorPrefix t
-    , "out of fuel"
-    ]
-  pretty (RuntimeErrorStackUnderflow t) = mconcat
-    [ runtimeErrorPrefix t
-    , "stack underflow"
-    ]
-  pretty (RuntimeErrorSortMismatch t expected actual) = mconcat
-    [ runtimeErrorPrefix t
-    , "sort mismatch at runtime (this probably shouldn't happen, please report it as a bug):\n"
-    , "expected: ", pretty expected, "\n"
-    , "actual: ", pretty actual
-    ]
-
-type RunningTop m t = (MonadThrow m, Typeable t, Show t)
-type Running m t = (RunningTop m t, ?term :: Maybe t)
-type BuiltinProgram m t = VM m t -> m (VM m t)
-type Builtin m t = (BuiltinProgram m t, BProgType)
-type Builtins m t = Maybe t -> Map Syn.Word (Builtin m t)
-data VM m t = VM
-  { fuel :: Maybe Integer
-  , bindings :: Syn.DictionaryF t
-  , builtins :: Builtins m t
-  , stack :: [ValueF t]
-  , effects :: [EffectF t]
-  }
-
-initialize :: Running m t => Maybe Integer -> Syn.DictionaryF t -> Builtins m t -> VM m t
-initialize fuel bindings builtins = VM{..}
-  where
-    stack = []
-    effects = []
-
-checkFuel :: Running m t => VM m t -> m (VM m t)
-checkFuel vm
-  | Just f <- vm.fuel
-  = if f <= 0
-    then throwM $ RuntimeErrorOutOfFuel ?term
-    else pure vm { fuel = Just $ f - 1 }
-checkFuel vm = pure vm
-
-push :: Running m t => ValueF t -> VM m t -> VM m t
-push v vm = vm
-  { stack = v : vm.stack
-  }
-
-runProgram :: Running m t => Syn.Extractor m t -> Syn.ProgramF t -> VM m t -> m (VM m t)
-runProgram f (Syn.Program p) vm = foldM (flip (run f)) vm p
-
-runWord :: Running m t => Syn.Extractor m t -> Syn.Word -> VM m t -> m (VM m t)
-runWord _ w vm | Just (b, _) <- Map.lookup w $ vm.builtins ?term = b vm
-runWord f w vm | Just p <- lookup w vm.bindings.defs = runProgram f p vm
-runWord _ w _ = throwM $ RuntimeErrorWordNotFound ?term w
-
-literalValue :: Syn.LiteralF t -> ValueF t
-literalValue (Syn.LiteralInteger i) = ValueInteger i
-literalValue (Syn.LiteralDouble i) = ValueDouble i
-literalValue (Syn.LiteralString i) = ValueString i
-literalValue (Syn.LiteralArray xs) = ValueArray $ literalValue <$> xs
-literalValue (Syn.LiteralQuote p) = ValueProgram p
-
-run :: Running m t => Syn.Extractor m t -> t -> VM m t -> m (VM m t)
-run f v vm =
-  let ?term = Just v in f v >>= \case
-    Syn.TermLiteral l -> push (literalValue l) <$> checkFuel vm
-    Syn.TermWord w -> runWord f w =<< checkFuel vm
diff --git a/fig-bless/src/Fig/Bless/Syntax.hs b/fig-bless/src/Fig/Bless/Syntax.hs
deleted file mode 100644
index 9cd8aec..0000000
--- a/fig-bless/src/Fig/Bless/Syntax.hs
+++ /dev/null
@@ -1,190 +0,0 @@
-{-# Language ApplicativeDo #-}
-
-module Fig.Bless.Syntax
-  ( Word(..)
-  , LiteralF(..)
-  , ProgramF(..)
-  , Program
-  , TermF(..)
-  , Term
-  , DictionaryF(..)
-  , Dictionary
-  , Extractor
-  , word, literalF, termF, term, programF, program, dictionaryF, dictionary, P.eof
-  , Spanning(..), unSpanning, spanning
-  , ParseError(..)
-  , parse
-  ) where
-
-import Fig.Prelude
-
-import Data.Char (isSpace)
-import Data.Functor ((<&>))
-import Data.String (IsString(..))
-
-import qualified Text.Megaparsec as P
-import qualified Text.Megaparsec.Char as P.C
-import qualified Text.Megaparsec.Char.Lexer as P.C.L
-
-import qualified Data.Aeson as Aeson
-
-newtype Word = Word Text
-  deriving (Show, Eq, Ord, Generic)
-instance Aeson.ToJSON Word
-instance IsString Word where
-  fromString = Word . fromString
-instance Pretty Word where
-  pretty (Word t) = t
-
-data LiteralF t
-  = LiteralInteger Integer
-  | LiteralDouble Double
-  | LiteralString Text
-  | LiteralArray [LiteralF t]
-  | LiteralQuote (ProgramF t)
-  deriving (Show, Eq, Ord, Generic, Functor)
-instance Aeson.ToJSON t => Aeson.ToJSON (LiteralF t)
-instance Pretty t => Pretty (LiteralF t) where
-  pretty (LiteralInteger i) = tshow i
-  pretty (LiteralDouble d) = tshow d
-  pretty (LiteralString s) = tshow s
-  pretty (LiteralArray xs) = "{" <> unwords (pretty <$> xs) <> "}"
-  pretty (LiteralQuote p) = pretty p
-
-newtype ProgramF t = Program [t]
-  deriving (Show, Eq, Ord, Generic, Functor)
-instance Aeson.ToJSON t => Aeson.ToJSON (ProgramF t)
-instance Pretty t => Pretty (ProgramF t) where
-  pretty (Program ts) = unwords $ pretty <$> ts
-type Program = ProgramF (Fix TermF)
-
-data TermF t
-  = TermWord Word
-  | TermLiteral (LiteralF t)
-  deriving (Show, Eq, Ord, Generic, Functor)
-instance Aeson.ToJSON t => Aeson.ToJSON (TermF t)
-instance Pretty t => Pretty (TermF t) where
-  pretty (TermWord w) = pretty w
-  pretty (TermLiteral l) = pretty l
-type Term = TermF (Fix TermF)
-
-newtype DictionaryF t = Dictionary
-  { defs :: [(Word, ProgramF t)]
-  } deriving (Show, Eq, Ord)
-instance Pretty t => Pretty (DictionaryF t) where
-  pretty d = unlines $ d.defs <&> \(w, p) -> mconcat
-    [ pretty w
-    , " = "
-    , pretty p
-    ]
-type Dictionary = DictionaryF (Fix TermF)
-
-type Extractor m t = t -> m (TermF t)
-
-type Parser = P.Parsec Void Text
-
-ws :: Parser ()
-ws = P.C.L.space
-  P.C.space1
-  (P.C.L.skipLineComment "//")
-  (P.C.L.skipBlockComment "/*" "*/")
-
-wordChar :: Char -> Bool
-wordChar c = not $ elem @[] c ['[', ']', '{', '}', '=', ';'] || isSpace c
-word :: Parser Word
-word = Word . pack <$> P.some (P.satisfy wordChar)
-
-literalF :: Parser t -> Parser (LiteralF t)
-literalF pt =
-  P.try ( (LiteralDouble <$> P.C.L.signed (pure ()) P.C.L.float)
-    P.<?> "floating-point literal"
-  ) P.<|>
-  ( (LiteralInteger <$>
-      P.C.L.signed (pure ())
-      ( (P.C.string' "0x" *> P.C.L.hexadecimal) P.<|>
-        (P.C.string' "0o" *> P.C.L.octal) P.<|>
-        (P.C.string' "0b" *> P.C.L.binary) P.<|>
-        P.C.L.decimal
-      )
-    ) P.<?> "integer literal"
-  ) P.<|>
-  ( (LiteralString . pack <$> (P.C.char '"' *> P.manyTill P.C.L.charLiteral (P.C.char '"')))
-    P.<?> "string literal"
-  ) P.<|>
-  ( (LiteralArray <$> (P.C.char '{' *> P.many (ws *> literalF pt <* ws) <* P.C.char '}'))
-    P.<?> "array literal"
-  ) P.<|>
-  ( (LiteralQuote <$> (P.C.char '[' *> programF pt <* P.C.char ']'))
-    P.<?> "quotation"
-  )
-
-programF :: Parser t -> Parser (ProgramF t)
-programF pt = Program <$> P.many (ws *> pt <* ws)
-
-program :: Parser Program
-program = programF $ Fix <$> term
-
-termF :: Parser t -> Parser (TermF t)
-termF pt =
-  ( P.try (TermLiteral <$> literalF pt)
-    P.<|> (TermWord <$> word)
-  ) P.<?> "term"
-
-term :: Parser Term
-term = termF $ Fix <$> term
-
-dictionaryF :: Parser t -> Parser (DictionaryF t)
-dictionaryF pt = Dictionary <$> P.many
-  ( (,)
-    <$> (ws *> word <* ws <* P.C.char '=')
-    <*> (ws *> programF pt <* ws <* P.C.char ';')
-  )
-
-dictionary :: Parser Dictionary
-dictionary = dictionaryF $ Fix <$> term
-
-newtype ParseError = ParseError (P.ParseErrorBundle Text Void)
-  deriving (Show, Generic)
-instance Exception ParseError
-instance Aeson.ToJSON ParseError where
-  toJSON (ParseError b) = Aeson.object
-    [ "errors" Aeson..= Aeson.toJSON (bimap P.parseErrorPretty P.sourcePosPretty <$> posed)
-    ]
-    where
-      (posed, _) = P.attachSourcePos P.errorOffset (P.bundleErrors b) (P.bundlePosState b)
-instance Pretty ParseError where
-  pretty (ParseError b) = mconcat
-    [ "failed to read program:\n"
-    , pack $ P.errorBundlePretty b
-    ]
-
-data Spanning = Spanning
-  { t :: TermF Spanning
-  , start :: P.SourcePos
-  , end :: P.SourcePos
-  } deriving (Show, Eq, Ord, Generic)
-instance Aeson.ToJSON Spanning where
-  toJSON s = Aeson.object
-    [ "term" Aeson..= Aeson.toJSON s.t
-    , "start" Aeson..= pack (P.sourcePosPretty s.start)
-    , "end" Aeson..= pack (P.sourcePosPretty s.end)
-    ]
-instance Pretty Spanning where
-  pretty s = mconcat
-    [ pretty s.t, "\n"
-    , pack $ P.sourcePosPretty s.start, ":"
-    ]
-unSpanning :: Spanning -> TermF Spanning
-unSpanning s = s.t
-
-spanning :: Parser Spanning
-spanning = do
-  start <- P.getSourcePos
-  t <- termF spanning
-  end <- P.getSourcePos
-  pure Spanning{..}
-
-parse :: MonadThrow m => Text -> Parser a -> Text -> m a
-parse nm p inp = case P.runParser p (unpack nm) inp of
-  Left err -> throwM $ ParseError err
-  Right x -> pure x
diff --git a/fig-bless/src/Fig/Bless/TypeChecker.hs b/fig-bless/src/Fig/Bless/TypeChecker.hs
deleted file mode 100644
index 2b2cb6d..0000000
--- a/fig-bless/src/Fig/Bless/TypeChecker.hs
+++ /dev/null
@@ -1,159 +0,0 @@
-{-# Language ImplicitParams #-}
-
-module Fig.Bless.TypeChecker where
-
-import Fig.Prelude
-
-import Control.Exception.Safe (Typeable)
-
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
-
-import qualified Data.Aeson as Aeson
-
-import Fig.Bless.Syntax
-import Fig.Bless.Types
-import Fig.Bless.Runtime
-
-data Env m t = Env
-  { defs :: [(Word, BProgType)]
-  , ext :: Extractor m t
-  }
-
-data TypeError t
-  = TypeErrorWordNotFound (Maybe t) Word
-  | TypeErrorMismatch (Maybe t) BType BType
-  | TypeErrorArityMismatch (Maybe t) BProgType BProgType
-  | TypeErrorMixedArray (Maybe t)
-  deriving (Show, Eq, Ord, Generic)
-instance (Show t, Typeable t) => Exception (TypeError t)
-instance Aeson.ToJSON t => Aeson.ToJSON (TypeError t)
-typeErrorPrefix :: Pretty t => Maybe t -> Text
-typeErrorPrefix Nothing = ""
-typeErrorPrefix (Just t) = mconcat
-  [ "while typechecking term: ", pretty t, "\n"
-  ]
-
-instance Pretty t => Pretty (TypeError t) where
-  pretty (TypeErrorWordNotFound t w) = mconcat
-    [ typeErrorPrefix t
-    , "word definition not found for: ", pretty w
-    ]
-  pretty (TypeErrorMismatch t expected actual) = mconcat
-    [ typeErrorPrefix t
-    , "type mismatch:\n"
-    , "expected: ", pretty expected, "\n"
-    , "actual: ", pretty actual
-    ]
-  pretty (TypeErrorArityMismatch t expected actual) = mconcat
-    [ typeErrorPrefix t
-    , "arity mismatch:\n"
-    , "expected: ", pretty expected, "\n"
-    , "actual: ", pretty actual
-    ]
-  pretty (TypeErrorMixedArray t) = mconcat
-    [ typeErrorPrefix t
-    , "array literal has mixed types"
-    ]
-
-type Typing m t = (MonadIO m, MonadThrow m, Typeable t, Show t, ?term :: Maybe t)
-
-completeSubstitution :: [(BType, BType)] -> Either ((BType, BType), [(BType, BType)]) (Map Text BType)
-completeSubstitution = go Map.empty
-  where
-    go acc [] = Right acc
-    go acc ((BTypeVariable v, x):xs) -- ignore variables that are "done", e.g. they don't occur elsewhere
-      | not (Set.member v (Set.unions $ (typeVariables . fst <$> xs) <> (typeVariables . snd <$> xs)))
-      = go (Map.insert v x acc) xs
-    go acc (x:xs) = Left (x, xs <> fmap (first BTypeVariable) (Map.toList acc))
-
-unifyTypes :: forall m t. Typing m t => [(BType, BType)] -> m (Map Text BType)
-unifyTypes subst = case completeSubstitution subst of
-  Right f -> pure f
-  Left ((BTypeArray t0, BTypeArray t1), xs) -- decompose arrays
-    -> unifyTypes ((t0, t1):xs)
-  Left ((BTypeProgram p0, BTypeProgram p1), xs) -- decompose programs
-    | length p0.inp == length p1.inp
-      && length p0.out == length p1.out
-      -> unifyTypes (zip p0.inp p1.inp <> zip p0.out p1.out <> xs) -- only if the programs have the same arity
-    | otherwise -> throwM $ TypeErrorArityMismatch ?term p0 p1 -- otherwise, arity mismatch
-  Left ((t0, t1@(BTypeVariable _)), xs) -> unifyTypes $ (t1, t0):xs -- swap variables to lhs
-  Left ((t0@(BTypeVariable v), t1), xs) -> unifyTypes -- eliminate
-    $ (t0, t1):(bimap (substitute v t1) (substitute v t1) <$> xs)
-  Left ((t0, t1), xs)
-    | t0 == t1 -> unifyTypes xs -- delete non-variable matches
-    | otherwise -> throwM $ TypeErrorMismatch ?term t0 t1 -- otherwise, mismatch
-
-combineProgTypes :: forall m t. Typing m t => BProgType -> BProgType -> m BProgType
-combineProgTypes f s' = do
-  let fvars = typeVariables $ BTypeProgram f
-  let s = BProgType { inp = ensureUniqueVars fvars <$> s'.inp, out = ensureUniqueVars fvars <$> s'.out }
-  subst <- unifyTypes $ zip f.out s.inp
-  let finp = applySubstitution subst <$> f.inp
-  let fout = applySubstitution subst <$> f.out
-  let sinp = applySubstitution subst <$> s.inp
-  let sout = applySubstitution subst <$> s.out
-  (leftover, dig) <- foldM
-    ( \(l, d) t -> case l of
-        x:xs
-          | x == t -> pure (xs, d)
-          | otherwise -> throwM $ TypeErrorMismatch ?term t x
-        [] -> pure (l, d <> [t])
-    )
-    (fout, [])
-    sinp
-  pure BProgType
-    { inp = finp <> dig
-    , out = sout <> leftover
-    }
-
-typeOfLiteral :: Typing m t => Env m t -> LiteralF t -> m BType
-typeOfLiteral _ LiteralInteger{} = pure BTypeInteger
-typeOfLiteral _ LiteralDouble{} = pure BTypeDouble
-typeOfLiteral _ LiteralString{} = pure BTypeString
-typeOfLiteral e (LiteralArray xs) = mapM (typeOfLiteral e) xs >>= \case
-  [] -> pure $ BTypeArray (BTypeVariable "a")
-  ts@(t:_)
-    | length (Set.fromList ts) == 1 -> pure $ BTypeArray t
-    | otherwise -> throwM $ TypeErrorMixedArray ?term
-typeOfLiteral e (LiteralQuote p) = BTypeProgram <$> typeOfProgram e p
-
-typeOfProgram :: Typing m t => Env m t -> ProgramF t -> m BProgType
-typeOfProgram e (Program p) = case p of
-  ft:ts -> do
-    x <- typeOf e ft
-    foldM (\pt t -> let ?term = Just t in combineProgTypes pt =<< typeOf e t) x ts
-  [] -> pure BProgType {inp = [] , out = []}
-
-typeOf :: Typing m t => Env m t -> t -> m BProgType
-typeOf e wt = do
-  let ?term = Just wt
-  e.ext wt >>= \case
-    TermWord w -> case lookup w e.defs of
-      Nothing -> throwM $ TypeErrorWordNotFound ?term w
-      Just p -> pure p
-    TermLiteral l -> do
-      out <- typeOfLiteral e l
-      pure BProgType
-        { inp = []
-        , out = [out]
-        }
-
-initializeEnv :: Extractor m t -> Builtins m t -> Env m t
-initializeEnv ext bs = Env
-  { ext = ext
-  , defs = (\(w, (_, p)) -> (w, p)) <$> Map.toList (bs Nothing)
-  }
-
-checkDictionary :: forall m t. Typing m t => Env m t -> DictionaryF t -> m (Env m t)
-checkDictionary env d = foldM
-  ( \e (w, p) -> do
-      pty <- typeOfProgram e p
-      pure Env
-        { ext = e.ext
-        , defs = (w, pty):e.defs
-        }
-  )
-  env
-  d.defs
diff --git a/fig-bless/src/Fig/Bless/Types.hs b/fig-bless/src/Fig/Bless/Types.hs
deleted file mode 100644
index f7263e7..0000000
--- a/fig-bless/src/Fig/Bless/Types.hs
+++ /dev/null
@@ -1,84 +0,0 @@
-module Fig.Bless.Types where
-
-import Fig.Prelude
-
-import Prelude (error)
-
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import Data.Set (Set)
-import qualified Data.Set as Set
-
-import qualified Data.Aeson as Aeson
-
-data BType
-  = BTypeVariable Text
-  | BTypeInteger
-  | BTypeDouble
-  | BTypeString
-  | BTypeProgram BProgType
-  | BTypeArray BType
-  deriving (Show, Eq, Ord, Generic)
-instance Aeson.ToJSON BType
-instance Pretty BType where
-  pretty (BTypeVariable s) = "!" <> s
-  pretty BTypeInteger = "integer"
-  pretty BTypeDouble = "double"
-  pretty BTypeString = "string"
-  pretty (BTypeProgram p) = "[" <> pretty p <> "]"
-  pretty (BTypeArray p) = "{" <> pretty p <> "}"
-
-data BProgType = BProgType
-  { inp :: [BType]
-  , out :: [BType]
-  }
-  deriving (Show, Eq, Ord, Generic)
-instance Aeson.ToJSON BProgType
-instance Pretty BProgType where
-  pretty p = unwords (pretty <$> p.inp) <> " -- " <> unwords (pretty <$> p.out)
-
-renameVars :: (Text -> Text) -> BType -> BType
-renameVars f (BTypeVariable v) = BTypeVariable $ f v
-renameVars f (BTypeArray t) = BTypeArray $ renameVars f t
-renameVars f (BTypeProgram p) = BTypeProgram BProgType
-  { inp = renameVars f <$> p.inp
-  , out = renameVars f <$> p.out
-  }
-renameVars _ x = x
-
-ensureUniqueVars :: Set Text -> BType -> BType
-ensureUniqueVars bad = renameVars \v -> if Set.member v bad
-  then do
-  let
-    names :: [Text]
-    names = fmap (pack . (:[])) ['a'..'z'] <> fmap (<>"'") names
-  case headMay $ filter (not . flip Set.member bad) names of
-    Nothing -> error "unreachable" -- this can't happen because names is an infinite list
-    Just x -> x
-  else v
-
-substitute :: Text -> BType -> BType -> BType
-substitute n v (BTypeVariable n') | n == n' = v
-substitute n v (BTypeArray t) = BTypeArray $ substitute n v t
-substitute n v (BTypeProgram p) = BTypeProgram BProgType
-  { inp = substitute n v <$> p.inp
-  , out = substitute n v <$> p.out
-  }
-substitute _ _ x = x
-
-applySubstitution :: Map Text BType -> BType -> BType
-applySubstitution s (BTypeVariable v)
-  | Just x <- Map.lookup v s = x
-  | otherwise = BTypeVariable v
-applySubstitution s (BTypeArray t) = BTypeArray $ applySubstitution s t
-applySubstitution s (BTypeProgram p) = BTypeProgram BProgType
-  { inp = applySubstitution s <$> p.inp
-  , out = applySubstitution s <$> p.out
-  }
-applySubstitution _ x = x
-
-typeVariables :: BType -> Set Text
-typeVariables (BTypeVariable v) = Set.singleton v
-typeVariables (BTypeArray t) = typeVariables t
-typeVariables (BTypeProgram p) = Set.unions $ (typeVariables <$> p.inp) <> (typeVariables <$> p.out)
-typeVariables _ = Set.empty