diff --git a/TODO.md b/TODO.md index 298e84e..56eb4ef 100644 --- a/TODO.md +++ b/TODO.md @@ -1,7 +1,7 @@ ## TODO -- [ ] forall / ∀ sugar +- [x] forall / ∀ sugar - [ ] Bad module name error has FC 0,0 instead of the module or name - [x] I've made `{x}` be `{x : _}` instead of `{_ : x}`. Change this. - [ ] Remove context lambdas when printing solutions (show names from context) diff --git a/newt-vscode/syntaxes/newt.tmLanguage.json b/newt-vscode/syntaxes/newt.tmLanguage.json index bf159a3..3c2cafa 100644 --- a/newt-vscode/syntaxes/newt.tmLanguage.json +++ b/newt-vscode/syntaxes/newt.tmLanguage.json @@ -16,7 +16,7 @@ }, { "name": "keyword.newt", - "match": "\\b(data|where|case|of|let|in|U|module|import|ptype|pfunc|infix|infixl|infixr)\\b" + "match": "\\b(data|where|case|of|let|forall|∀|in|U|module|import|ptype|pfunc|infix|infixl|infixr)\\b" }, { "name": "string.js", diff --git a/playground/samples/Lists.newt b/playground/samples/Lists.newt index 955e498..ccd1b53 100644 --- a/playground/samples/Lists.newt +++ b/playground/samples/Lists.newt @@ -21,17 +21,17 @@ S n + m = S (n + m) -- A list is empty (Nil) or a value followed by a list (separated by the :: operator) infixr 3 _::_ data List : U -> U where - Nil : {A : U} -> List A - _::_ : {A : U} -> A -> List A -> List A + Nil : ∀ A. List A + _::_ : ∀ A. A -> List A -> List A -- length of a list is defined inductively -length : {A : U} -> List A -> Nat +length : ∀ A . List A -> Nat length Nil = Z length (x :: xs) = S (length xs) -- List concatenation infixl 2 _++_ -_++_ : {A : U} -> List A -> List A -> List A +_++_ : ∀ A. List A -> List A -> List A Nil ++ ys = ys x :: xs ++ ys = x :: (xs ++ ys) @@ -40,8 +40,8 @@ x :: xs ++ ys = x :: (xs ++ ys) -- Magic happens in the compiler when it tries to make the types -- fit into this. infixl 1 _≡_ -data _≡_ : {A : U} -> A -> A -> U where - Refl : {A : U} {a : A} -> a ≡ a +data _≡_ : ∀ A . A -> A -> U where + Refl : ∀ A . {a : A} -> a ≡ a -- If a ≡ b then b ≡ a sym : {A : U} {a b : A} -> a ≡ b -> b ≡ a @@ -60,32 +60,32 @@ cong : {A B : U} {a b : A} -> (f : A -> B) -> a ≡ b -> f a ≡ f b -- if concatenate two lists, the length is the sum of the lengths -- of the original lists -length-++ : {A : U} (xs ys : List A) -> length (xs ++ ys) ≡ length xs + length ys +length-++ : ∀ A. (xs ys : List A) -> length (xs ++ ys) ≡ length xs + length ys length-++ Nil ys = Refl length-++ (x :: xs) ys = cong S (length-++ xs ys) -- a function to reverse a list -reverse : {A : U} -> List A -> List A +reverse : ∀ A. List A -> List A reverse Nil = Nil reverse (x :: xs) = reverse xs ++ (x :: Nil) -- if we add an empty list to a list, we get the original back -++-identity : {A : U} -> (xs : List A) -> xs ++ Nil ≡ xs +++-identity : ∀ A. (xs : List A) -> xs ++ Nil ≡ xs ++-identity Nil = Refl ++-identity (x :: xs) = cong (_::_ x) (++-identity xs) -- concatenation is associative -++-associative : {A : U} (xs ys zs : List A) -> xs ++ (ys ++ zs) ≡ (xs ++ ys) ++ zs +++-associative : ∀ A. (xs ys zs : List A) -> xs ++ (ys ++ zs) ≡ (xs ++ ys) ++ zs -- reverse distributes over ++, but switches order -reverse-++-distrib : {A : U} -> (xs ys : List A) -> reverse (xs ++ ys) ≡ reverse ys ++ reverse xs +reverse-++-distrib : ∀ A. (xs ys : List A) -> reverse (xs ++ ys) ≡ reverse ys ++ reverse xs reverse-++-distrib Nil ys = sym (++-identity (reverse ys)) reverse-++-distrib (x :: xs) ys = trans (cong (\ z => z ++ (x :: Nil)) (reverse-++-distrib xs ys)) (sym (++-associative (reverse ys) (reverse xs) (x :: Nil))) -- same thing, but using `replace` in the proof -reverse-++-distrib' : {A : U} -> (xs ys : List A) -> reverse (xs ++ ys) ≡ reverse ys ++ reverse xs +reverse-++-distrib' : ∀ A. (xs ys : List A) -> reverse (xs ++ ys) ≡ reverse ys ++ reverse xs reverse-++-distrib' Nil ys = sym (++-identity (reverse ys)) reverse-++-distrib' {A} (x :: xs) ys = replace (\ z => (reverse (xs ++ ys) ++ (x :: Nil)) ≡ z) @@ -93,28 +93,28 @@ reverse-++-distrib' {A} (x :: xs) ys = (replace (\ z => (reverse (xs ++ ys)) ++ (x :: Nil) ≡ z ++ (x :: Nil)) (reverse-++-distrib' xs ys) Refl) -- reverse of reverse gives you the original list -reverse-involutive : {A : U} -> (xs : List A) -> reverse (reverse xs) ≡ xs +reverse-involutive : ∀ A. (xs : List A) -> reverse (reverse xs) ≡ xs reverse-involutive Nil = Refl reverse-involutive (x :: xs) = trans (reverse-++-distrib (reverse xs) (x :: Nil)) (cong (_::_ x) (reverse-involutive xs)) -- helper for a different version of reverse -shunt : {A : U} -> List A -> List A -> List A +shunt : ∀ A. List A -> List A -> List A shunt Nil ys = ys shunt (x :: xs) ys = shunt xs (x :: ys) -- lemma -shunt-reverse : {A : U} (xs ys : List A) -> shunt xs ys ≡ reverse xs ++ ys +shunt-reverse : ∀ A. (xs ys : List A) -> shunt xs ys ≡ reverse xs ++ ys shunt-reverse Nil ys = Refl shunt-reverse (x :: xs) ys = trans (shunt-reverse xs (x :: ys)) (++-associative (reverse xs) (x :: Nil) ys) -- an alternative definition of reverse -reverse' : {A : U} -> List A -> List A +reverse' : ∀ A. List A -> List A reverse' xs = shunt xs Nil -- proof that the reverse and reverse' give the same results -reverses : {A : U} → (xs : List A) → reverse' xs ≡ reverse xs +reverses : ∀ A. (xs : List A) → reverse' xs ≡ reverse xs reverses xs = trans (shunt-reverse xs Nil) (++-identity _) diff --git a/playground/samples/Tour.newt b/playground/samples/Tour.newt index 07f0e67..d8ea502 100644 --- a/playground/samples/Tour.newt +++ b/playground/samples/Tour.newt @@ -77,13 +77,13 @@ test = Refl infixl 7 _+_ -- We don't have records yet, so we define a single constructor --- inductive type: +-- inductive type. Here we also use `∀ A.` which is sugar for `{A : _} ->` data Plus : U -> U where - MkPlus : {A : U} -> (A -> A -> A) -> Plus A + MkPlus : ∀ A. (A -> A -> A) -> Plus A -- and the generic function that uses it -- the double brackets indicate an argument that is solved by search -_+_ : {A : U} {{_ : Plus A}} -> A -> A -> A +_+_ : ∀ A. {{_ : Plus A}} -> A -> A -> A _+_ {{MkPlus f}} x y = f x y -- The typeclass is now defined, search will look for functions in scope @@ -150,31 +150,31 @@ data Monad : (U -> U) -> U where ({a b : U} -> m a -> (a -> m b) -> m b) -> Monad m -pure : {m : U -> U} -> {{_ : Monad m}} -> {a : U} -> a -> m a +pure : ∀ m . {{_ : Monad m}} -> {a : U} -> a -> m a pure {{MkMonad p _}} a = p a -- we can declare multiple infix operators at once infixl 1 _>>=_ _>>_ -_>>=_ : {m : U -> U} -> {{_ : Monad m}} -> {a b : U} -> m a -> (a -> m b) -> m b +_>>=_ : ∀ m a b. {{_ : Monad m}} -> m a -> (a -> m b) -> m b _>>=_ {{MkMonad _ b}} ma amb = b ma amb -_>>_ : {m : U -> U} -> {{_ : Monad m}} -> {a b : U} -> m a -> m b -> m b +_>>_ : ∀ m a b. {{_ : Monad m}} -> m a -> m b -> m b ma >> mb = ma >>= (λ _ => mb) -- That's our Monad typeclass, now let's make a List monad infixr 3 _::_ data List : U -> U where - Nil : {A : U} -> List A - _::_ : {A : U} -> A -> List A -> List A + Nil : ∀ A. List A + _::_ : ∀ A. A -> List A -> List A infixr 7 _++_ -_++_ : {a : U} -> List a -> List a -> List a +_++_ : ∀ a. List a -> List a -> List a Nil ++ ys = ys (x :: xs) ++ ys = x :: (xs ++ ys) -bindList : {a b : U} -> List a -> (a -> List b) -> List b +bindList : ∀ a b. List a -> (a -> List b) -> List b bindList Nil f = Nil bindList (x :: xs) f = f x ++ bindList xs f @@ -186,11 +186,11 @@ MonadList = MkMonad (λ a => a :: Nil) bindList -- Also we see that → can be used in lieu of -> infixr 1 _,_ _×_ data _×_ : U → U → U where - _,_ : {A B : U} → A → B → A × B + _,_ : ∀ A B. A → B → A × B -- The _>>=_ operator is used for desugaring do blocks -prod : {A B : U} → List A → List B → List (A × B) +prod : ∀ A B. List A → List B → List (A × B) prod xs ys = do x <- xs y <- ys diff --git a/playground/src/monarch.ts b/playground/src/monarch.ts index e723f7a..5db38d2 100644 --- a/playground/src/monarch.ts +++ b/playground/src/monarch.ts @@ -70,6 +70,8 @@ export let newtTokens: monaco.languages.IMonarchLanguage = { "case", "of", "data", + "forall", + "∀", "U", "module", "ptype", diff --git a/src/Lib/Parser.idr b/src/Lib/Parser.idr index 7c5a2c1..a858682 100644 --- a/src/Lib/Parser.idr +++ b/src/Lib/Parser.idr @@ -252,6 +252,15 @@ arrow : Parser Unit arrow = sym "->" <|> sym "→" -- Collect a bunch of binders (A : U) {y : A} -> ... + +forAll : Parser Raw +forAll = do + keyword "forall" <|> keyword "∀" + all <- some (withPos varname) + keyword "." + scope <- typeExpr + pure $ foldr (\ (fc, n), sc => RPi fc (Just n) Implicit (RImplicit fc) sc) scope all + binders : Parser Raw binders = do binds <- many (abind <|> ibind <|> ebind) @@ -262,7 +271,9 @@ binders = do mkBind : FC -> (String, Icit, Raw) -> Raw -> Raw mkBind fc (name, icit, ty) scope = RPi fc (Just name) icit ty scope -typeExpr = binders +typeExpr + = binders + <|> forAll <|> do fc <- getPos exp <- term diff --git a/src/Lib/Tokenizer.idr b/src/Lib/Tokenizer.idr index 6502e01..19f3ed6 100644 --- a/src/Lib/Tokenizer.idr +++ b/src/Lib/Tokenizer.idr @@ -8,10 +8,8 @@ import Lib.Common keywords : List String keywords = ["let", "in", "where", "case", "of", "data", "U", "do", "ptype", "pfunc", "module", "infixl", "infixr", "infix", - "->", "→", ":", "=>", ":=", "=", "<-", "\\", "_"] - -specialOps : List String -specialOps = ["->", ":", "=>", ":=", "=", "<-"] + "∀", "forall", ".", + "->", "→", ":", "=>", ":=", "=", "<-", "\\", "_"] checkKW : String -> Token Kind checkKW s = if elem s keywords then Tok Keyword s else Tok Ident s @@ -20,10 +18,10 @@ checkUKW : String -> Token Kind checkUKW s = if elem s keywords then Tok Keyword s else Tok UIdent s identMore : Lexer -identMore = alphaNum <|> exact "." <|> exact "'" <|> exact "_" +identMore = alphaNum <|> exact "'" <|> exact "_" singleton : Lexer -singleton = oneOf "()\\{}[],?" +singleton = oneOf "()\\{}[],?." quo : Recognise True quo = is '"'