Updated the Type AST and did some refactoring - the parser now has no knowledge of the set of builtin functions and types

parser-typechecker/src/Unison/Builtin.hs

@@ -1,21 +1,42 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Unison.Builtin where
 
-import Unison.Parsers (unsafeParseType)
+import Unison.Parsers (unsafeParseType, unsafeParseTerm)
 import Unison.Symbol (Symbol)
 import Unison.Type (Type)
+import Unison.Term (Term)
+import Unison.Var (Var)
+import Data.Set (Set)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Unison.Reference as R
 import qualified Unison.Type as Type
+import qualified Unison.Term as Term
 import qualified Unison.ABT as ABT
 import qualified Unison.Var as Var
 
 t :: String -> Type Symbol
-t s = let
-  t = unsafeParseType s
-  free = Set.toList $ ABT.freeVars t
-  in ABT.substs [(v, Type.builtin (Var.name v)) | v <- free ] t
+t = resolveBuiltinTypes . unsafeParseType
+
+resolveBuiltinTypes :: Type Symbol -> Type Symbol
+resolveBuiltinTypes t =
+  let free = Set.intersection (ABT.freeVars t) builtinTypes
+  in ABT.substs [(v, Type.builtin (Var.name v)) | v <- Set.toList free ] t
+
+tm :: String -> Term Symbol
+tm s = let
+  t = unsafeParseTerm s
+  free = Set.intersection (ABT.freeVars t) builtinTerms
+  in ABT.substs [(v, Term.builtin (Var.name v)) | v <- Set.toList free ] t
+
+builtinTypes :: Set Symbol
+builtinTypes = Set.fromList . map Var.named $ [
+  "Int64", "UInt64", "Float", "Boolean", "Sequence", "Text", "Stream"]
+
+builtinTerms :: Set Symbol
+builtinTerms = Set.map toSymbol (Map.keysSet builtins) where
+  toSymbol (R.Builtin txt) = Var.named txt
+  toSymbol _ = error "unpossible"
 
 builtins :: Map.Map R.Reference (Type Symbol)
 builtins = Map.fromList $
@@ -52,5 +73,3 @@ builtins = Map.fromList $
       , ("Float.==", "Float -> Float -> Boolean")
       ]
   ]
-
-

parser-typechecker/src/Unison/Parsers.hs

@@ -28,10 +28,10 @@ unsafeGetRight (Right a) = a
 unsafeGetRight (Left err) = error err
 
 parseTerm :: Var v => String -> Either String (Term v)
-parseTerm = parseTerm' termBuiltins typeBuiltins
+parseTerm = parseTerm' [] []
 
 parseType :: Var v => String -> Either String (Type v)
-parseType = parseType' typeBuiltins
+parseType = parseType' []
 
 parseTerm' :: Var v => [(v, Term v)] -> [(v, Type v)] -> String -> Either String (Term v)
 parseTerm' termBuiltins typeBuiltins s =
@@ -56,74 +56,3 @@ unsafeParseTerm' er tr = unsafeGetRight . parseTerm' er tr
 
 unsafeParseType' :: Var v => [(v, Type v)] -> String -> Type v
 unsafeParseType' tr = unsafeGetRight . parseType' tr
