Minor cleanup of dependencies

src/Module.purs

@@ -21,7 +21,6 @@ import Expr (traverseModule)
 import Graph (class Graph, Vertex)
 import Graph (empty) as G
 import Graph.GraphWriter (class MonadGraphAlloc, alloc, fresh, runWithGraphAllocT)
-import Lattice (botOf)
 import Parse (module_, program)
 import Parsing (runParser)
 import Primitive.Defs (primitives)
@@ -53,7 +52,7 @@ parse src = liftEither <<< mapLeft (error <<< show) <<< runParser src
 
 parseProgram :: forall m. MonadAff m => MonadError Error m => Folder -> File -> m (S.Expr Unit)
 parseProgram folder file =
-   loadFile folder file >>= flip parse (program <#> botOf)
+   loadFile folder file >>= flip parse program
 
 open :: forall m. MonadAff m => MonadError Error m => File -> m (S.Expr Unit)
 open = parseProgram (Folder "fluid/example")

src/Pretty2.purs

@@ -29,7 +29,7 @@ import Util (type (+), type (×), Endo, absurd, assert, error, intersperse, (×)
 import Util.Pair (Pair(..), toTuple)
 import Util.Pretty (Doc(..), atop, beside, empty, hcat, render, text)
 import Val2 (Fun(..), Val(..)) as V
-import Val2 (class Ann, class Highlightable, DictRep(..), ForeignOp', Fun, MatrixRep(..), Val, highlightIf)
+import Val2 (class Highlightable, DictRep(..), ForeignOp', Fun, MatrixRep(..), Val, highlightIf)
 
 replacement :: Array (String × String)
 replacement =
@@ -81,16 +81,16 @@ exprType (ListComp _ _ _) = Simple
 exprType (Let _ _) = Expression
 exprType (LetRec _ _) = Expression
 
-prettySimple :: forall a. Ann a => Expr a -> Doc
+prettySimple :: forall a. Highlightable a => Expr a -> Doc
 prettySimple s = case exprType s of
    Simple -> pretty s
    Expression -> parentheses (pretty s)
 
-prettyAppChain :: forall a. Ann a => Expr a -> Doc
+prettyAppChain :: forall a. Highlightable a => Expr a -> Doc
 prettyAppChain (App s s') = prettyAppChain s .<>. prettySimple s'
 prettyAppChain s = prettySimple s
 
-prettyBinApp :: forall a. Ann a => Int -> Expr a -> Doc
+prettyBinApp :: forall a. Highlightable a => Int -> Expr a -> Doc
 prettyBinApp n (BinaryApp s op s') =
    let
       prec' = getPrec op
@@ -126,7 +126,7 @@ removeDocWS (Doc d) = Doc
    , lines: map (\x -> removeLineWS (drop 1 x)) d.lines
    }
 
-instance Ann a => Pretty (Expr a) where
+instance Highlightable a => Pretty (Expr a) where
    pretty (Var x) = text x
    pretty (Op op) = parentheses (text op)
    pretty (Int ann n) = (highlightIf ann $ text (show n))
@@ -156,22 +156,22 @@ instance Ann a => Pretty (Expr a) where
    pretty (Let ds s) = (text str.let_ .<>. pretty ds .<>. text str.in_) .-. pretty s
    pretty (LetRec h s) = (text str.let_ .<>. pretty (First h) .<>. text str.in_) .-. pretty s
 
-prettyOperator :: forall a. Ann a => (Doc -> Doc -> Doc) -> List (Bind (Expr a)) -> Doc
+prettyOperator :: forall a. Highlightable a => (Doc -> Doc -> Doc) -> List (Bind (Expr a)) -> Doc
 prettyOperator _ (Cons s Nil) = text (key s) .<>. text str.colon .<>. pretty (val s)
 prettyOperator sep (Cons s xss) = sep (prettyOperator sep (toList (singleton s)) .<>. text str.comma) (prettyOperator sep xss)
 prettyOperator _ Nil = empty
 
-instance Ann a => Pretty (ListRest a) where
+instance Highlightable a => Pretty (ListRest a) where
    pretty (Next ann (Record _ xss) l) = ((highlightIf ann $ text str.comma)) .<>. ((highlightIf ann $ curlyBraces (prettyOperator (.<>.) xss))) .-. pretty l
    pretty (Next ann s l) = ((highlightIf ann $ text str.comma)) .<>. pretty s .<>. pretty l
    pretty (End ann) = (highlightIf ann $ text str.rBracket)
 
-instance Ann a => Pretty (List (Pair (Expr a))) where
+instance Highlightable a => Pretty (List (Pair (Expr a))) where
    pretty (Cons (Pair e e') Nil) = prettyPairs (Pair e e')
    pretty (Cons (Pair e e') sss) = prettyPairs (Pair e e') .<>. text str.comma .<>. pretty sss
    pretty Nil = empty
 
-prettyPairs :: forall a. Ann a => (Pair (Expr a)) -> Doc
+prettyPairs :: forall a. Highlightable a => (Pair (Expr a)) -> Doc
 prettyPairs (Pair e e') = pretty e .<>. text str.colonEq .<>. pretty e'
 
 instance Pretty Pattern where
@@ -207,39 +207,39 @@ instance Pretty ListRestPattern where
    pretty (PNext p l) = text str.comma .<>. pretty p .<>. pretty l
    pretty PEnd = text str.rBracket
 
-prettyClause :: forall a. Ann a => Doc -> Clause a -> Doc
+prettyClause :: forall a. Highlightable a => Doc -> Clause a -> Doc
 prettyClause sep (Clause (ps × e)) = prettyPattConstr empty (toList ps) .<>. sep .<>. pretty e
 
-instance Ann a => Pretty (Clauses a) where
+instance Highlightable a => Pretty (Clauses a) where
    pretty (Clauses cs) = intersperse' (toList (map (prettyClause (text str.equals)) (cs))) (text str.semiColon)
 
-instance Ann a => Pretty (Branch a) where
+instance Highlightable a => Pretty (Branch a) where
    pretty (x × Clause (ps × e)) = text x .<>. prettyClause (text str.equals) (Clause (ps × e))
 
-instance Ann a => Pretty (NonEmptyList (Branch a)) where
+instance Highlightable a => Pretty (NonEmptyList (Branch a)) where
    pretty h = intersperse' (toList (map pretty h)) (text str.semiColon)
 
-instance Ann a => Pretty (NonEmptyList (NonEmptyList (Branch a))) where
+instance Highlightable a => Pretty (NonEmptyList (NonEmptyList (Branch a))) where
    pretty hs = intersperse' (toList (map pretty hs)) (text str.semiColon)
 
-instance Ann a => Pretty (FirstGroup a) where
+instance Highlightable a => Pretty (FirstGroup a) where
    pretty (First h) = pretty (groupBy (\p q -> key p == key q) h)
 
-instance Ann a => Pretty (NonEmptyList (Pattern × Expr a)) where
+instance Highlightable a => Pretty (NonEmptyList (Pattern × Expr a)) where
    pretty pss = intersperse' (map (prettyClause (text str.rArrow)) (map Clause (toList (helperMatch pss)))) (text str.semiColon)
 
-instance Ann a => Pretty (VarDef a) where
+instance Highlightable a => Pretty (VarDef a) where
    pretty (VarDef p s) = pretty p .<>. text str.equals .<>. pretty s
 
-instance Ann a => Pretty (VarDefs a) where
+instance Highlightable a => Pretty (VarDefs a) where
    pretty ds = intersperse' (toList (map pretty ds)) (text str.semiColon)
 
-instance Ann a => Pretty (List (Expr a)) where
+instance Highlightable a => Pretty (List (Expr a)) where
    pretty (Cons s Nil) = pretty s
    pretty (Cons s ss) = pretty s .<>. pretty ss
    pretty Nil = empty
 
-instance Ann a => Pretty (List (Qualifier a)) where
+instance Highlightable a => Pretty (List (Qualifier a)) where
    pretty (Cons (Guard s) Nil) = pretty s
    pretty (Cons (Declaration d) Nil) = text str.let_ .<>. pretty d
    pretty (Cons (Generator p s) Nil) = pretty p .<>. text str.lArrow .<>. pretty s

src/Primitive2.purs

@@ -16,7 +16,7 @@ import Lattice (class BoundedJoinSemilattice, bot)
 import Partial.Unsafe (unsafePartial)
 import Pretty2 (prettyP)
 import Util (type (+), type (×), (×), error)
-import Val2 (class Ann, ForeignOp'(..), Fun(..), MatrixRep, OpBwd, OpFwd, OpGraph, Val(..))
+import Val2 (class Highlightable, ForeignOp'(..), Fun(..), MatrixRep, OpBwd, OpFwd, OpGraph, Val(..))
 
 -- Mediate between values of annotation type a and (potential) underlying datatype d, analogous to
 -- pattern-matching and construction for data types. Wasn't able to make a typeclass version of this
@@ -101,25 +101,25 @@ intPair =
    match' (Constr α c (v : v' : Nil)) | c == cPair = (int.match v × int.match v') × α
    match' v = error ("Pair expected; got " <> prettyP (erase v))
 
-matrixRep :: forall a. Ann a => ToFrom (MatrixRep a) a
+matrixRep :: forall a. Highlightable a => ToFrom (MatrixRep a) a
 matrixRep =
    { constr: \(m × α) -> Matrix α m
    , constr_bwd: match'
    , match: match'
    }
    where
-   match' :: Ann a => Val a -> MatrixRep a × a
+   match' :: Highlightable a => Val a -> MatrixRep a × a
    match' (Matrix α m) = m × α
    match' v = error ("Matrix expected; got " <> prettyP v)
 
-record :: forall a. Ann a => ToFrom (Dict (Val a)) a
+record :: forall a. Highlightable a => ToFrom (Dict (Val a)) a
 record =
    { constr: \(xvs × α) -> Record α xvs
    , constr_bwd: match'
    , match: match'
    }
    where
-   match' :: Ann a => _
+   match' :: Highlightable a => _
    match' (Record α xvs) = xvs × α
    match' v = error ("Record expected; got " <> prettyP v)
 

src/Val2.purs

@@ -4,7 +4,6 @@ import Prelude hiding (absurd, append)
 
 import Bindings (Var)
 import BoolAlg (BoolAlg)
-import Control.Apply (lift2)
 import Control.Monad.Error.Class (class MonadError, class MonadThrow)
 import Data.Array ((!!))
 import Data.Array (zipWith) as A
@@ -23,8 +22,7 @@ import Foreign.Object (filterKeys, lookup, unionWith)
 import Foreign.Object (keys) as O
 import Graph (Vertex(..))
 import Graph.GraphWriter (class MonadGraphAlloc)
-import Lattice (class BoundedJoinSemilattice, class BoundedLattice, class Expandable, class JoinSemilattice, class Neg, Raw, definedJoin, expand, maybeJoin, neg, (∨))
-import Util (type (×), Endo, error, orElse, throw, unsafeUpdateAt, (!), (×), (≜), (≞))
+import Util (type (×), Endo, error, orElse, unsafeUpdateAt, (!), (×))
 import Util.Pretty (Doc, beside, text)
 
 data Val a
@@ -42,16 +40,9 @@ data Fun a
    | Foreign ForeignOp (List (Val a)) -- never saturated
    | PartialConstr Ctr (List (Val a)) -- never saturated
 
-class (Highlightable a, BoundedLattice a) <= Ann a
-
-instance Ann Boolean
-instance Ann Unit
-
 instance Highlightable a => Highlightable (a × b) where
    highlightIf (a × _) doc = highlightIf a doc
 
-instance (Ann a, BoundedLattice b) => Ann (a × b)
-
 -- similar to an isomorphism lens with complement t
 type OpFwd t = forall a m. Highlightable a => MonadError Error m => BoolAlg a -> List (Val a) -> m (t × Val a)
 type OpBwd t = forall a. Highlightable a => BoolAlg a -> t × Val a -> List (Val a)
@@ -189,67 +180,3 @@ instance Traversable MatrixRep where
          (bitraverse (traverse f) (traverse f))
          m
    sequence = sequenceDefault
-
-instance JoinSemilattice a => JoinSemilattice (DictRep a) where
-   maybeJoin (DictRep svs) (DictRep svs') = DictRep <$> maybeJoin svs svs'
-   join v = definedJoin v
-
-instance JoinSemilattice a => JoinSemilattice (MatrixRep a) where
-   maybeJoin (MatrixRep (vss × (i × βi) × (j × βj))) (MatrixRep (vss' × (i' × βi') × (j' × βj'))) =
-      MatrixRep <$>
-         ( maybeJoin vss vss'
-              `lift2 (×)` (((_ × (βi ∨ βi')) <$> (i ≞ i')) `lift2 (×)` ((_ × (βj ∨ βj')) <$> (j ≞ j')))
-         )
-   join v = definedJoin v
-
-instance JoinSemilattice a => JoinSemilattice (Val a) where
-   maybeJoin (Int α n) (Int α' n') = Int (α ∨ α') <$> (n ≞ n')
-   maybeJoin (Float α n) (Float α' n') = Float (α ∨ α') <$> (n ≞ n')
-   maybeJoin (Str α s) (Str α' s') = Str (α ∨ α') <$> (s ≞ s')
-   maybeJoin (Record α xvs) (Record α' xvs') = Record (α ∨ α') <$> maybeJoin xvs xvs'
-   maybeJoin (Dictionary α d) (Dictionary α' d') = Dictionary (α ∨ α') <$> maybeJoin d d'
-   maybeJoin (Constr α c vs) (Constr α' c' us) = Constr (α ∨ α') <$> (c ≞ c') <*> maybeJoin vs us
-   maybeJoin (Matrix α m) (Matrix α' m') = Matrix (α ∨ α') <$> maybeJoin m m'
-   maybeJoin (Fun α φ) (Fun α' φ') = Fun (α ∨ α') <$> maybeJoin φ φ'
-   maybeJoin _ _ = throw "Incompatible values"
-
-   join v = definedJoin v
-
-instance JoinSemilattice a => JoinSemilattice (Fun a) where
-   maybeJoin (Closure γ ρ σ) (Closure γ' ρ' σ') =
-      Closure <$> maybeJoin γ γ' <*> maybeJoin ρ ρ' <*> maybeJoin σ σ'
-   maybeJoin (Foreign φ vs) (Foreign _ vs') =
-      Foreign φ <$> maybeJoin vs vs' -- TODO: require φ == φ'
-   maybeJoin (PartialConstr c vs) (PartialConstr c' us) =
-      PartialConstr <$> (c ≞ c') <*> maybeJoin vs us
-   maybeJoin _ _ = throw "Incompatible functions"
-
-   join v = definedJoin v
-
-instance BoundedJoinSemilattice a => Expandable (DictRep a) (Raw DictRep) where
-   expand (DictRep svs) (DictRep svs') = DictRep (expand svs svs')
-
-instance BoundedJoinSemilattice a => Expandable (MatrixRep a) (Raw MatrixRep) where
-   expand (MatrixRep (vss × (i × βi) × (j × βj))) (MatrixRep (vss' × (i' × _) × (j' × _))) =
-      MatrixRep (expand vss vss' × ((i ≜ i') × βi) × ((j ≜ j') × βj))
-
-instance BoundedJoinSemilattice a => Expandable (Val a) (Raw Val) where
-   expand (Int α n) (Int _ n') = Int α (n ≜ n')
-   expand (Float α n) (Float _ n') = Float α (n ≜ n')
-   expand (Str α s) (Str _ s') = Str α (s ≜ s')
-   expand (Record α xvs) (Record _ xvs') = Record α (expand xvs xvs')
-   expand (Dictionary α d) (Dictionary _ d') = Dictionary α (expand d d')
-   expand (Constr α c vs) (Constr _ c' us) = Constr α (c ≜ c') (expand vs us)
-   expand (Matrix α m) (Matrix _ m') = Matrix α (expand m m')
-   expand (Fun α φ) (Fun _ φ') = Fun α (expand φ φ')
-   expand _ _ = error "Incompatible values"
-
-instance BoundedJoinSemilattice a => Expandable (Fun a) (Raw Fun) where
-   expand (Closure γ ρ σ) (Closure γ' ρ' σ') =
-      Closure (expand γ γ') (expand ρ ρ') (expand σ σ')
-   expand (Foreign φ vs) (Foreign _ vs') = Foreign φ (expand vs vs') -- TODO: require φ == φ'
-   expand (PartialConstr c vs) (PartialConstr c' us) = PartialConstr (c ≜ c') (expand vs us)
-   expand _ _ = error "Incompatible values"
-
-instance Neg a => Neg (Val a) where
-   neg = (<$>) neg