{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Unison.Runtime.Decompile
( decompile,
DecompResult,
DecompError (..),
renderDecompError,
)
where
import Data.Map qualified as Map
import Data.Set (singleton)
import Unison.ABT (substs)
import Unison.Builtin.Decls qualified as DD
import Unison.Codebase.Runtime (Error)
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.Prelude
import Unison.Reference (Reference, pattern Builtin)
import Unison.Referent (pattern Ref)
import Unison.Referent qualified as Referent
import Unison.Runtime.ANF (maskTags)
import Unison.Runtime.Array
( Array,
ByteArray,
byteArrayToList,
)
import Unison.Runtime.Foreign
( Foreign (..),
HashAlgorithm (..),
maybeUnwrapBuiltin,
maybeUnwrapForeign,
)
import Unison.Runtime.IOSource (iarrayFromListRef, ibarrayFromBytesRef)
import Unison.Runtime.MCode (CombIx (..))
import Unison.Runtime.Stack
( Closure (..),
USeq,
UnboxedTypeTag (..),
Val (..),
pattern DataC,
pattern PApV,
)
import Unison.Syntax.NamePrinter (prettyReference)
import Unison.Term
( Term,
app,
apps',
boolean,
builtin,
char,
constructor,
float,
int,
list,
list',
nat,
ref,
termLink,
text,
typeLink,
pattern LamNamed',
)
import Unison.Term qualified as Term
import Unison.Type
( anyRef,
booleanRef,
hmapRef,
iarrayRef,
ibytearrayRef,
listRef,
termLinkRef,
typeLinkRef,
)
import Unison.Util.Bytes qualified as By
import Unison.Util.Pretty (indentN, lines, lit, shown, syntaxToColor, wrap)
import Unison.Util.Text qualified as Text
import Unison.Var (Var)
import Prelude hiding (lines)
con :: (Var v) => Reference -> Word64 -> Term v ()
con :: forall v. Var v => Reference -> Word64 -> Term v ()
con Reference
rf Word64
ct = () -> ConstructorReference -> Term2 v () () v ()
forall v a vt at ap.
Ord v =>
a -> ConstructorReference -> Term2 vt at ap v a
constructor () (Reference -> Word64 -> ConstructorReference
forall r. r -> Word64 -> GConstructorReference r
ConstructorReference Reference
rf (Word64 -> ConstructorReference) -> Word64 -> ConstructorReference
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
ct)
bug :: (Var v) => Text -> Term v ()
bug :: forall v. Var v => Text -> Term v ()
bug Text
msg = ()
-> Term2 v () () v () -> Term2 v () () v () -> Term2 v () () v ()
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
app () (() -> Text -> Term2 v () () v ()
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin () Text
"bug") (() -> Text -> Term2 v () () v ()
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
text () Text
msg)
err :: DecompError -> a -> (Set DecompError, a)
err :: forall a. DecompError -> a -> (Set DecompError, a)
err DecompError
err a
x = (DecompError -> Set DecompError
forall a. a -> Set a
singleton DecompError
err, a
x)
data DecompError
= BadBool !Word64
| BadUnboxed !UnboxedTypeTag
| BadForeign !Reference
| BadData !Reference
| BadPAp !Reference
| UnkComb !Reference
| UnkLocal !Reference !Word64
| Cont
| Exn
| Aff
deriving (DecompError -> DecompError -> Bool
(DecompError -> DecompError -> Bool)
-> (DecompError -> DecompError -> Bool) -> Eq DecompError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecompError -> DecompError -> Bool
== :: DecompError -> DecompError -> Bool
$c/= :: DecompError -> DecompError -> Bool
/= :: DecompError -> DecompError -> Bool
Eq, Eq DecompError
Eq DecompError =>
(DecompError -> DecompError -> Ordering)
-> (DecompError -> DecompError -> Bool)
-> (DecompError -> DecompError -> Bool)
-> (DecompError -> DecompError -> Bool)
-> (DecompError -> DecompError -> Bool)
-> (DecompError -> DecompError -> DecompError)
-> (DecompError -> DecompError -> DecompError)
-> Ord DecompError
DecompError -> DecompError -> Bool
DecompError -> DecompError -> Ordering
DecompError -> DecompError -> DecompError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DecompError -> DecompError -> Ordering
compare :: DecompError -> DecompError -> Ordering
$c< :: DecompError -> DecompError -> Bool
< :: DecompError -> DecompError -> Bool
$c<= :: DecompError -> DecompError -> Bool
<= :: DecompError -> DecompError -> Bool
$c> :: DecompError -> DecompError -> Bool
> :: DecompError -> DecompError -> Bool
$c>= :: DecompError -> DecompError -> Bool
>= :: DecompError -> DecompError -> Bool
$cmax :: DecompError -> DecompError -> DecompError
max :: DecompError -> DecompError -> DecompError
$cmin :: DecompError -> DecompError -> DecompError
min :: DecompError -> DecompError -> DecompError
Ord)
type DecompResult v = (Set DecompError, Term v ())
prf :: Reference -> Error
prf :: Reference -> Pretty ColorText
prf = Pretty (SyntaxText' Reference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
syntaxToColor (Pretty (SyntaxText' Reference) -> Pretty ColorText)
-> (Reference -> Pretty (SyntaxText' Reference))
-> Reference
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Reference -> Pretty (SyntaxText' Reference)
prettyReference Int
10
printUnboxedTypeTag :: UnboxedTypeTag -> Error
printUnboxedTypeTag :: UnboxedTypeTag -> Pretty ColorText
printUnboxedTypeTag = UnboxedTypeTag -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
shown
renderDecompError :: DecompError -> Error
renderDecompError :: DecompError -> Pretty ColorText
renderDecompError (BadBool Word64
n) =
[Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines
[ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
wrap Pretty ColorText
"A boolean value had an unexpected constructor tag:",
Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> (String -> Pretty ColorText) -> String -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColorText -> Pretty ColorText
forall s. (IsString s, ListLike s Char) => s -> Pretty s
lit (ColorText -> Pretty ColorText)
-> (String -> ColorText) -> String -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ColorText
forall a. IsString a => String -> a
fromString (String -> Pretty ColorText) -> String -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Word64 -> String
forall a. Show a => a -> String
show Word64
n
]
renderDecompError (BadUnboxed UnboxedTypeTag
tt) =
[Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines
[ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
wrap Pretty ColorText
"An apparent numeric type had an unrecognized packed tag:",
Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ UnboxedTypeTag -> Pretty ColorText
printUnboxedTypeTag UnboxedTypeTag
tt
]
renderDecompError (BadForeign Reference
rf) =
[Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines
[ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
wrap Pretty ColorText
"A foreign value with no decompiled representation was encountered:",
Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Reference -> Pretty ColorText
prf Reference
rf
]
renderDecompError (BadData Reference
rf) =
[Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines
[ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
wrap
Pretty ColorText
"A data type with no decompiled representation was encountered:",
Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Reference -> Pretty ColorText
prf Reference
rf
]
renderDecompError (BadPAp Reference
rf) =
[Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines
[ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
wrap Pretty ColorText
"A partial function application could not be decompiled: ",
Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Reference -> Pretty ColorText
prf Reference
rf
]
renderDecompError (UnkComb Reference
rf) =
[Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines
[ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
wrap Pretty ColorText
"A reference to an unknown function was encountered: ",
Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Reference -> Pretty ColorText
prf Reference
rf
]
renderDecompError (UnkLocal Reference
rf Word64
n) =
[Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
lines
[ Pretty ColorText
"A reference to an unknown portion to a function was encountered: ",
Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"function: " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Reference -> Pretty ColorText
prf Reference
rf,
Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"section: " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> ColorText -> Pretty ColorText
forall s. (IsString s, ListLike s Char) => s -> Pretty s
lit (String -> ColorText
forall a. IsString a => String -> a
fromString (String -> ColorText) -> String -> ColorText
forall a b. (a -> b) -> a -> b
$ Word64 -> String
forall a. Show a => a -> String
show Word64
n)
]
renderDecompError DecompError
Cont = Pretty ColorText
"A continuation value was encountered"
renderDecompError DecompError
Exn = Pretty ColorText
"An exception value was encountered"
renderDecompError DecompError
Aff = Pretty ColorText
"An affine info value was encountered"
decompile ::
forall v.
(Var v) =>
(Reference -> Maybe Reference) ->
(Word64 -> Word64 -> Maybe (Term v ())) ->
Val ->
DecompResult v
decompile :: forall v.
Var v =>
(Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ())) -> Val -> DecompResult v
decompile Reference -> Maybe Reference
backref Word64 -> Word64 -> Maybe (Term v ())
topTerms = \case
CharVal Char
c -> Term v () -> DecompResult v
forall a. a -> (Set DecompError, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Char -> Term v ()
forall v a vt at ap. Ord v => a -> Char -> Term2 vt at ap v a
char () Char
c)
NatVal Word64
n -> Term v () -> DecompResult v
forall a. a -> (Set DecompError, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Word64 -> Term v ()
forall v a vt at ap. Ord v => a -> Word64 -> Term2 vt at ap v a
nat () Word64
n)
IntVal Int
i -> Term v () -> DecompResult v
forall a. a -> (Set DecompError, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Int64 -> Term v ()
forall v a vt at ap. Ord v => a -> Int64 -> Term2 vt at ap v a
int () (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i))
DoubleVal Double
f -> Term v () -> DecompResult v
forall a. a -> (Set DecompError, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Double -> Term v ()
forall v a vt at ap. Ord v => a -> Double -> Term2 vt at ap v a
float () Double
f)
Val Int
i (UnboxedTypeTag UnboxedTypeTag
tt) ->
DecompError -> Term v () -> DecompResult v
forall a. DecompError -> a -> (Set DecompError, a)
err (UnboxedTypeTag -> DecompError
BadUnboxed UnboxedTypeTag
tt) (Term v () -> DecompResult v)
-> (Word64 -> Term v ()) -> Word64 -> DecompResult v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Word64 -> Term v ()
forall v a vt at ap. Ord v => a -> Word64 -> Term2 vt at ap v a
nat () (Word64 -> DecompResult v) -> Word64 -> DecompResult v
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Int
i
Val Int
_u Closure
clos -> case Closure
clos of
DataC Reference
rf (PackedTag -> Word64
maskTags -> Word64
ct) []
| Reference
rf Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
booleanRef -> Word64 -> DecompResult v
forall v. Var v => Word64 -> DecompResult v
tag2bool Word64
ct
(DataC Reference
rf PackedTag
_ [Val
b])
| Reference
rf Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
anyRef ->
() -> Term v () -> Term v () -> Term v ()
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
app () (() -> Text -> Term v ()
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin () Text
"Any.Any") (Term v () -> Term v ()) -> DecompResult v -> DecompResult v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ())) -> Val -> DecompResult v
forall v.
Var v =>
(Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ())) -> Val -> DecompResult v
decompile Reference -> Maybe Reference
backref Word64 -> Word64 -> Maybe (Term v ())
topTerms Val
b
(DataC Reference
rf (PackedTag -> Word64
maskTags -> Word64
ct) [Val]
vs) ->
Term v () -> [Term v ()] -> Term v ()
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' (Reference -> Word64 -> Term v ()
forall v. Var v => Reference -> Word64 -> Term v ()
con Reference
rf Word64
ct) ([Term v ()] -> Term v ())
-> (Set DecompError, [Term v ()]) -> DecompResult v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val -> DecompResult v) -> [Val] -> (Set DecompError, [Term v ()])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ())) -> Val -> DecompResult v
forall v.
Var v =>
(Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ())) -> Val -> DecompResult v
decompile Reference -> Maybe Reference
backref Word64 -> Word64 -> Maybe (Term v ())
topTerms) [Val]
vs
(PApV (CIx Reference
rf Word64
rt Word64
k) RCombInfo Val
_ [Val]
vs)
| Reference
rf Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Reference
forall t h. t -> Reference' t h
Builtin Text
"jumpCont" ->
DecompError -> Term v () -> DecompResult v
forall a. DecompError -> a -> (Set DecompError, a)
err DecompError
Cont (Term v () -> DecompResult v) -> Term v () -> DecompResult v
forall a b. (a -> b) -> a -> b
$ Text -> Term v ()
forall v. Var v => Text -> Term v ()
bug Text
"<Continuation>"
| Just Term v ()
t <- Word64 -> Word64 -> Maybe (Term v ())
topTerms Word64
rt Word64
k ->
Term v () -> Term v ()
forall v. Var v => Term0 v -> Term0 v
Term.etaReduceEtaVars (Term v () -> Term v ())
-> ([Term v ()] -> Term v ()) -> [Term v ()] -> Term v ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v () -> [Term v ()] -> Term v ()
forall v. Var v => Term v () -> [Term v ()] -> Term v ()
substitute Term v ()
t
([Term v ()] -> Term v ())
-> (Set DecompError, [Term v ()]) -> DecompResult v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val -> DecompResult v) -> [Val] -> (Set DecompError, [Term v ()])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ())) -> Val -> DecompResult v
forall v.
Var v =>
(Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ())) -> Val -> DecompResult v
decompile Reference -> Maybe Reference
backref Word64 -> Word64 -> Maybe (Term v ())
topTerms) [Val]
vs
| Word64
k Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
0,
Just Term v ()
_ <- Word64 -> Word64 -> Maybe (Term v ())
topTerms Word64
rt Word64
0 ->
DecompError -> Term v () -> DecompResult v
forall a. DecompError -> a -> (Set DecompError, a)
err (Reference -> Word64 -> DecompError
UnkLocal Reference
rf Word64
k) (Term v () -> DecompResult v) -> Term v () -> DecompResult v
forall a b. (a -> b) -> a -> b
$ Text -> Term v ()
forall v. Var v => Text -> Term v ()
bug Text
"<Unknown>"
| Builtin Text
nm <- Reference
rf ->
Term v () -> [Term v ()] -> Term v ()
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' (() -> Text -> Term v ()
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin () Text
nm) ([Term v ()] -> Term v ())
-> (Set DecompError, [Term v ()]) -> DecompResult v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val -> DecompResult v) -> [Val] -> (Set DecompError, [Term v ()])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ())) -> Val -> DecompResult v
forall v.
Var v =>
(Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ())) -> Val -> DecompResult v
decompile Reference -> Maybe Reference
backref Word64 -> Word64 -> Maybe (Term v ())
topTerms) [Val]
vs
| Bool
otherwise -> DecompError -> Term v () -> DecompResult v
forall a. DecompError -> a -> (Set DecompError, a)
err (Reference -> DecompError
UnkComb Reference
rf) (Term v () -> DecompResult v) -> Term v () -> DecompResult v
forall a b. (a -> b) -> a -> b
$ () -> Reference -> Term v ()
forall v a vt at ap. Ord v => a -> Reference -> Term2 vt at ap v a
ref () Reference
rf
(PAp (CIx Reference
rf Word64
_ Word64
_) RCombInfo Val
_ Seg
_) ->
DecompError -> Term v () -> DecompResult v
forall a. DecompError -> a -> (Set DecompError, a)
err (Reference -> DecompError
BadPAp Reference
rf) (Term v () -> DecompResult v) -> Term v () -> DecompResult v
forall a b. (a -> b) -> a -> b
$ Text -> Term v ()
forall v. Var v => Text -> Term v ()
bug Text
"<Unknown>"
Closure
BlackHole -> DecompError -> Term v () -> DecompResult v
forall a. DecompError -> a -> (Set DecompError, a)
err DecompError
Exn (Term v () -> DecompResult v) -> Term v () -> DecompResult v
forall a b. (a -> b) -> a -> b
$ Text -> Term v ()
forall v. Var v => Text -> Term v ()
bug Text
"<Exception>"
(Captured {}) -> DecompError -> Term v () -> DecompResult v
forall a. DecompError -> a -> (Set DecompError, a)
err DecompError
Cont (Term v () -> DecompResult v) -> Term v () -> DecompResult v
forall a b. (a -> b) -> a -> b
$ Text -> Term v ()
forall v. Var v => Text -> Term v ()
bug Text
"<Continuation>"
(Affine {}) -> DecompError -> Term v () -> DecompResult v
forall a. DecompError -> a -> (Set DecompError, a)
err DecompError
Aff (Term v () -> DecompResult v) -> Term v () -> DecompResult v
forall a b. (a -> b) -> a -> b
$ Text -> Term v ()
forall v. Var v => Text -> Term v ()
bug Text
"<Affine>"
(Foreign Foreign
f) ->
(Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ()))
-> Foreign
-> DecompResult v
forall v.
Var v =>
(Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ()))
-> Foreign
-> DecompResult v
decompileForeign Reference -> Maybe Reference
backref Word64 -> Word64 -> Maybe (Term v ())
topTerms Foreign
f
tag2bool :: (Var v) => Word64 -> DecompResult v
tag2bool :: forall v. Var v => Word64 -> DecompResult v
tag2bool Word64
0 = Term v () -> (Set DecompError, Term v ())
forall a. a -> (Set DecompError, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Bool -> Term v ()
forall v a vt at ap. Ord v => a -> Bool -> Term2 vt at ap v a
boolean () Bool
False)
tag2bool Word64
1 = Term v () -> (Set DecompError, Term v ())
forall a. a -> (Set DecompError, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Bool -> Term v ()
forall v a vt at ap. Ord v => a -> Bool -> Term2 vt at ap v a
boolean () Bool
True)
tag2bool Word64
n = DecompError -> Term v () -> (Set DecompError, Term v ())
forall a. DecompError -> a -> (Set DecompError, a)
err (Word64 -> DecompError
BadBool Word64
n) (Term v () -> (Set DecompError, Term v ()))
-> Term v () -> (Set DecompError, Term v ())
forall a b. (a -> b) -> a -> b
$ Reference -> Word64 -> Term v ()
forall v. Var v => Reference -> Word64 -> Term v ()
con Reference
booleanRef Word64
n
substitute :: (Var v) => Term v () -> [Term v ()] -> Term v ()
substitute :: forall v. Var v => Term v () -> [Term v ()] -> Term v ()
substitute = [(v, Term (F v () ()) v ())]
-> Term (F v () ()) v ()
-> [Term (F v () ()) v ()]
-> Term (F v () ()) v ()
forall {v} {a} {typeVar} {typeAnn} {patternAnn}.
(Var v, Semigroup a) =>
[(v, Term (F typeVar typeAnn patternAnn) v a)]
-> Term (F typeVar typeAnn patternAnn) v a
-> [Term (F typeVar typeAnn patternAnn) v a]
-> Term (F typeVar typeAnn patternAnn) v a
align []
where
align :: [(v, Term (F typeVar typeAnn patternAnn) v a)]
-> Term (F typeVar typeAnn patternAnn) v a
-> [Term (F typeVar typeAnn patternAnn) v a]
-> Term (F typeVar typeAnn patternAnn) v a
align [(v, Term (F typeVar typeAnn patternAnn) v a)]
vts (LamNamed' v
v Term (F typeVar typeAnn patternAnn) v a
bd) (Term (F typeVar typeAnn patternAnn) v a
t : [Term (F typeVar typeAnn patternAnn) v a]
ts) = [(v, Term (F typeVar typeAnn patternAnn) v a)]
-> Term (F typeVar typeAnn patternAnn) v a
-> [Term (F typeVar typeAnn patternAnn) v a]
-> Term (F typeVar typeAnn patternAnn) v a
align ((v
v, Term (F typeVar typeAnn patternAnn) v a
t) (v, Term (F typeVar typeAnn patternAnn) v a)
-> [(v, Term (F typeVar typeAnn patternAnn) v a)]
-> [(v, Term (F typeVar typeAnn patternAnn) v a)]
forall a. a -> [a] -> [a]
: [(v, Term (F typeVar typeAnn patternAnn) v a)]
vts) Term (F typeVar typeAnn patternAnn) v a
bd [Term (F typeVar typeAnn patternAnn) v a]
ts
align [(v, Term (F typeVar typeAnn patternAnn) v a)]
vts Term (F typeVar typeAnn patternAnn) v a
tm [] = [(v, Term (F typeVar typeAnn patternAnn) v a)]
-> Term (F typeVar typeAnn patternAnn) v a
-> Term (F typeVar typeAnn patternAnn) v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v a)] -> Term f v a -> Term f v a
substs [(v, Term (F typeVar typeAnn patternAnn) v a)]
vts Term (F typeVar typeAnn patternAnn) v a
tm
align [(v, Term (F typeVar typeAnn patternAnn) v a)]
vts Term (F typeVar typeAnn patternAnn) v a
tm [Term (F typeVar typeAnn patternAnn) v a]
ts = Term (F typeVar typeAnn patternAnn) v a
-> [Term (F typeVar typeAnn patternAnn) v a]
-> Term (F typeVar typeAnn patternAnn) v a
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
apps' ([(v, Term (F typeVar typeAnn patternAnn) v a)]
-> Term (F typeVar typeAnn patternAnn) v a
-> Term (F typeVar typeAnn patternAnn) v a
forall (f :: * -> *) v a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v a)] -> Term f v a -> Term f v a
substs [(v, Term (F typeVar typeAnn patternAnn) v a)]
vts Term (F typeVar typeAnn patternAnn) v a
tm) [Term (F typeVar typeAnn patternAnn) v a]
ts
decompileForeign ::
(Var v) =>
(Reference -> Maybe Reference) ->
(Word64 -> Word64 -> Maybe (Term v ())) ->
Foreign ->
DecompResult v
decompileForeign :: forall v.
Var v =>
(Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ()))
-> Foreign
-> DecompResult v
decompileForeign Reference -> Maybe Reference
backref Word64 -> Word64 -> Maybe (Term v ())
topTerms Foreign
f
| Just Text
t <- Foreign -> Maybe Text
forall f. BuiltinForeign f => Foreign -> Maybe f
maybeUnwrapBuiltin Foreign
f = Term v () -> (Set DecompError, Term v ())
forall a. a -> (Set DecompError, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v () -> (Set DecompError, Term v ()))
-> Term v () -> (Set DecompError, Term v ())
forall a b. (a -> b) -> a -> b
$ () -> Text -> Term v ()
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
text () (Text -> Text
Text.toText Text
t)
| Just Bytes
b <- Foreign -> Maybe Bytes
forall f. BuiltinForeign f => Foreign -> Maybe f
maybeUnwrapBuiltin Foreign
f = Term v () -> (Set DecompError, Term v ())
forall a. a -> (Set DecompError, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v () -> (Set DecompError, Term v ()))
-> Term v () -> (Set DecompError, Term v ())
forall a b. (a -> b) -> a -> b
$ Bytes -> Term v ()
forall v. Var v => Bytes -> Term v ()
decompileBytes Bytes
b
| Just HashAlgorithm
h <- Foreign -> Maybe HashAlgorithm
forall f. BuiltinForeign f => Foreign -> Maybe f
maybeUnwrapBuiltin Foreign
f = Term v () -> (Set DecompError, Term v ())
forall a. a -> (Set DecompError, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v () -> (Set DecompError, Term v ()))
-> Term v () -> (Set DecompError, Term v ())
forall a b. (a -> b) -> a -> b
$ HashAlgorithm -> Term v ()
forall v. Var v => HashAlgorithm -> Term v ()
decompileHashAlgorithm HashAlgorithm
h
| Just Referent
l <- Reference -> Foreign -> Maybe Referent
forall a. Reference -> Foreign -> Maybe a
maybeUnwrapForeign Reference
termLinkRef Foreign
f =
Term v () -> (Set DecompError, Term v ())
forall a. a -> (Set DecompError, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v () -> (Set DecompError, Term v ()))
-> (Referent -> Term v ())
-> Referent
-> (Set DecompError, Term v ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Referent -> Term v ()
forall v a vt at ap. Ord v => a -> Referent -> Term2 vt at ap v a
termLink () (Referent -> (Set DecompError, Term v ()))
-> Referent -> (Set DecompError, Term v ())
forall a b. (a -> b) -> a -> b
$ case Referent
l of
Ref Reference
r -> Referent -> (Reference -> Referent) -> Maybe Reference -> Referent
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Referent
l Reference -> Referent
Ref (Maybe Reference -> Referent) -> Maybe Reference -> Referent
forall a b. (a -> b) -> a -> b
$ Reference -> Maybe Reference
backref Reference
r
Referent
_ -> Referent
l
| Just Reference
l <- Reference -> Foreign -> Maybe Reference
forall a. Reference -> Foreign -> Maybe a
maybeUnwrapForeign Reference
typeLinkRef Foreign
f =
Term v () -> (Set DecompError, Term v ())
forall a. a -> (Set DecompError, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v () -> (Set DecompError, Term v ()))
-> Term v () -> (Set DecompError, Term v ())
forall a b. (a -> b) -> a -> b
$ () -> Reference -> Term v ()
forall v a vt at ap. Ord v => a -> Reference -> Term2 vt at ap v a
typeLink () Reference
l
| Just (Array Val
a :: Array Val) <- Reference -> Foreign -> Maybe (Array Val)
forall a. Reference -> Foreign -> Maybe a
maybeUnwrapForeign Reference
iarrayRef Foreign
f =
() -> Term v () -> Term v () -> Term v ()
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
app () (() -> Reference -> Term v ()
forall v a vt at ap. Ord v => a -> Reference -> Term2 vt at ap v a
ref () Reference
iarrayFromListRef) (Term v () -> Term v ())
-> ([Term v ()] -> Term v ()) -> [Term v ()] -> Term v ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> [Term v ()] -> Term v ()
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
list ()
([Term v ()] -> Term v ())
-> (Set DecompError, [Term v ()]) -> (Set DecompError, Term v ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val -> (Set DecompError, Term v ()))
-> [Val] -> (Set DecompError, [Term v ()])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ()))
-> Val
-> (Set DecompError, Term v ())
forall v.
Var v =>
(Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ())) -> Val -> DecompResult v
decompile Reference -> Maybe Reference
backref Word64 -> Word64 -> Maybe (Term v ())
topTerms) (Array Val -> [Val]
forall a. Array a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array Val
a)
| Just (ByteArray
a :: ByteArray) <- Reference -> Foreign -> Maybe ByteArray
forall a. Reference -> Foreign -> Maybe a
maybeUnwrapForeign Reference
ibytearrayRef Foreign
f =
Term v () -> (Set DecompError, Term v ())
forall a. a -> (Set DecompError, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v () -> (Set DecompError, Term v ()))
-> Term v () -> (Set DecompError, Term v ())
forall a b. (a -> b) -> a -> b
$
() -> Term v () -> Term v () -> Term v ()
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
app
()
(() -> Reference -> Term v ()
forall v a vt at ap. Ord v => a -> Reference -> Term2 vt at ap v a
ref () Reference
ibarrayFromBytesRef)
(Bytes -> Term v ()
forall v. Var v => Bytes -> Term v ()
decompileBytes (Bytes -> Term v ()) -> ([Word8] -> Bytes) -> [Word8] -> Term v ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Bytes
By.fromWord8s ([Word8] -> Term v ()) -> [Word8] -> Term v ()
forall a b. (a -> b) -> a -> b
$ ByteArray -> [Word8]
byteArrayToList ByteArray
a)
| Just USeq
s <- Foreign -> Maybe USeq
unwrapSeq Foreign
f =
() -> Seq (Term v ()) -> Term v ()
forall v a vt at ap.
Ord v =>
a -> Seq (Term2 vt at ap v a) -> Term2 vt at ap v a
list' () (Seq (Term v ()) -> Term v ())
-> (Set DecompError, Seq (Term v ()))
-> (Set DecompError, Term v ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val -> (Set DecompError, Term v ()))
-> USeq -> (Set DecompError, Seq (Term v ()))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse ((Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ()))
-> Val
-> (Set DecompError, Term v ())
forall v.
Var v =>
(Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ())) -> Val -> DecompResult v
decompile Reference -> Maybe Reference
backref Word64 -> Word64 -> Maybe (Term v ())
topTerms) USeq
s
| Just Map Val Val
m <- Reference -> Foreign -> Maybe (Map Val Val)
forall a. Reference -> Foreign -> Maybe a
maybeUnwrapForeign Reference
hmapRef Foreign
f = do
let decompileEntry :: Val -> Val -> (Set DecompError, Term v ())
decompileEntry Val
k Val
v = Term v () -> Term v () -> Term v ()
forall v. Var v => Term v () -> Term v () -> Term v ()
pair (Term v () -> Term v () -> Term v ())
-> (Set DecompError, Term v ())
-> (Set DecompError, Term v () -> Term v ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ()))
-> Val
-> (Set DecompError, Term v ())
forall v.
Var v =>
(Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ())) -> Val -> DecompResult v
decompile Reference -> Maybe Reference
backref Word64 -> Word64 -> Maybe (Term v ())
topTerms Val
k (Set DecompError, Term v () -> Term v ())
-> (Set DecompError, Term v ()) -> (Set DecompError, Term v ())
forall a b.
(Set DecompError, a -> b)
-> (Set DecompError, a) -> (Set DecompError, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ()))
-> Val
-> (Set DecompError, Term v ())
forall v.
Var v =>
(Reference -> Maybe Reference)
-> (Word64 -> Word64 -> Maybe (Term v ())) -> Val -> DecompResult v
decompile Reference -> Maybe Reference
backref Word64 -> Word64 -> Maybe (Term v ())
topTerms Val
v
[Term v ()]
kvs <- ((Val, Val) -> (Set DecompError, Term v ()))
-> [(Val, Val)] -> (Set DecompError, [Term v ()])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Val -> Val -> (Set DecompError, Term v ()))
-> (Val, Val) -> (Set DecompError, Term v ())
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Val -> Val -> (Set DecompError, Term v ())
decompileEntry) (Map Val Val -> [(Val, Val)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Val Val
m)
pure $ () -> Term v () -> Term v () -> Term v ()
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
app () Term v ()
forall v. Var v => Term v ()
map_fromList (() -> [Term v ()] -> Term v ()
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
list () [Term v ()]
kvs)
decompileForeign Reference -> Maybe Reference
_ Word64 -> Word64 -> Maybe (Term v ())
_ (Wrap Reference
r e
_) =
DecompError -> Term v () -> (Set DecompError, Term v ())
forall a. DecompError -> a -> (Set DecompError, a)
err (Reference -> DecompError
BadForeign Reference
r) (Term v () -> (Set DecompError, Term v ()))
-> Term v () -> (Set DecompError, Term v ())
forall a b. (a -> b) -> a -> b
$ Text -> Term v ()
forall v. Var v => Text -> Term v ()
bug Text
text
where
text :: Text
text
| Builtin Text
name <- Reference
r = Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
| Bool
otherwise = Text
"<Foreign>"
map_fromList :: (Var v) => Term v ()
map_fromList :: forall v. Var v => Term v ()
map_fromList =
case Text -> Maybe Referent
Referent.fromText Text
"#apmvhl40hl48q1s7383g5ev3sh7td8qo374t87bchpnu24sccmnvm13e2a1q0f2p1prm2uk9prfpg598dc9jo23iagact6gmi18vta8" of
Just Referent
r -> () -> Referent -> Term v ()
forall v a vt at ap. Ord v => a -> Referent -> Term2 vt at ap v a
Term.fromReferent () Referent
r
Maybe Referent
Nothing -> String -> Term v ()
forall a. HasCallStack => String -> a
error String
"Map_fromList"
pair :: (Var v) => Term v () -> Term v () -> Term v ()
pair :: forall v. Var v => Term v () -> Term v () -> Term v ()
pair Term v ()
a Term v ()
b =
Term v () -> [Term v ()] -> Term v ()
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.apps'
(() -> Referent -> Term v ()
forall v a vt at ap. Ord v => a -> Referent -> Term2 vt at ap v a
Term.fromReferent () Referent
DD.pairCtorRef)
[ Term v ()
a,
Term v () -> [Term v ()] -> Term v ()
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.apps' (() -> Referent -> Term v ()
forall v a vt at ap. Ord v => a -> Referent -> Term2 vt at ap v a
Term.fromReferent () Referent
DD.pairCtorRef) [Term v ()
b, () -> Referent -> Term v ()
forall v a vt at ap. Ord v => a -> Referent -> Term2 vt at ap v a
Term.fromReferent () Referent
DD.unitCtorRef]
]
decompileBytes :: (Var v) => By.Bytes -> Term v ()
decompileBytes :: forall v. Var v => Bytes -> Term v ()
decompileBytes =
()
-> Term2 v () () v () -> Term2 v () () v () -> Term2 v () () v ()
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
app () (() -> Text -> Term2 v () () v ()
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
builtin () (Text -> Term2 v () () v ()) -> Text -> Term2 v () () v ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
"Bytes.fromList")
(Term2 v () () v () -> Term2 v () () v ())
-> (Bytes -> Term2 v () () v ()) -> Bytes -> Term2 v () () v ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> [Term2 v () () v ()] -> Term2 v () () v ()
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
list ()
([Term2 v () () v ()] -> Term2 v () () v ())
-> (Bytes -> [Term2 v () () v ()]) -> Bytes -> Term2 v () () v ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Term2 v () () v ()) -> [Word8] -> [Term2 v () () v ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> Word64 -> Term2 v () () v ()
forall v a vt at ap. Ord v => a -> Word64 -> Term2 vt at ap v a
nat () (Word64 -> Term2 v () () v ())
-> (Word8 -> Word64) -> Word8 -> Term2 v () () v ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
([Word8] -> [Term2 v () () v ()])
-> (Bytes -> [Word8]) -> Bytes -> [Term2 v () () v ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> [Word8]
By.toWord8s
decompileHashAlgorithm :: (Var v) => HashAlgorithm -> Term v ()
decompileHashAlgorithm :: forall v. Var v => HashAlgorithm -> Term v ()
decompileHashAlgorithm (HashAlgorithm Reference
r a
_) = () -> Reference -> Term2 v () () v ()
forall v a vt at ap. Ord v => a -> Reference -> Term2 vt at ap v a
ref () Reference
r
unwrapSeq :: Foreign -> Maybe USeq
unwrapSeq :: Foreign -> Maybe USeq
unwrapSeq = Reference -> Foreign -> Maybe USeq
forall a. Reference -> Foreign -> Maybe a
maybeUnwrapForeign Reference
listRef