-
--- Alias <alias> <fully-qualified-name>
-  -- will import the builtin <fully-qualified-name>, and once more as the alias
--- AliasFromModule
---   <modulename> e.g. "Number"
---   <aliases import modulename.alias as alias> e.g. "plus"
---   <ids import as qualified modulename.id> e.g. "minus" will import builtin "Number.plus" only
-data Builtin = Builtin Text -- e.g. Builtin "()"
-             | Alias Text Text
-             | AliasFromModule Text [Text] [Text]
-
--- aka default imports
-termBuiltins :: Var v => [(v, Term v)]
-termBuiltins = (Var.named *** Term.ref) <$> (
-    [ Builtin "()"
-    , Alias "Right" "Either.Right"
-    , Alias "Left" "Either.Left"
-    , Builtin "Greater"
-    , Builtin "Less"
-    , Builtin "Equal"
-    , Builtin "True"
-    , Builtin "False"
-    , Builtin "Pair"
-    , Alias "unit" "()"
-    , Alias "Unit" "()"
-    , Alias "Some" "Optional.Some"
-    , Alias "None" "Optional.None"
-    , Alias "+" "Number.+"
-    , Alias "-" "Number.-"
-    , Alias "*" "Number.*"
-    , Alias "/" "Number./"
-    , AliasFromModule "Vector" ["single"] []
-    , AliasFromModule "Remote" ["pure", "bind", "pure", "fork"] []
-    ] >>= unpackAliases)
-    where
-      unpackAliases :: Builtin -> [(Text, R.Reference)]
-      unpackAliases (Builtin t) = [builtin t]
-      unpackAliases (Alias a sym) = [alias a sym, builtin sym]
-      unpackAliases (AliasFromModule m toAlias other) =
-        (aliasFromModule m <$> toAlias) ++ (builtinInModule m <$> toAlias)
-          ++ (builtinInModule m <$> other)
-
-      builtin t = (t, R.Builtin t)
-      alias new known = (new, R.Builtin known)
-      aliasFromModule m sym = alias sym (Text.intercalate "." [m, sym])
-      builtinInModule m sym = builtin (Text.intercalate "." [m, sym])
-
-typeBuiltins :: Var v => [(v, Type v)]
-typeBuiltins = (Var.named *** Type.lit) <$>
-  [ ("Number", Type.Number)
-  , builtin "Unit"
-  , builtin "Boolean"
-  , ("Optional", Type.Optional)
-  , builtin "Either"
-  , builtin "Pair"
-  , builtin "Order"
-  , builtin "Comparison"
-  , builtin "Order.Key"
-  -- kv store
-  , builtin "Index"
-  -- html
-  , builtin "Html.Link"
-  -- distributed
-  , builtin "Channel"
-  , builtin "Duration"
-  , builtin "Remote"
-  , builtin "Node"
-  -- hashing
-  , builtin "Hash"
-  ]
-  where builtin t = (t, Type.Ref $ R.Builtin t)

parser-typechecker/src/Unison/Type.hs

@@ -27,18 +27,9 @@ import qualified Unison.Kind as K
 import qualified Unison.Reference as Reference
 import qualified Unison.TypeVar as TypeVar
 
--- | Type literals
-data Literal
-  = Number
-  | Text
-  | Vector
-  | Ref Reference -- ^ A type literal uniquely defined by some nameless Hash
-  | Optional
-  deriving (Eq,Ord,Generic)
-
 -- | Base functor for types in the Unison language
 data F a
-  = Lit Literal
+  = Ref Reference
   | Arrow a a
   | Ann a K.Kind
   | App a a
@@ -76,7 +67,7 @@ monotype t = Monotype <$> ABT.visit isMono t where
   isMono _ = Nothing
 
 -- some smart patterns
-pattern Lit' l <- ABT.Tm' (Lit l)
+pattern Ref' r <- ABT.Tm' (Ref r)
 pattern Arrow' i o <- ABT.Tm' (Arrow i o)
 pattern Arrows' spine <- (unArrows -> Just spine)
 pattern Ann' t k <- ABT.Tm' (Ann t k)
@@ -119,17 +110,14 @@ isArrow _ = False
 
 -- some smart constructors
 
-lit :: Ord v => Literal -> Type v
-lit l = ABT.tm (Lit l)
-
 vector :: Ord v => Type v
-vector = lit Vector
+vector = builtin "Sequence"
 
 vectorOf :: Ord v => Type v -> Type v
 vectorOf t = vector `app` t
 
 ref :: Ord v => Reference -> Type v
-ref = lit . Ref
+ref = ABT.tm . Ref
 
 builtin :: Ord v => Text -> Type v
 builtin = ref . Reference.Builtin
@@ -180,15 +168,6 @@ constrain t u = ABT.tm (Constrain t u)
 generalize :: Ord v => Type v -> Type v
 generalize t = foldr forall t $ Set.toList (ABT.freeVars t)
 
-instance Hashable Literal where
-  tokens l = case l of
-    Number -> [Hashable.Tag 0]
-    Text -> [Hashable.Tag 1]
-    Vector -> [Hashable.Tag 2]
-    Optional -> [Hashable.Tag 3]
-    Ref (Reference.Builtin name) -> Hashable.Tag 4 : Hashable.tokens name
-    Ref (Reference.Derived h) -> [Hashable.Tag 5, Hashable.Hashed (Hashable.fromBytes (Hash.toBytes h))]
-
 instance Hashable1 F where
   hash1 _ hash e =
     let
@@ -196,23 +175,16 @@ instance Hashable1 F where
       -- Note: start each layer with leading `0` byte, to avoid collisions with
       -- terms, which start each layer with leading `1`. See `Hashable1 Term.F`
     in Hashable.accumulate $ tag 0 : case e of
