🧩 [consolidate]: Remove spurious projection form from core language, and desugar SExpr projections to d-projections.

Author: rolyp

src/Eval.purs

@@ -129,12 +129,6 @@ eval γ e0 αs = do
  withMsg "Variable lookup" $ lookup' x γ
  Op op ->
  withMsg "Variable lookup" $ lookup' op γ
- Project e x -> do
- v <- eval γ e αs
- case v of
- Val _ _ (V.Dictionary (DictRep d)) ->
- withMsg "Dict lookup" (snd <$> lookup x d # orElse ("Key \"" <> x <> "\" not found"))
- _ -> throw $ "Found " <> prettyP v <> ", expected dictionary"
  DProject e x -> do
  v <- eval γ e αs
  v' <- eval γ x αs

src/Expr.purs

@@ -33,7 +33,6 @@ data Expr a
  | Constr a Ctr (List (Expr a))
  | Matrix a (Expr a) (Var × Var) (Expr a)
  | Lambda a (Elim a)
- | Project (Expr a) Var
  | DProject (Expr a) (Expr a)
  | App (Expr a) (Expr a)
  | Let (VarDef a) (Expr a)
@@ -77,7 +76,6 @@ instance FV (Expr a) where
  fv (Constr _ _ es) = unions (fv <$> es)
  fv (Matrix _ e1 _ e2) = fv e1 ∪ fv e2
  fv (Lambda _ σ) = fv σ
- fv (Project e _) = fv e
  fv (DProject e x) = fv e ∪ fv x
  fv (App e1 e2) = fv e1 ∪ fv e2
  fv (Let def e) = fv def ∪ (fv e \\ bv def)
@@ -173,7 +171,6 @@ instance JoinSemilattice a => JoinSemilattice (Expr a) where
  join (Matrix α e1 (x × y) e2) (Matrix α' e1' (x' × y') e2') =
  Matrix (α ∨ α') (e1 ∨ e1') ((x ≜ x') × (y ≜ y')) (e2 ∨ e2')
  join (Lambda α σ) (Lambda α' σ') = Lambda (α ∨ α') (σ ∨ σ')
- join (Project e x) (Project e' x') = Project (e ∨ e') (x ≜ x')
  join (DProject e1 e2) (DProject e1' e2') = DProject (e1 ∨ e1') (e2 ∨ e2')
  join (App e1 e2) (App e1' e2') = App (e1 ∨ e1') (e2 ∨ e2')
  join (LetRec ρ e) (LetRec ρ' e') = LetRec (ρ ∨ ρ') (e ∨ e')
@@ -191,7 +188,6 @@ instance BoundedJoinSemilattice a => Expandable (Expr a) (Raw Expr) where
  expand (Matrix α e1 (x × y) e2) (Matrix _ e1' (x' × y') e2') =
  Matrix α (expand e1 e1') ((x ≜ x') × (y ≜ y')) (expand e2 e2')
  expand (Lambda α σ) (Lambda _ σ') = Lambda α (expand σ σ')
- expand (Project e x) (Project e' x') = Project (expand e e') (x ≜ x')
  expand (DProject e1 e2) (DProject e1' e2') = DProject (expand e1 e1') (expand e2 e2')
  expand (App e1 e2) (App e1' e2') = App (expand e1 e1') (expand e2 e2')
  expand (Let def e) (Let def' e') = Let (expand def def') (expand e e')
@@ -214,7 +210,6 @@ instance Vertices (Expr Vertex) where
  vertices e@(Constr α _ es) = singleton (DVertex (α × pack e)) ∪ unions (vertices <$> es)
  vertices e@(Matrix α e1 _ e2) = singleton (DVertex (α × pack e)) ∪ vertices e1 ∪ vertices e2
  vertices e@(Lambda α σ) = singleton (DVertex (α × pack e)) ∪ vertices σ
- vertices (Project e _) = vertices e
  vertices (DProject e e') = vertices e ∪ vertices e'
  vertices (App e1 e2) = vertices e1 ∪ vertices e2
  vertices (Let def e) = vertices def ∪ vertices e
@@ -275,7 +270,6 @@ instance Apply Expr where
  apply (Matrix fα fe1 (x × y) fe2) (Matrix α e1 (x' × y') e2) =
  Matrix (fα α) (fe1 <*> e1) ((x ≜ x') × (y ≜ y')) (fe2 <*> e2)
  apply (Lambda fα fσ) (Lambda α σ) = Lambda (fα α) (fσ <*> σ)
- apply (Project fe x) (Project e _) = Project (fe <*> e) x
  apply (DProject fd fk) (DProject d k) = DProject (fd <*> d) (fk <*> k)
  apply (App fe1 fe2) (App e1 e2) = App (fe1 <*> e1) (fe2 <*> e2)
  apply (Let (VarDef fσ fe1) fe2) (Let (VarDef σ e1) e2) = Let (VarDef (fσ <*> σ) (fe1 <*> e1)) (fe2 <*> e2)

src/Pretty.purs

@@ -270,7 +270,6 @@ instance Highlightable a => Pretty (E.Expr a) where
  pretty (E.Matrix a e1 (i × j) e2) =
  highlightIf a $ matrix (pretty e1 <+> text "for" <+> pair text i j <+> text "in" <+> pretty e2)
  pretty (E.Lambda a o) = highlightIf a (text "lambda") <+> pretty o -- really?
- pretty (E.Project e x) = pretty e <> text "." <> pretty x
  pretty (E.DProject e x) = pretty e <> brackets (pretty x)
  pretty (E.App e e') = pretty e <> parens (pretty e') -- TODO
  pretty (E.Let (E.VarDef o e) e') = text "def" <+> pretty o <> block (pretty e) <++> pretty e'

src/SExpr.purs

@@ -293,22 +293,22 @@ exprFwd (Float α n) =
  pure $ (E.Float α n)
 exprFwd (Str α s) =
  pure $ E.Str α s
-exprFwd (Constr α c ss) = do
+exprFwd (Constr α c ss) =
  E.Constr α c <$> traverse desug ss
 exprFwd (Dictionary α sss) = do
  let ks × ss = unzip sss
  ks' <- traverse desug ks
  es <- traverse desug ss
  E.Dictionary α <$> pure (zipWith Pair ks' es)
-exprFwd (Matrix α s (x × y) s') = do
+exprFwd (Matrix α s (x × y) s') =
  E.Matrix α <$> desug s <@> x × y <*> desug s'
 exprFwd (Lambda μ) =
  E.Lambda top <$> desug μ
-exprFwd (Project s x) = do
- E.Project <$> desug s <@> x
-exprFwd (DProject s x) = do
+exprFwd (Project s x) =
+ E.DProject <$> desug s <@> E.Str top x
+exprFwd (DProject s x) =
  E.DProject <$> desug s <*> desug x
-exprFwd (App s1 s2) = do
+exprFwd (App s1 s2) =
  E.App <$> desug s1 <*> desug s2
 exprFwd (BinaryApp s1 op s2) =
  E.App <$> (E.App (E.Op op) <$> desug s1) <*> desug s2
@@ -322,11 +322,11 @@ exprFwd (Paragraph elems) =
  paragraphFwd elems
 exprFwd (ListEmpty α) =
  pure $ enil α
-exprFwd (ListNonEmpty α s l) = do
+exprFwd (ListNonEmpty α s l) =
  econs α <$> desug s <*> desug l
 exprFwd (ListEnum s1 s2) =
  E.App <$> (E.App (E.Var "enumFromTo") <$> desug s1) <*> desug s2
-exprFwd (ListComp α s (ListCompGen p s' : qs)) = unsafePartial $ do
+exprFwd (ListComp α s (ListCompGen p s' : qs)) = unsafePartial $
  listCompFwd (α × (ListCompGen p s' : qs) × s)
 exprFwd (ListComp α s qs) =
  listCompFwd (α × qs × s)
@@ -353,8 +353,8 @@ exprBwd (E.Matrix α e1 _ e2) (Matrix _ s1 (x × y) s2) =
  Matrix α (desugBwd e1 s1) (x × y) (desugBwd e2 s2)
 exprBwd (E.Lambda _ σ) (Lambda μ) =
  Lambda (desugBwd σ μ)
-exprBwd (E.Project e x) (Project s _) =
- Project (desugBwd e s) x
+exprBwd (E.DProject ed _) (Project s x) =
+ Project (desugBwd ed s) x
 exprBwd (E.DProject ed ek) (DProject sd sk) =
  DProject (exprBwd ed sd) (exprBwd ek sk)
 exprBwd (E.App e1 e2) (App s1 s2) =