misc cleanup

newt/Prelude.newt

@@ -189,8 +189,6 @@ instance Traversable List where
 traverse_ : ∀ t f a b. {{Traversable t}} {{Applicative f}} → (a → f b) → t a → f Unit
 traverse_ f xs = return (const MkUnit) <*> traverse f xs
 
--- FIXME - there is something subtly wrong in erasure here. t gets applied and there is no warning about it.
--- maybe we don't check the head of an application?
 for : {0 t : U → U} {0 f : U → U} → {{Traversable t}} {{appf : Applicative f}} → {0 a : U} → {0 b : U} → t a → (a → f b) → f (t b)
 for stuff fun = traverse fun stuff
 
@@ -691,10 +689,7 @@ instance Eq Ordering where
   GT == GT = True
   _ == _ = False
 
--- FIXME There is a subtle issue here with shadowing if the file defines a GT in its own namespace
+pfunc jsCompare : ∀ a. a → a → Ordering := `(_, a, b) => a == b ? "EQ" : a < b ? "LT" : "GT"`
--- We end up chosing that an assigning to GT, which cause a lot of trouble.
--- Prelude.GT is not in scope, because we've depended on the other one.
-pfunc jsCompare uses (LT EQ GT) : ∀ a. a → a → Ordering := `(_, a, b) => a == b ? Prelude_EQ : a < b ? Prelude_LT : Prelude_GT`
 
 infixl 6 _<_ _<=_ _>_
 class Ord a where

src/Lib/Compile.newt

@@ -51,7 +51,6 @@ data JSStmt : StKind -> U where
   JLet : (nm : String) -> JSStmt (Assign nm) -> JSStmt Plain  -- need somebody to assign
   JAssign : (nm : String) -> JSExp -> JSStmt (Assign nm)
   -- TODO - switch to Int tags
-  -- FIXME add e to JAlt (or just drop it?)
   JCase : ∀ a. JSExp -> List JAlt -> JSStmt a
   -- throw can't be used
   JError : ∀ a. String -> JSStmt a

src/Lib/CompileExp.newt

@@ -58,8 +58,6 @@ lamArity : Tm -> Nat
 lamArity (Lam _ _ _ _ t) = S (lamArity t)
 lamArity _ = Z
 
-
-
 -- This is how much we want to curry at top level
 -- leading lambda Arity is used for function defs and metas
 -- TODO - figure out how this will work with erasure
@@ -75,16 +73,13 @@ arityForName fc nm = do
     (Just (PrimTCon arity)) => pure $ cast arity
     (Just (PrimFn t arity used)) => pure arity
 
-
 any : ∀ a. (a → Bool) → List a → Bool
 any f Nil = False
 any f (x :: xs) = if f x then True else any f xs
 
--- need to eta out extra args, fill in the rest of the apps
+-- apply an expression at an arity to a list of args
--- NOW - maybe eta here instead of Compile.newt, drop number on CApp
+-- CApp will specify any missing args, for eta conversion later
--- The problem would be deBruijn. We have to put the app under CLam
+-- and any extra args get individual CApp.
--- which would mess up all of the deBruijn (unless we push it out)
-
 apply : CExp -> List CExp -> SnocList CExp -> Nat -> M CExp
 -- out of args, make one up (fix that last arg)
 apply t Nil acc (S k) =

src/Lib/Elab.newt

@@ -11,7 +11,6 @@ import Data.SortedMap
 import Lib.Eval
 import Lib.Util
 import Lib.TopContext
--- FIXME Def is shadowing...
 import Lib.Syntax
 import Lib.Types
 
@@ -682,8 +681,6 @@ findSplit (x :: xs) = findSplit xs
 
 -- we could pass into build case and use it for   (x /? y)
 
--- TODO, we may need to filter these against the type to rule out
--- impossible cases
 getConstructors : Context -> FC -> Val -> M (List (QName × Int × Tm))
 getConstructors ctx scfc (VRef fc nm _) = do
   names <- lookupTCon nm
@@ -731,13 +728,6 @@ substVal k v tm = go tm
     go (VMeta fc ix sp) = VMeta fc ix (map go sp)
     go (VRef fc nm sp) = VRef fc nm (map go sp)
     go tm = tm
-    -- FIXME - do I need a Val closure like idris?
-    -- or env in unify...
-    -- or quote back
-    -- go (VLam fc nm sc) = VLam fc nm sc
-    -- go (VCase x sc xs) = ?rhs_2
-    -- go (VU x) = ?rhs_7
-    -- go (VLit x y) = ?rhs_8
 
 -- need to turn k into a ground value
 