-      Lit l -> [tag 0, Hashable.accumulateToken l]
+      Ref r -> [tag 0, Hashable.accumulateToken r]
       Arrow a b -> [tag 1, hashed (hash a), hashed (hash b) ]
       App a b -> [tag 2, hashed (hash a), hashed (hash b) ]
       Ann a k -> [tag 3, hashed (hash a), Hashable.accumulateToken k ]
       Constrain a u -> [tag 4, hashed (hash a), Hashable.accumulateToken u]
       Forall a -> [tag 5, hashed (hash a)]
 
-instance Show Literal where
-  show Number = "Number"
-  show Text = "Text"
-  show Vector = "Vector"
-  show (Ref r) = show r
-  show Optional = "Optional"
-
 instance Show a => Show (F a) where
   showsPrec p fa = go p fa where
-    go _ (Lit l) = showsPrec 0 l
+    go _ (Ref r) = showsPrec 0 r
     go p (Arrow i o) =
       showParen (p > 0) $ showsPrec (p+1) i <> s" -> " <> showsPrec p o
     go p (Ann t k) =

parser-typechecker/src/Unison/TypeParser.hs

@@ -103,9 +103,4 @@ keywords = ["forall", "∀"]
 --     more = (:) <$> char '.' <*> qualifiedTypeName
 
 literal :: Var v => Parser (S v) (Type v)
-literal = label "literal" . token $
-  asum [ Type.lit Type.Number <$ token (string "Number")
-       , Type.lit Type.Text <$ token (string "Text")
-       , Type.lit Type.Vector <$ token (string "Vector")
-       , (Type.v' . Text.pack) <$> typeName
-       ]
+literal = label "literal" . token $ (Type.v' . Text.pack) <$> typeName

parser-typechecker/src/Unison/Typechecker/Context.hs

@@ -257,7 +257,7 @@ wellformedType :: Var v => Context v -> Type v -> Bool
 wellformedType c t = wellformed c && case t of
   Type.Existential' v -> Set.member v (existentials c)
   Type.Universal' v -> Set.member v (universals c)
-  Type.Lit' _ -> True
+  Type.Ref' _ -> True
   Type.Arrow' i o -> wellformedType c i && wellformedType c o
   Type.Ann' t' _ -> wellformedType c t'
   Type.App' x y -> wellformedType c x && wellformedType c y
@@ -281,7 +281,7 @@ lookupType ctx v = lookup v (bindings ctx)
 apply :: Var v => Context v -> Type v -> Type v
 apply ctx t = case t of
   Type.Universal' _ -> t
-  Type.Lit' _ -> t
+  Type.Ref' _ -> t
   Type.Existential' v ->
     maybe t (\(Type.Monotype t') -> apply ctx t') (lookup v (solved ctx))
   Type.Arrow' i o -> Type.arrow (apply ctx i) (apply ctx o)
@@ -327,7 +327,7 @@ subtype :: Var v => Type v -> Type v -> M v ()
 subtype tx ty = scope (show tx++" <: "++show ty) $
   do ctx <- getContext; go ctx tx ty
   where -- Rules from figure 9
-  go _ (Type.Lit' l) (Type.Lit' l2) | l == l2 = pure () -- `Unit`
+  go _ (Type.Ref' r) (Type.Ref' r2) | r == r2 = pure () -- `Unit`
   go ctx t1@(Type.Universal' v1) t2@(Type.Universal' v2) -- `Var`
     | v1 == v2 && wellformedType ctx t1 && wellformedType ctx t2
     = pure ()

parser-typechecker/tests/Unison/Test/Common.hs

@@ -16,16 +16,10 @@ import qualified Unison.Var as Var
 import qualified Unison.Reference as R
 
 tm :: String -> Term Symbol
-tm s = let
-  t = unsafeParseTerm s
-  free = Set.toList $ ABT.freeVars t
-  in ABT.substs [(v, Term.builtin (Var.name v)) | v <- free ] t
+tm = B.tm
 
 t :: String -> Type Symbol
-t s = let
-  t = unsafeParseType s
-  free = Set.toList $ ABT.freeVars t
-  in ABT.substs [(v, Type.builtin (Var.name v)) | v <- free ] t
+t = B.t
 
 typechecks :: String -> Bool
 typechecks terms = typechecks' (tm terms)