diff --git a/newt-vscode/syntaxes/newt.tmLanguage.json b/newt-vscode/syntaxes/newt.tmLanguage.json index e0fbcb2..d494284 100644 --- a/newt-vscode/syntaxes/newt.tmLanguage.json +++ b/newt-vscode/syntaxes/newt.tmLanguage.json @@ -5,7 +5,7 @@ "patterns": [ { "name": "invalid.illegal.trace", - "match": "\\b(trace|fatalError)\\b" + "match": "\\b(trace|strace|fatalError)\\b" }, { "name": "comment.block.newt", diff --git a/src/Data/Fin.newt b/src/Data/Fin.newt new file mode 100644 index 0000000..8a9b455 --- /dev/null +++ b/src/Data/Fin.newt @@ -0,0 +1,34 @@ +module Data.Fin +import Prelude + +-- TODO - handle erased params in Nat transform. +-- TODO - double check we erase params to type constructors +data Fin : Nat → U where + FZ : ∀ k. Fin (S k) + FS : ∀ k. Fin k → Fin (S k) + +allFins : (n : Nat) → List (Fin n) +allFins Z = Nil +allFins (S k) = FZ :: map FS (allFins k) + +-- TODO maybe teach compiler to recognize and make magic Nat Eq fast? +instance ∀ n. Eq (Fin n) where + FZ == FZ = True + FS l == FS n = l == n + _ == _ = False + +-- TODO - recognize identity functions +weaken : ∀ k. Fin k → Fin (S k) +weaken FZ = FZ +weaken (FS k) = FS $ weaken k + +instance ∀ n. Cast (Fin n) Nat where + cast FZ = Z + cast (FS x) = S (cast x) + +instance ∀ k. Show (Fin k) where + show x = show {Nat} $ cast x + +lastFin : {n : _} -> Fin (S n) +lastFin {Z} = FZ +lastFin {S _} = FS lastFin diff --git a/src/Data/Vect.newt b/src/Data/Vect.newt new file mode 100644 index 0000000..cf0f3eb --- /dev/null +++ b/src/Data/Vect.newt @@ -0,0 +1,52 @@ +module Data.Vect + +import Prelude +import Data.Fin + +infixr 6 _:-_ +data Vect : (0 n : Nat) → (0 a : U) → U where + VNil : ∀ a. Vect Z a + _:-_ : ∀ k a. a → Vect k a → Vect (S k) a + +vindex : ∀ n a. Fin n → Vect n a → a +vindex FZ (x :- _) = x +vindex (FS k) (x :- rest) = vindex k rest +vindex () VNil -- Idris doesn't need this hint. + +instance ∀ k. Functor (Vect k) where + map f VNil = VNil + map f (x :- xs) = f x :- map f xs + +toVect : ∀ a. (n : Nat) -> List a -> Maybe (Vect n a) +toVect (S k) (x :: xs) = _:-_ x <$> toVect k xs +toVect Z Nil = Just VNil +toVect _ _ = Nothing + +instance ∀ n a. Cast (Vect n a) (List a) where + cast VNil = Nil + cast (x :- xs) = x :: cast xs + +instance ∀ n a. {{Show a}} → Show (Vect n a) where + show {n} {a} xs = show $ cast {_} {List a} xs + +vIndexes : (n : Nat) → Vect n (Fin n) +vIndexes Z = VNil +vIndexes (S k) = FZ :- map FS (vIndexes k) + +vIndexes' : ∀ n a. Vect n a → Vect n (Fin n) +vIndexes' VNil = VNil +vIndexes' ( _ :- xs) = FZ :- map FS (vIndexes' xs) + +venum : ∀ n a. Vect n a → Vect n (Fin n × a) +venum VNil = VNil +venum (x :- xs) = (FZ, x) :- map (mapFst FS) (venum xs) + +zipVect : ∀ n a b. Vect n a → Vect n b → Vect n (a × b) +zipVect VNil VNil = VNil +zipVect (x :- xs) (y :- ys) = (x,y) :- zipVect xs ys + +vset : ∀ n a. Fin n → a → Vect n a → Vect n a +vset () el VNil +vset FZ el (x :- xs) = el :- xs +vset (FS k) el (x :- xs) = x :- vset k el xs + diff --git a/src/Prelude.newt b/src/Prelude.newt index d0b8db0..3ecb634 100644 --- a/src/Prelude.newt +++ b/src/Prelude.newt @@ -607,8 +607,15 @@ elem v (x :: xs) = if v == x then True else elem v xs -- TODO no empty value on my `Add`, I need a group.. -- sum : ∀ a. {{Add a}} → List a → a -- sum xs = foldl _+_ + +-- TODO debugStr is not super useful any more. pfunc trace uses (debugStr) : ∀ a. String → a → a := `(_, msg, a) => { console.log(msg,Prelude_debugStr(_,a)); return a }` +pfunc prim_strace : String → String → String := `(msg, a) => { console.log(msg,a); return a }` + +strace : ∀ a. {{Show a}} → String → a → a +strace msg a = let x = prim_strace msg (show a) in a + mapMaybe : ∀ a b. (a → Maybe b) → List a → List b mapMaybe {a} {b} f xs = go Lin xs where @@ -695,6 +702,11 @@ isNothing : ∀ a. Maybe a → Bool isNothing Nothing = True isNothing _ = False +isJust : ∀ a. Maybe a → Bool +isJust Nothing = False +isJust _ = True + + instance Bifunctor _×_ where bimap f g (a,b) = (f a, g b)