@@ -936,7 +926,6 @@ buildCase ctx prob scnm scty (dcName, arity, ty) = do
         then case y of
           PatVar _ _ s => pure $ Just $ c :: (xs ++ acc)
           PatWild _ _ => pure $ Just $ c :: (xs ++ acc)
-          -- FIXME why don't we hit this (when user puts 'x' for Just 'x')
           PatLit fc lit => error fc "Literal \{show lit} in constructor split"
           PatCon fc icit nm ys as => if nm == dcName
             then case as of

src/Lib/LiftWhere.newt

@@ -39,7 +39,6 @@ liftWhereTm name env tm@(Case fc t alts) = do
 -- This is where the magic happens
 liftWhereTm name env (LetRec fc nm ty t u) = do
   let l = length env
-  -- FIXME we need a namespace and a name, these collide everywhere.
   qn <- getName name nm
   let env' = (Just (qn, S l) :: env)
   -- environment should subst this function (see next case)
@@ -51,6 +50,7 @@ liftWhereTm name env (LetRec fc nm ty t u) = do
   u' <- liftWhereTm qn env' u
   pure $ LetRec fc nm (Erased fc) (Erased fc) u'
   where
+    -- TODO might be nice if we could nest the names (Foo.go.go) for nested where
     getName : QName → String → M QName
     getName qn@(QN ns nm) ext = do
       let qn' = QN ns (nm ++ "." ++ ext)

src/Lib/Parser.newt

@@ -1,7 +1,5 @@
 module Lib.Parser
 
--- NOW Still working on this.
-
 import Prelude
 import Lib.Common
 import Data.SortedMap

src/Lib/Parser/Impl.newt

@@ -206,7 +206,6 @@ token' : Kind -> Parser String
 token' k = satisfy (\t => t.val.kind == k) "Expected a \{show k} token"
 
 keyword' : String -> Parser Unit
--- FIXME make this an appropriate whitelist
 keyword' kw = ignore $ satisfy (\t => t.val.text == kw && (t.val.kind == Keyword || t.val.kind == Symbol || t.val.kind == Number)) "Expected \{kw}"
 
 -- expect indented token of given kind

src/Lib/Syntax.newt

@@ -217,20 +217,18 @@ instance Pretty Literal where
   pretty (LInt i) = text $ show i
   pretty (LChar c) = text $ show c
 
-
-instance Pretty Pattern where
-  -- FIXME - wrap Implicit with {}
-  pretty (PatVar _ icit str) = text str
-  pretty (PatCon _ icit nm args Nothing) = text (show nm) <+> spread (map pretty args)
-  pretty (PatCon _ icit nm args (Just as)) = text as ++ text "@(" ++ text (show nm) <+> spread (map pretty args) ++ text ")"
-  pretty (PatWild _ icit) = text "_"
-  pretty (PatLit _ lit) = pretty lit
-
 wrap : Icit -> Doc -> Doc
 wrap Explicit x = text "(" ++ x ++ text ")"
 wrap Implicit x = text "{" ++ x ++ text "}"
 wrap Auto x = text "{{" ++ x ++ text "}}"
 
+instance Pretty Pattern where
+  pretty (PatVar _ Implicit str) = text str
+  pretty (PatVar _ icit str) = wrap icit $ text str
+  pretty (PatCon _ icit nm args Nothing) = text (show nm) <+> spread (map pretty args)
+  pretty (PatCon _ icit nm args (Just as)) = text as ++ text "@(" ++ text (show nm) <+> spread (map pretty args) ++ text ")"
+  pretty (PatWild _ icit) = text "_"
+  pretty (PatLit _ lit) = pretty lit
 
 instance Pretty Raw where
   pretty = asDoc 0

src/Lib/Types.newt

@@ -188,7 +188,6 @@ pprint' p names (Pi _ "_" Explicit Many t u) =
   parens 0 p $ pprint' 1 names t <+> text "->" <+> pprint' 0 ("_" :: names) u
 pprint' p names (Pi _ nm Explicit rig t u) = parens 0 p $
   text "(" ++  text (show rig) <+> text nm <+> text ":" <+> pprint' 0 names t ++ text ")" <+> text "->" <+> pprint' 0 (nm :: names) u
