<commit_before>{-# language PatternGuards #-}
{-# language TupleSections #-}
{-# language PatternSynonyms #-}

module Unison.Runtime.Decompile
  ( decompile ) where

import Data.String (fromString)
import Data.Word (Word64)

import Unison.ABT (absChain, substs, pattern AbsN')
import Unison.Term
  ( Term
  , nat, int, float, boolean, constructor, apps'
  )
import Unison.Type
  ( natRef, intRef, floatRef, booleanRef
  )
import Unison.Var (Var)
import Unison.Reference (Reference)

import Unison.Runtime.ANF (RTag, CTag, Tag(..))
import Unison.Runtime.Foreign (Foreign)
import Unison.Runtime.Stack
  (Closure(..), pattern DataC, pattern PApV, IComb(..))

import Unison.Codebase.Runtime (Error)
import Unison.Util.Pretty (lit)

import Unsafe.Coerce -- for Int -> Double

con :: Var v => Reference -> CTag -> Term v ()
con rf ct = constructor () rf . fromIntegral $ rawTag ct

err :: String -> Either Error a
err = Left . lit . fromString

decompile
  :: Var v
  => (RTag -> Maybe Reference)
  -> (Word64 -> Maybe (Term v ()))
  -> Closure
  -> Either Error (Term v ())
decompile tyRef _ (DataC rt ct [] [])
  | Just rf <- tyRef rt
  , rf == booleanRef
  = boolean () <$> tag2bool ct
decompile tyRef _ (DataC rt ct [i] [])
  | Just rf <- tyRef rt
  = decompileUnboxed rf ct i
decompile tyRef topTerms (DataC rt ct [] bs)
  | Just rf <- tyRef rt
  = apps' (con rf ct) <$> traverse (decompile tyRef topTerms) bs
decompile tyRef topTerms (PApV (IC rt _) [] bs)
  | Just t <- topTerms rt
  = substitute t <$> traverse (decompile tyRef topTerms) bs
  | otherwise
  = err "reference to unknown combinator"
decompile _ _ (PAp _ _ _)
  = err "cannot decompile a partial application to unboxed values"
decompile _ _ (DataC{})
  = err "cannot decompile data type with multiple unboxed fields"
decompile _ _ BlackHole = err "exception"
decompile _ _ (Captured{}) = err "decompiling a captured continuation"
decompile tyRef _ (Foreign f) = decompileForeign tyRef f

tag2bool :: CTag -> Either Error Bool
tag2bool c = case rawTag c of
  0 -> Right False
  1 -> Right True
  _ -> err "bad boolean tag"

substitute :: Var v => Term v () -> [Term v ()] -> Term v ()
substitute (AbsN' vs bd) ts = align [] vs ts
  where
  align vts (v:vs) (t:ts) = align ((v,t):vts) vs ts
  align vts vs [] = substs vts (absChain vs bd)
  -- this should not happen
  align vts [] ts = apps' (substs vts bd) ts
-- TODO: these aliases are not actually very conveniently written
substitute _ _ = error "impossible"

decompileUnboxed
  :: Var v => Reference -> CTag -> Int -> Either Error (Term v ())
decompileUnboxed r _ i
  | r == natRef = pure . nat () $ fromIntegral i
  | r == intRef = pure . int () $ fromIntegral i
  | r == floatRef = pure . float () $ unsafeCoerce i
decompileUnboxed _ _ _ = err "cannot decompile unboxed data type"

decompileForeign
  :: Var v
  => (RTag -> Maybe Reference)
  -> Foreign
  -> Either Error (Term v ())
decompileForeign _ _ = err "cannot decompile Foreign"<commit_msg>More information in decompilation errors.<commit_after>{-# language PatternGuards #-}
{-# language TupleSections #-}
{-# language PatternSynonyms #-}

module Unison.Runtime.Decompile
  ( decompile ) where

import Data.String (fromString)
import Data.Word (Word64)

import Unison.ABT (absChain, substs, pattern AbsN')
import Unison.Term
  ( Term
  , nat, int, float, boolean, constructor, apps'
  )
import Unison.Type
  ( natRef, intRef, floatRef, booleanRef
  )
import Unison.Var (Var)
import Unison.Reference (Reference)

import Unison.Runtime.ANF (RTag, CTag, Tag(..))
import Unison.Runtime.Foreign (Foreign)
import Unison.Runtime.Stack
  (Closure(..), pattern DataC, pattern PApV, IComb(..))

import Unison.Codebase.Runtime (Error)
import Unison.Util.Pretty (lit)

import Unsafe.Coerce -- for Int -> Double

con :: Var v => Reference -> CTag -> Term v ()
con rf ct = constructor () rf . fromIntegral $ rawTag ct

err :: String -> Either Error a
err = Left . lit . fromString

decompile
  :: Var v
  => (RTag -> Maybe Reference)
  -> (Word64 -> Maybe (Term v ()))
  -> Closure
  -> Either Error (Term v ())
decompile tyRef _ (DataC rt ct [] [])
  | Just rf <- tyRef rt
  , rf == booleanRef
  = boolean () <$> tag2bool ct
decompile tyRef _ (DataC rt ct [i] [])
  | Just rf <- tyRef rt
  = decompileUnboxed rf ct i
decompile tyRef topTerms (DataC rt ct [] bs)
  | Just rf <- tyRef rt
  = apps' (con rf ct) <$> traverse (decompile tyRef topTerms) bs
decompile tyRef topTerms (PApV (IC rt _) [] bs)
  | Just t <- topTerms rt
  = substitute t <$> traverse (decompile tyRef topTerms) bs
  | otherwise
  = err "reference to unknown combinator"
decompile _ _ (PAp _ _ _)
  = err "cannot decompile a partial application to unboxed values"
decompile _ _ (DataC{})
  = err "cannot decompile data type with multiple unboxed fields"
decompile _ _ BlackHole = err "exception"
decompile _ _ (Captured{}) = err "decompiling a captured continuation"
decompile tyRef _ (Foreign f) = decompileForeign tyRef f

tag2bool :: CTag -> Either Error Bool
tag2bool c = case rawTag c of
  0 -> Right False
  1 -> Right True
  _ -> err "bad boolean tag"

substitute :: Var v => Term v () -> [Term v ()] -> Term v ()
substitute (AbsN' vs bd) ts = align [] vs ts
  where
  align vts (v:vs) (t:ts) = align ((v,t):vts) vs ts
  align vts vs [] = substs vts (absChain vs bd)
  -- this should not happen
  align vts [] ts = apps' (substs vts bd) ts
-- TODO: these aliases are not actually very conveniently written
substitute _ _ = error "impossible"

decompileUnboxed
  :: Var v => Reference -> CTag -> Int -> Either Error (Term v ())
decompileUnboxed r _ i
  | r == natRef = pure . nat () $ fromIntegral i
  | r == intRef = pure . int () $ fromIntegral i
  | r == floatRef = pure . float () $ unsafeCoerce i
decompileUnboxed r _ _
  = err $ "cannot decompile unboxed data type with reference: " ++ show r

decompileForeign
  :: Var v
  => (RTag -> Maybe Reference)
  -> Foreign
  -> Either Error (Term v ())
decompileForeign _ _ = err "cannot decompile Foreign"
{'fraction_non_alphanumeric': 0.12218703117186197, 'fraction_numerical': 0.0030005000833472247, 'mean_word_length': 3.4676098287416233, 'pattern_counts': {'":': 0, '<': 17, '<?xml version=': 0, '>': 61, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4620876', 'n_tokens_mistral': 2086, 'n_tokens_neox': 2010, 'n_words': 726}