<commit_before>module TrSTG where

import qualified Core
import qualified Typing as Ty
import STG

import Debug.Trace

trVar (Core.TermVar n _) = TermVar n

trVar (Core.DictVar n1 n2) = DictVar n1 n2

trLit (Core.LitInt i _) = LitInt i

trLit (Core.LitChar c _) = LitChar c

trLit (Core.LitStr s _) = LitStr s

trLit (Core.LitFrac r _) = LitFrac r

trExpr (Core.Var v) = AtomExpr $ VarAtom $ trVar v

trExpr (Core.Lit l) = AtomExpr $ LitAtom $ trLit l

trExpr (Core.App f x) = FunAppExpr f' [x']
  where
    f' = trExpr f
    x' = trExpr x

trExpr (Core.Let b e) = 
  let
    bs = trBind b
    expr = trExpr e
  in
   LetExpr bs expr

trExpr e@(Core.Lam vs expr) = LamExpr vs' expr'
  where
    vs' = map trVar vs
    expr' = trExpr expr

trExpr e@(Core.Case scrut _ alts) = CaseExpr scrut' alts'
  where
    scrut' = trExpr scrut
    alts' = map tralt alts
    tralt ((Core.DataAlt (Core.DataCon name vs _)), _, expr) =
      CotrAlt name $ trExpr expr'
      where 
        expr' = case vs of
          [] -> expr
          vs' -> (Core.Lam vs' expr)
    tralt (Core.DEFAULT, vs, expr) = DefaultAlt $ trExpr (Core.Lam vs expr)

trExpr e = error $ "Non-exhaustive pattern in trExpr: " ++ show e

trbind :: (Core.Var, Core.Expr) -> Bind
trbind (v, e) = Bind (trVar v) (trExpr e)

trBind :: Core.Bind -> [Bind]
{- trBind (Core.NoRec v e) = [trbind (v, e)] -}
trBind (Core.Rec bs) = trbinds bs
  where
    trbinds [] = []
    trbinds (b:bs) = trbind b : trbinds bs
<commit_msg>TrSTG.hs: -27 lines, 0 warns, 0 hint.<commit_after>module TrSTG where

import qualified Core
import           STG

-- import           Debug.Trace

trVar :: Core.Var -> Var
trVar (Core.TermVar n _)   = TermVar n
trVar (Core.DictVar n1 n2) = DictVar n1 n2

trLit :: Core.Literal -> Literal
trLit (Core.LitInt i _)  = LitInt i
trLit (Core.LitChar c _) = LitChar c
trLit (Core.LitStr s _)  = LitStr s
trLit (Core.LitFrac r _) = LitFrac r

trExpr :: Core.Expr -> Expr
trExpr (Core.Var v) = AtomExpr $ VarAtom $ trVar v
trExpr (Core.Lit l) = AtomExpr $ LitAtom $ trLit l
trExpr (Core.App f x) = FunAppExpr (trExpr f) [trExpr x]
trExpr (Core.Let b e) = LetExpr (trBind b) (trExpr e)
trExpr (Core.Lam vs expr) = LamExpr (map trVar vs) (trExpr expr)

trExpr (Core.Case scrut _ alts) = CaseExpr (trExpr scrut) (map tralt alts)
  where
    tralt (Core.DataAlt (Core.DataCon name vs _), _, expr) =
      CotrAlt name $ trExpr expr'
      where
        expr' = case vs of
          []  -> expr
          vs' -> Core.Lam vs' expr
    tralt (Core.DEFAULT, vs, expr) = DefaultAlt $ trExpr (Core.Lam vs expr)
    tralt _ = error "tralt: must not occur"

trBind :: Core.Bind -> [Bind]
trBind (Core.Rec bs) = map trbind bs
  where trbind (v, e) = Bind (trVar v) (trExpr e)
{'fraction_non_alphanumeric': 0.11909124221326493, 'fraction_numerical': 0.004397215097105167, 'mean_word_length': 2.7244201909959074, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 13, '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': '1317890', 'n_tokens_mistral': 1088, 'n_tokens_neox': 1050, 'n_words': 356}