--- FIXME - probably way wrong on the names here.  There is implicit binding going on
 pprint' p names (Case _ sc alts) = parens 0 p $ text "case" <+> pprint' 0 names sc <+> text "of" ++ (nest 2 (line ++ stack (map (pprintAlt 0 names) alts)))
 pprint' p names (Lit _ lit) = text (show lit)
 pprint' p names (Let _ nm t u) = parens 0 p $ text "let" <+> text nm <+> text ":=" <+> pprint' 0 names t <+> text "in" </> (nest 2 $ pprint' 0 (nm :: names) u)
@@ -355,8 +354,6 @@ record TopEntry where
   def : Def
   eflags : List EFlag
 
--- FIXME snoc
-
 instance Show TopEntry where
   show (MkEntry fc name type def flags) = "\{show name} : \{show type} := \{show def} \{show flags}"
 

src/Main.newt

@@ -179,8 +179,7 @@ processModule importFC base stk qn@(QN ns nm) = do
 
   (Nil) <- liftIO {M} $ readIORef top.errors
     | errors => do
-        for_ errors $ \err =>
+        traverse (putStrLn ∘ showError src) errors
-          putStrLn (showError src err)
         exitFailure "Compile failed"
   logMetas $ reverse $ listValues mc.metas
   pure src
@@ -190,7 +189,7 @@ processModule importFC base stk qn@(QN ns nm) = do
       (Left err) <- tryError $ processDecl ns decl | _ => pure MkUnit
       addError err
 
-
+-- unwind the module part of the path name
 baseDir : SnocList String -> SnocList String -> Either String String
 baseDir dirs Lin = Right $ joinBy "/" (dirs <>> Nil)
 baseDir (dirs :< d) (ns :< n) = if d == n
@@ -201,17 +200,15 @@ baseDir Lin _ = Left "module path doesn't match directory"
 showErrors : String -> String -> M Unit
 showErrors fn src = do
   top <- getTop
+  -- TODO {M} needed to sort out scrutinee
   (Nil) <- liftIO {M} $ readIORef top.errors
     | errors => do
-        for_ errors $ \err =>
+        traverse (putStrLn ∘ showError src) errors
-          putStrLn (showError src err)
-        -- if err.file == fn
-        -- then putStrLn (showError src err)
-        -- else putStrLn (showError "" err)
         exitFailure "Compile failed"
   pure MkUnit
 
-
+-- processFile called on the top level file
+-- it sets up everything and then recurses into processModule
 processFile : String -> M Unit
 processFile fn = do
   putStrLn "*** Process \{fn}"

tests/Auto.newt

@@ -1,24 +0,0 @@
-module Auto
-
-pfunc i2s : Int -> String := `(i) => ''+i`
-pfunc _++_ : String -> String -> String := `(a,b) => a + b`
-
-infixl 4 _++_
-
--- We need sugar and marking as class/instance on all of this
-
-data Show : U -> U where
-  MkShow : { A : U } -> ((show : A) -> String) -> Show A
-
--- FIXME - we'd like to inline this, so `show _ {{showInt}} a` ends up as `i2s a`
-show : {A : U} {{myshow : Show A}} -> A -> String
-show {_} {{MkShow foo}} a = foo a
-
-showInt : Show Int
-showInt = MkShow i2s
-
-ptype World
-pfunc log : {A : U} -> A -> World := `(_, a) => console.log(a)`
-
-main : Int -> World
-main _ = log ("answer: " ++ show 42)

tests/Auto2.newt

@@ -1,38 +0,0 @@
-module Auto2
-
-ptype World
-pfunc log : {A : U} -> A -> World := `(_, a) => console.log(a)`
-
-
-pfunc i_plus : Int -> Int -> Int := `(x,y) => x + y`
-
-data Nat : U where
-  Z : Nat
-  S : Nat -> Nat
-
-plus : Nat -> Nat -> Nat
-plus Z x = x
-plus (S k) x = S (plus k x)
-
--- a type class
-data Add : U -> U where
-  MkAdd : {A : U} -> (A -> A -> A) -> Add A
-
-infixl 8 _+_
-_+_ : {A : U} -> {{myadd : Add A}} -> A -> A -> A
-_+_ {_} {{MkAdd adder}} x y = adder x y
-
--- Two instances
-addInt : Add Int
-addInt = MkAdd i_plus
-
-addNat : Add Nat
-addNat = MkAdd plus
-
--- sequencing hack
-infixl 2 _>>_
-_>>_ :  {a b : U} ->  a -> b -> b
-a >> b = b
-
-main : World -> World
-main _ = log (40 + 2) >> log (Z + Z)

tests/RUTest.newt.golden

@@ -1,2 +1,2 @@
 0
-3
+0

tests/TestCase.newt

@@ -60,8 +60,6 @@ and = \ x y => case x of
   True => y
   False => False
 
--- FIXME - a case is evaluated here, and I don't know why.
-
 nand : Bool -> Bool -> Bool
 nand = \ x y => not (case x of
     True => y