    module Agda.Compiler.JS.Substitution where

    import Prelude hiding ( map, lookup )
    import Data.Map ( empty, unionWith, singleton, findWithDefault )
    import qualified Data.Map as Map
    import Data.List ( genericIndex )
    import qualified Data.List as List

    import Agda.Syntax.Common ( Nat )
    import Agda.Compiler.JS.Syntax
      ( Exp(Self,Undefined,Local,Lambda,Object,Array,Apply,Lookup,If,BinOp,PreOp),
        MemberId, LocalId(LocalId) )
    import Agda.Utils.Function ( iterate' )
    import Agda.Utils.List ( indexWithDefault )

    -- Map for expressions

    map :: Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map :: Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map Nat
    m Nat -> LocalId -> Exp
    f (Local LocalId
    i)       = Nat -> LocalId -> Exp
    f Nat
    m LocalId
    i
    map Nat
    m Nat -> LocalId -> Exp
    f (Lambda Nat
    i Exp
    e)    = Nat -> Exp -> Exp
    Lambda Nat
    i (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map (Nat
    m Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    + Nat
    i) Nat -> LocalId -> Exp
    f Exp
    e)
    map Nat
    m Nat -> LocalId -> Exp
    f (Object Map MemberId Exp
    o)      = Map MemberId Exp -> Exp
    Object ((Exp -> Exp) -> Map MemberId Exp -> Map MemberId Exp
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map Nat
    m Nat -> LocalId -> Exp
    f) Map MemberId Exp
    o)
    map Nat
    m Nat -> LocalId -> Exp
    f (Array [(Comment, Exp)]
    es)      = [(Comment, Exp)] -> Exp
    Array (((Comment, Exp) -> (Comment, Exp))
    -> [(Comment, Exp)] -> [(Comment, Exp)]
    forall a b. (a -> b) -> [a] -> [b]
    List.map (\(Comment
    c, Exp
    e) -> (Comment
    c, Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map Nat
    m Nat -> LocalId -> Exp
    f Exp
    e)) [(Comment, Exp)]
    es)
    map Nat
    m Nat -> LocalId -> Exp
    f (Apply Exp
    e [Exp]
    es)    = Exp -> [Exp] -> Exp
    Apply (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map Nat
    m Nat -> LocalId -> Exp
    f Exp
    e) ((Exp -> Exp) -> [Exp] -> [Exp]
    forall a b. (a -> b) -> [a] -> [b]
    List.map (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map Nat
    m Nat -> LocalId -> Exp
    f) [Exp]
    es)
    map Nat
    m Nat -> LocalId -> Exp
    f (Lookup Exp
    e MemberId
    l)    = Exp -> MemberId -> Exp
    Lookup (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map Nat
    m Nat -> LocalId -> Exp
    f Exp
    e) MemberId
    l
    map Nat
    m Nat -> LocalId -> Exp
    f (If Exp
    e Exp
    e' Exp
    e'')   = Exp -> Exp -> Exp -> Exp
    If (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map Nat
    m Nat -> LocalId -> Exp
    f Exp
    e) (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map Nat
    m Nat -> LocalId -> Exp
    f Exp
    e') (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map Nat
    m Nat -> LocalId -> Exp
    f Exp
    e'')
    map Nat
    m Nat -> LocalId -> Exp
    f (PreOp String
    op Exp
    e)    = String -> Exp -> Exp
    PreOp String
    op (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map Nat
    m Nat -> LocalId -> Exp
    f Exp
    e)
    map Nat
    m Nat -> LocalId -> Exp
    f (BinOp Exp
    e String
    op Exp
    e') = Exp -> String -> Exp -> Exp
    BinOp (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map Nat
    m Nat -> LocalId -> Exp
    f Exp
    e) String
    op (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map Nat
    m Nat -> LocalId -> Exp
    f Exp
    e')
    map Nat
    m Nat -> LocalId -> Exp
    f Exp
    e               = Exp
    e

    -- Shifting

    shift :: Nat -> Exp -> Exp
    shift :: Nat -> Exp -> Exp
    shift = Nat -> Nat -> Exp -> Exp
    shiftFrom Nat
    0

    shiftFrom :: Nat -> Nat -> Exp -> Exp
    shiftFrom :: Nat -> Nat -> Exp -> Exp
    shiftFrom Nat
    m Nat
    0 Exp
    e = Exp
    e
    shiftFrom Nat
    m Nat
    n Exp
    e = Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map Nat
    m (Nat -> Nat -> LocalId -> Exp
    shifter Nat
    n) Exp
    e

    shifter :: Nat -> Nat -> LocalId -> Exp
    shifter :: Nat -> Nat -> LocalId -> Exp
    shifter Nat
    n Nat
    m (LocalId Nat
    i) | Nat
    i Nat -> Nat -> Bool
    forall a. Ord a => a -> a -> Bool
    < Nat
    m     = LocalId -> Exp
    Local (Nat -> LocalId
    LocalId Nat
    i)
    shifter Nat
    n Nat
    m (LocalId Nat
    i) | Bool
    otherwise = LocalId -> Exp
    Local (Nat -> LocalId
    LocalId (Nat
    i Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    + Nat
    n))

    -- Substitution

    subst :: Nat -> [Exp] -> Exp -> Exp
    subst :: Nat -> [Exp] -> Exp -> Exp
    subst Nat
    0 [Exp]
    es Exp
    e = Exp
    e
    subst Nat
    n [Exp]
    es Exp
    e = Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map Nat
    0 (Nat -> [Exp] -> Nat -> LocalId -> Exp
    substituter Nat
    n [Exp]
    es) Exp
    e

    substituter :: Nat -> [Exp] -> Nat -> LocalId -> Exp
    substituter :: Nat -> [Exp] -> Nat -> LocalId -> Exp
    substituter Nat
    n [Exp]
    es Nat
    m (LocalId Nat
    i) | Nat
    i Nat -> Nat -> Bool
    forall a. Ord a => a -> a -> Bool
    < Nat
    m       = LocalId -> Exp
    Local (Nat -> LocalId
    LocalId Nat
    i)
    substituter Nat
    n [Exp]
    es Nat
    m (LocalId Nat
    i) | (Nat
    i Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Nat
    m) Nat -> Nat -> Bool
    forall a. Ord a => a -> a -> Bool
    < Nat
    n = Nat -> Exp -> Exp
    shift Nat
    m ([Exp] -> Nat -> Exp
    forall i a. Integral i => [a] -> i -> a
    genericIndex ([Exp]
    es [Exp] -> [Exp] -> [Exp]
    forall a. [a] -> [a] -> [a]
    ++ Exp -> [Exp]
    forall a. a -> [a]
    repeat Exp
    Undefined) (Nat
    n Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - (Nat
    i Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    + Nat
    1 Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Nat
    m)))
    substituter Nat
    n [Exp]
    es Nat
    m (LocalId Nat
    i) | Bool
    otherwise   = LocalId -> Exp
    Local (Nat -> LocalId
    LocalId (Nat
    i Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    - Nat
    n))

    -- A variant on substitution which performs beta-reduction

    map' :: Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map' :: Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map' Nat
    m Nat -> LocalId -> Exp
    f (Local LocalId
    i)       = Nat -> LocalId -> Exp
    f Nat
    m LocalId
    i
    map' Nat
    m Nat -> LocalId -> Exp
    f (Lambda Nat
    i Exp
    e)    = Nat -> Exp -> Exp
    Lambda Nat
    i (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map' (Nat
    m Nat -> Nat -> Nat
    forall a. Num a => a -> a -> a
    + Nat
    i) Nat -> LocalId -> Exp
    f Exp
    e)
    map' Nat
    m Nat -> LocalId -> Exp
    f (Object Map MemberId Exp
    o)      = Map MemberId Exp -> Exp
    Object ((Exp -> Exp) -> Map MemberId Exp -> Map MemberId Exp
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map' Nat
    m Nat -> LocalId -> Exp
    f) Map MemberId Exp
    o)
    map' Nat
    m Nat -> LocalId -> Exp
    f (Array [(Comment, Exp)]
    es)      = [(Comment, Exp)] -> Exp
    Array (((Comment, Exp) -> (Comment, Exp))
    -> [(Comment, Exp)] -> [(Comment, Exp)]
    forall a b. (a -> b) -> [a] -> [b]
    List.map (\(Comment
    c, Exp
    e) -> (Comment
    c, Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map' Nat
    m Nat -> LocalId -> Exp
    f Exp
    e)) [(Comment, Exp)]
    es)
    map' Nat
    m Nat -> LocalId -> Exp
    f (Apply Exp
    e [Exp]
    es)    = Exp -> [Exp] -> Exp
    apply (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map' Nat
    m Nat -> LocalId -> Exp
    f Exp
    e) ((Exp -> Exp) -> [Exp] -> [Exp]
    forall a b. (a -> b) -> [a] -> [b]
    List.map (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map' Nat
    m Nat -> LocalId -> Exp
    f) [Exp]
    es)
    map' Nat
    m Nat -> LocalId -> Exp
    f (Lookup Exp
    e MemberId
    l)    = Exp -> MemberId -> Exp
    lookup (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map' Nat
    m Nat -> LocalId -> Exp
    f Exp
    e) MemberId
    l
    map' Nat
    m Nat -> LocalId -> Exp
    f (If Exp
    e Exp
    e' Exp
    e'')   = Exp -> Exp -> Exp -> Exp
    If (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map' Nat
    m Nat -> LocalId -> Exp
    f Exp
    e) (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map' Nat
    m Nat -> LocalId -> Exp
    f Exp
    e') (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map' Nat
    m Nat -> LocalId -> Exp
    f Exp
    e'')
    map' Nat
    m Nat -> LocalId -> Exp
    f (PreOp String
    op Exp
    e)    = String -> Exp -> Exp
    PreOp String
    op (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map' Nat
    m Nat -> LocalId -> Exp
    f Exp
    e)
    map' Nat
    m Nat -> LocalId -> Exp
    f (BinOp Exp
    e String
    op Exp
    e') = Exp -> String -> Exp -> Exp
    BinOp (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map' Nat
    m Nat -> LocalId -> Exp
    f Exp
    e) String
    op (Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map' Nat
    m Nat -> LocalId -> Exp
    f Exp
    e')
    map' Nat
    m Nat -> LocalId -> Exp
    f Exp
    e               = Exp
    e

    subst' :: Nat -> [Exp] -> Exp -> Exp
    subst' :: Nat -> [Exp] -> Exp -> Exp
    subst' Nat
    0 [Exp]
    es Exp
    e = Exp
    e
    subst' Nat
    n [Exp]
    es Exp
    e = Nat -> (Nat -> LocalId -> Exp) -> Exp -> Exp
    map' Nat
    0 (Nat -> [Exp] -> Nat -> LocalId -> Exp
    substituter Nat
    n [Exp]
    es) Exp
    e

    -- Beta-reducing application and field access

    apply :: Exp -> [Exp] -> Exp
    apply :: Exp -> [Exp] -> Exp
    apply (Lambda Nat
    i Exp
    e) [Exp]
    es = Nat -> [Exp] -> Exp -> Exp
    subst' Nat
    i [Exp]
    es Exp
    e
    apply Exp
    e            [Exp]
    es = Exp -> [Exp] -> Exp
    Apply Exp
    e [Exp]
    es

    lookup :: Exp -> MemberId -> Exp
    lookup :: Exp -> MemberId -> Exp
    lookup (Object Map MemberId Exp
    o) MemberId
    l = Exp -> MemberId -> Map MemberId Exp -> Exp
    forall k a. Ord k => a -> k -> Map k a -> a
    findWithDefault Exp
    Undefined MemberId
    l Map MemberId Exp
    o
    lookup Exp
    e          MemberId
    l = Exp -> MemberId -> Exp
    Lookup Exp
    e MemberId
    l

    -- Replace any top-level occurrences of self
    -- (needed because JS is a cbv language, so any top-level
    -- recursions would evaluate before the module has been defined,
    -- e.g. exports = { x: 1, y: exports.x } results in an exception,
    -- as exports is undefined at the point that exports.x is evaluated),

    self :: Exp -> Exp -> Exp
    self :: Exp -> Exp -> Exp
    self Exp
    e (Exp
    Self)         = Exp
    e
    self Exp
    e (Object Map MemberId Exp
    o)     = Map MemberId Exp -> Exp
    Object ((Exp -> Exp) -> Map MemberId Exp -> Map MemberId Exp
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map (Exp -> Exp -> Exp
    self Exp
    e) Map MemberId Exp
    o)
    self Exp
    e (Array [(Comment, Exp)]
    es)     = [(Comment, Exp)] -> Exp
    Array (((Comment, Exp) -> (Comment, Exp))
    -> [(Comment, Exp)] -> [(Comment, Exp)]
    forall a b. (a -> b) -> [a] -> [b]
    List.map (\(Comment
    c, Exp
    x) -> (Comment
    c, Exp -> Exp -> Exp
    self Exp
    e Exp
    x)) [(Comment, Exp)]
    es)
    self Exp
    e (Apply Exp
    f [Exp]
    es)   = case (Exp -> Exp -> Exp
    self Exp
    e Exp
    f) of
      (Lambda Nat
    n Exp
    g) -> Exp -> Exp -> Exp
    self Exp
    e (Nat -> [Exp] -> Exp -> Exp
    subst' Nat
    n [Exp]
    es Exp
    g)
      Exp
    g            -> Exp -> [Exp] -> Exp
    Apply Exp
    g ((Exp -> Exp) -> [Exp] -> [Exp]
    forall a b. (a -> b) -> [a] -> [b]
    List.map (Exp -> Exp -> Exp
    self Exp
    e) [Exp]
    es)
    self Exp
    e (Lookup Exp
    f MemberId
    l)   = Exp -> MemberId -> Exp
    lookup (Exp -> Exp -> Exp
    self Exp
    e Exp
    f) MemberId
    l
    self Exp
    e (If Exp
    f Exp
    g Exp
    h)     = Exp -> Exp -> Exp -> Exp
    If (Exp -> Exp -> Exp
    self Exp
    e Exp
    f) (Exp -> Exp -> Exp
    self Exp
    e Exp
    g) (Exp -> Exp -> Exp
    self Exp
    e Exp
    h)
    self Exp
    e (BinOp Exp
    f String
    op Exp
    g) = Exp -> String -> Exp -> Exp
    BinOp (Exp -> Exp -> Exp
    self Exp
    e Exp
    f) String
    op (Exp -> Exp -> Exp
    self Exp
    e Exp
    g)
    self Exp
    e (PreOp String
    op Exp
    f)   = String -> Exp -> Exp
    PreOp String
    op (Exp -> Exp -> Exp
    self Exp
    e Exp
    f)
    self Exp
    e Exp
    f              = Exp
    f

    -- Find the fixed point of an expression, with no top-level occurrences
    -- of self.

    fix :: Exp -> Exp
    fix :: Exp -> Exp
    fix Exp
    f = Exp
    e where e :: Exp
    e = Exp -> Exp -> Exp
    self Exp
    e Exp
    f

    -- Some helper functions

    curriedApply :: Exp -> [Exp] -> Exp
    curriedApply :: Exp -> [Exp] -> Exp
    curriedApply = (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\ Exp
    f Exp
    e -> Exp -> [Exp] -> Exp
    apply Exp
    f [Exp
    e])

    curriedLambda :: Nat -> Exp -> Exp
    curriedLambda :: Nat -> Exp -> Exp
    curriedLambda Nat
    n = Nat -> (Exp -> Exp) -> Exp -> Exp
    forall i a. Integral i => i -> (a -> a) -> a -> a
    iterate' Nat
    n (Nat -> Exp -> Exp
    Lambda Nat
    1)

    emp :: Exp
    emp :: Exp
    emp = Map MemberId Exp -> Exp
    Object (Map MemberId Exp
    forall k a. Map k a
    empty)

    union :: Exp -> Exp -> Exp
    union :: Exp -> Exp -> Exp
    union (Object Map MemberId Exp
    o) (Object Map MemberId Exp
    p) = Map MemberId Exp -> Exp
    Object ((Exp -> Exp -> Exp)
    -> Map MemberId Exp -> Map MemberId Exp -> Map MemberId Exp
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    unionWith Exp -> Exp -> Exp
    union Map MemberId Exp
    o Map MemberId Exp
    p)
    union Exp
    e          Exp
    f          = Exp
    e

    vine :: [MemberId] -> Exp -> Exp
    vine :: [MemberId] -> Exp -> Exp
    vine [MemberId]
    ls Exp
    e = (MemberId -> Exp -> Exp) -> Exp -> [MemberId] -> Exp
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\ MemberId
    l Exp
    e -> Map MemberId Exp -> Exp
    Object (MemberId -> Exp -> Map MemberId Exp
    forall k a. k -> a -> Map k a
    singleton MemberId
    l Exp
    e)) Exp
    e [MemberId]
    ls

    object :: [([MemberId],Exp)] -> Exp
    object :: [([MemberId], Exp)] -> Exp
    object = (([MemberId], Exp) -> Exp -> Exp)
    -> Exp -> [([MemberId], Exp)] -> Exp
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\ ([MemberId]
    ls,Exp
    e) -> (Exp -> Exp -> Exp
    union ([MemberId] -> Exp -> Exp
    vine [MemberId]
    ls Exp
    e))) Exp
    emp