Add vscode extension, command line argument, and positioned error handling.

README.md

@@ -4,20 +4,44 @@ Ditched well-scoped for now.
 
 Fixed more issues, started processing stuff, we need real example code.
 
+Need to sort out eval. Currently List doesn't get substituted. We should make sure we're CBV. I guess I could always subst (or glue?) since we're head normal form. We need actual values (∏) for checking.
+
+ok, our kovacs eval puts the arg in the environment and continues. So CBN, but maybe duplicate work (for our version).
+
+So smalltt has TopVar with a Level. typechecking binders end up as top too.
+
+Also delayed unfolded values for top or solved metas. This looks like glue - all the bits for the top and a cached value (it's keeping top as values).
+
+
+
+
 Parser:
 - [x] import statement
 - [x] def
 - [x] simple decl
-- [ ] fix / test parsing and pretty printing
+- [x] List not in scope
+- [ ] vscode support for .newt
+- [ ] Should I switch this back over to the App monad?
+- [ ] Error object like pi-forall
+- [ ] Get implicits working
+- [x] Replace on define
+- [x] more sugar on lambdas
+- [ ] tests for parsing and pretty printing
 - [ ] inductive types
 - [x] read files
-- [ ] process a file
-- [ ] figure out context representation - Global context?
-- [ ] type checking / elab
-- [ ] error printing
-- [ ] 
-- [ ] 
+- [x] process a file
+- [x] figure out context representation - Global context?
+- [x] type checking / elab
+  - What does this represent? The basics, implicits? pattern unification?
 - [ ] symbolic execution
 - [ ] compilation
 
 - [ ] write tests
+
+Forward:
+
+- [ ] Switch to query-based?
+- [ ] LSP?
+- [ ] white box testing
+- 
+f

eg/eq.newt

@@ -0,0 +1,15 @@
+module Equality
+
+-- we don't have implicits yet, so this won't typecheck
+
+Eq : {A : U} -> A -> A -> U
+Eq = \ {A} => \ x => \ y => (P : A -> U) -> P x -> P y
+
+refl : {A : U} {x : A} -> Eq x x
+refl = \ {A} => \ {x} => x
+
+-- can I write J without pattern matching?
+J : {A : U} {x y : A} (eq : Eq x y) ->
+(mot : (x : A) (P : Eq x y) -> U)
+(b : mot y refl) -> 
+mot x eq

eg/ex.newt

@@ -11,7 +11,7 @@ id = \ a => \ x => x
 List : U -> U
 List = \ A => (L : U) -> L -> (A -> L -> L) -> L
 
-nil : (A L : U) -> L -> (A -> L -> L) -> L
+nil : (A : U) -> List A
 nil = \ A L n f => n
 
 Bool : U

eg/zoo2.newt

@@ -0,0 +1,31 @@
+module Zoo2
+
+id : (A : U) -> A -> A
+id = \ A x => x
+
+const : (A B : U) -> A -> B -> A
+const = \A B x y => x
+
+Nat : U
+Nat = (N : U) -> (N -> N) -> N -> N
+
+-- need Nat to reduce (and syntax highlighting)
+five : Nat
+five = \ N s z => s (s (s (s (s z))))
+
+add : Nat -> Nat -> Nat
+add = \a b N s z => a N s (b N s z)
+
+mul : Nat -> Nat -> Nat
+mul = \a b N s z => a N (b N s) z
+
+ten : Nat
+ten = add five five
+
+hundred : Nat
+hundred = mul ten ten
+
+thousand : Nat
+thousand = mul ten hundred
+
+-- and then nf / eval of hundred

newt-vscode/.eslintrc.json

@@ -0,0 +1,30 @@
+{
+    "root": true,
+    "parser": "@typescript-eslint/parser",
+    "parserOptions": {
+        "ecmaVersion": 6,
+        "sourceType": "module"
+    },
+    "plugins": [
+        "@typescript-eslint"
+    ],
+    "rules": {
+        "@typescript-eslint/naming-convention": [
+            "warn",
+            {
+                "selector": "import",
+                "format": [ "camelCase", "PascalCase" ]
+            }
+        ],
+        "@typescript-eslint/semi": "warn",
+        "curly": "warn",
+        "eqeqeq": "warn",
+        "no-throw-literal": "warn",
+        "semi": "off"
+    },
+    "ignorePatterns": [
+        "out",
+        "dist",
+        "**/*.d.ts"
+    ]
+}

newt-vscode/.gitignore

@@ -0,0 +1,4 @@
+dist
+node_modules
+*.vsix
+

newt-vscode/.vscodeignore

@@ -0,0 +1,4 @@
+.vscode/**
+.vscode-test/**
+.gitignore
+vsc-extension-quickstart.md

newt-vscode/CHANGELOG.md

@@ -0,0 +1,9 @@
+# Change Log
+
+All notable changes to the "newt-vscode" extension will be documented in this file.
+
+Check [Keep a Changelog](http://keepachangelog.com/) for recommendations on how to structure this file.
+
+## [Unreleased]
+
+- Initial release

newt-vscode/README.md

@@ -0,0 +1,3 @@
+# newt-vscode README
+
+newt extension for vscode

newt-vscode/esbuild.js

@@ -0,0 +1,56 @@
+const esbuild = require("esbuild");
+
+const production = process.argv.includes('--production');
+const watch = process.argv.includes('--watch');
+
+/**
+ * @type {import('esbuild').Plugin}
+ */
+const esbuildProblemMatcherPlugin = {
+	name: 'esbuild-problem-matcher',
+
+	setup(build) {
+		build.onStart(() => {
+			console.log('[watch] build started');
+		});
+		build.onEnd((result) => {
+			result.errors.forEach(({ text, location }) => {
+				console.error(`✘ [ERROR] ${text}`);
+				console.error(`    ${location.file}:${location.line}:${location.column}:`);
+			});
+			console.log('[watch] build finished');
+		});
+	},
+};
+
+async function main() {
+	const ctx = await esbuild.context({
+		entryPoints: [
+			'src/extension.ts'
+		],
+		bundle: true,
+		format: 'cjs',
+		minify: production,
+		sourcemap: !production,
+		sourcesContent: false,
+		platform: 'node',
+		outfile: 'dist/extension.js',
+		external: ['vscode'],
+		logLevel: 'silent',
+		plugins: [
+			/* add to the end of plugins array */
+			esbuildProblemMatcherPlugin,
+		],
+	});
+	if (watch) {
+		await ctx.watch();
+	} else {
+		await ctx.rebuild();
+		await ctx.dispose();
+	}
+}
+
+main().catch(e => {
+	console.error(e);
+	process.exit(1);
+});

newt-vscode/language-configuration.json

@@ -0,0 +1,30 @@
+{
+    "comments": {
+        // symbol used for single line comment. Remove this entry if your language does not support line comments
+        "lineComment": "--",
+        // symbols used for start and end a block comment. Remove this entry if your language does not support block comments
+        "blockComment": [ "/-", "-/" ]
+    },
+    // symbols used as brackets
+    "brackets": [
+        ["{", "}"],
+        ["[", "]"],
+        ["(", ")"]
+    ],
+    // symbols that are auto closed when typing
+    "autoClosingPairs": [
+        ["{", "}"],
+        ["[", "]"],
+        ["(", ")"],
+        ["\"", "\""],
+        ["'", "'"]
+    ],
+    // symbols that can be used to surround a selection
+    "surroundingPairs": [
+        ["{", "}"],
+        ["[", "]"],
+        ["(", ")"],
+        ["\"", "\""],
+        ["'", "'"]
+    ]
+}

newt-vscode/package.json

@@ -0,0 +1,62 @@
+{
+  "name": "newt-vscode",
+  "displayName": "newt-vscode",
+  "description": "newt language support",
+  "version": "0.0.1",
+  "license": "MIT",
+  "engines": {
+    "vscode": "^1.91.0"
+  },
+  "categories": [
+    "Programming Languages"
+  ],
+  "activationEvents": [
+  ],
+  "main": "./dist/extension.js",
+  "contributes": {
+    "languages": [{
+      "id": "newt",
+      "aliases": ["newt", "newt"],
+      "extensions": ["newt"],
+      "configuration": "./language-configuration.json"
+    }],
+    "grammars": [{
+      "language": "newt",
+      "scopeName": "source.newt",
+      "path": "./syntaxes/newt.tmLanguage.json"
+    }],
+    "commands": [
+      {
+        "command": "newt-vscode.check",
+        "title": "Check newt file"
+      }
+    ]
+
+  },
+  "scripts": {
+    "vscode:prepublish": "npm run package",
+    "compile": "npm run check-types && npm run lint && node esbuild.js",
+    "watch": "npm-run-all -p watch:*",
+    "watch:esbuild": "node esbuild.js --watch",
+    "package": "npm run check-types && npm run lint && node esbuild.js --production",
+    "compile-tests": "tsc -p . --outDir out",
+    "watch-tests": "tsc -p . -w --outDir out",
+    "pretest": "npm run compile-tests && npm run compile && npm run lint",
+    "check-types": "tsc --noEmit",
+    "lint": "eslint src --ext ts",
+    "test": "vscode-test"
+  },
+  "devDependencies": {
+    "@types/mocha": "^10.0.7",
+    "@types/node": "20.x",
+    "@types/vscode": "^1.90.0",
+    "@typescript-eslint/eslint-plugin": "^7.14.1",
+    "@typescript-eslint/parser": "^7.11.0",
+    "@vscode/test-cli": "^0.0.9",
+    "@vscode/test-electron": "^2.4.0",
+    "esbuild": "^0.21.5",
+    "eslint": "^8.57.0",
+    "npm-run-all": "^4.1.5",
+    "typescript": "^5.4.5"
+  }
+}

newt-vscode/src/extension.ts

@@ -0,0 +1,91 @@
+import * as vscode from "vscode";
+import { exec } from "child_process";
+import path from "path";
+
+export function activate(context: vscode.ExtensionContext) {
+  const diagnosticCollection =
+    vscode.languages.createDiagnosticCollection("newt");
+
+  function checkDocument(document: vscode.TextDocument) {
+    const fileName = document.fileName;
+    // Is there a better way to do this? It will get fussy with quoting and all plus it's not visible to the user.
+    const workspaceFolder = vscode.workspace.getWorkspaceFolder(document.uri);
+    const cwd = workspaceFolder
+      ? workspaceFolder.uri.fsPath
+      : path.dirname(fileName);
+    const config = vscode.workspace.getConfiguration("newt");
+    const cmd = config.get<string>("path", "build/exec/newt");
+    const command = `${cmd} ${fileName}`;
+    exec(command, { cwd }, (err, stdout, _stderr) => {
+      if (err && err.code !== 1) {
+        vscode.window.showErrorMessage(`newt error: ${err}`);
+      }
+
+      // extract errors and messages from stdout
+      const lines = stdout.split("\n");
+      const diagnostics: vscode.Diagnostic[] = [];
+
+      for (let i = 0; i < lines.length; i++) {
+        const line = lines[i];
+        const match = line.match(/ERROR at \((\d+), (\d+)\): (.*)/);
+        if (match) {
+          let [_full, line, column, message] = match;
+          let lnum = Number(line);
+          let cnum = Number(column);
+          let start = new vscode.Position(lnum, cnum);
+          // we don't have the full range, so grab the surrounding word
+          let end = new vscode.Position(lnum, cnum+1);
+          let range =
+            document.getWordRangeAtPosition(start) ??
+            new vscode.Range(start, end);
+          // heuristics to grab the entire message:
+          // anything indented
+          // Context:, or Goal: are part of PRINTME
+          // unexpected / expecting appear in parse errors
+          while (
+            lines[i + 1]?.match(/^(  )/)
+          ) {
+            message += "\n" + lines[++i];
+          }
+          const severity = vscode.DiagnosticSeverity.Error;
+          const diag = new vscode.Diagnostic(range, message, severity);
+          diagnostics.push(diag);
+        }
+      }
+      diagnosticCollection.set(vscode.Uri.file(fileName), diagnostics);
+    });
+  }
+
+  const runPiForall = vscode.commands.registerCommand(
+    "newt-vscode.check",
+    () => {
+      const editor = vscode.window.activeTextEditor;
+      if (editor) {
+        const document = editor.document;
+        if (document.fileName.endsWith(".newt")) {
+          checkDocument(document);
+        }
+      }
+    }
+  );
+  context.subscriptions.push(runPiForall);
+
+  vscode.workspace.onDidSaveTextDocument((document) => {
+    if (document.fileName.endsWith(".newt")) {
+      vscode.commands.executeCommand("newt-vscode.check");
+    }
+  });
+  vscode.workspace.onDidOpenTextDocument((document) => {
+    if (document.fileName.endsWith(".newt")) {
+      vscode.commands.executeCommand("newt-vscode.check");
+    }
+  });
+  for (let document of vscode.workspace.textDocuments) {
+    if (document.fileName.endsWith(".newt")) {
+      checkDocument(document);
+    }
+  }
+  context.subscriptions.push(diagnosticCollection);
+}
+
+export function deactivate() {}

newt-vscode/syntaxes/newt.tmLanguage.json

@@ -0,0 +1,48 @@
+{
+  "$schema": "https://raw.githubusercontent.com/martinring/tmlanguage/master/tmlanguage.json",
+  "name": "newt",
+  "scopeName": "source.newt",
+  "patterns": [
+	{
+		"name": "comment.block.newt",
+		"begin": "/-",
+		"end": "`-/",
+		"contentName": "comment.block.newt"
+	},
+	{
+      "name": "comment.line.newt",
+      "begin": "--",
+      "end": "\\n"
+  },
+	{
+      "name": "variable.other.constant",
+      "match": "([\\w]+)\\."
+    },
+    {
+      "name": "entity.name.variable",
+      "match": "\\.([\\w]+)"
+    },
+	{
+		"name": "punctuation",
+		"match": ":|=>|\\"
+	},
+    {
+      "name": "keyword.other.operator.newt",
+      "match": "[\\p{Math}:!#$%&*+.,/<=>?@\\^|-]+"
+    },
+
+    {
+      "name": "keyword.command.newt",
+      "match": "\\b(module)\\b"
+    },
+    {
+      "name": "keyword.newt",
+      "match": "\\b(data)\\b"
+    },
+    // {
+    //   "name": "variable.other.constant.newt",
+    //   "match": "\\b(Type|Id|refl|sym|Gel|ungel)\\b",
+	  // "comment": "These are in the emacs mode, but some are user defined"
+    // }
+  ]
+}

newt-vscode/tsconfig.json

@@ -0,0 +1,16 @@
+{
+	"compilerOptions": {
+		"module": "Node16",
+		"target": "ES2022",
+		"lib": [
+			"ES2022"
+		],
+		"sourceMap": true,
+		"rootDir": "src",
+		"strict": true   /* enable all strict type-checking options */
+		/* Additional Checks */
+		// "noImplicitReturns": true, /* Report error when not all code paths in function return a value. */
+		// "noFallthroughCasesInSwitch": true, /* Report errors for fallthrough cases in switch statement. */
+		// "noUnusedParameters": true,  /* Report errors on unused parameters. */
+	}
+}

src/Lib/Check.idr

@@ -10,13 +10,13 @@ import Lib.TopContext
 import Syntax
 
 -- cribbed this, it avoids MonadError String m => everywhere
-parameters {0 m : Type -> Type} {auto _ : MonadError String m} (top : TopContext)
+parameters {0 m : Type -> Type} {auto _ : MonadError Error m} (top : TopContext)
   export
   infer : Context -> Raw -> m (Tm, Val)
 
   export
   check : Context -> Raw -> Val -> m Tm
-
+  check ctx (RSrcPos x tm) ty = check ({pos := x} ctx) tm ty
   check ctx (RLam nm icit tm) ty = case ty of                    
                     (VPi pinm icit a b) => do
                       -- TODO icit
@@ -24,18 +24,25 @@ parameters {0 m : Type -> Type} {auto _ : MonadError String m} (top : TopContext
                       let ctx' = extend ctx nm a
                       tm' <- check ctx' tm (b $$ var)
                       pure $ Lam nm icit tm'
-                      
-                    other => throwError "Expected pi type \{show $ quote 0 ty}"
+                    
+                    -- So it gets stuck for `List a`, not a pi type, and we want the
+                    -- (This is not a data constructor, but a church encoding)
+                    -- List reduces now and we're stuck for `Nat`.
+
+                    other => error [(DS "Expected pi type, got \{show $ quote 0 ty}")]
   check ctx tm ty = do
     (tm', ty') <- infer ctx tm
     if quote 0 ty /= quote 0 ty' then
-        throwError "type mismatch"
+        error [DS "type mismatch"]
       else pure tm'
 
   infer ctx (RVar nm) = go 0 ctx.types
     where
       go : Nat -> Vect n (String, Val) -> m (Tm, Val)
-      go i [] = throwError "\{show nm} not in scope \{show $ map fst ctx.types}"
+      go i [] = case lookup nm top of
+        Just (MkEntry name ty (Fn t)) => pure (Ref nm (Just t), eval [] CBN ty)
+        Just (MkEntry name ty _) => pure (Ref nm Nothing, eval [] CBN ty)
+        Nothing => error [DS "\{show nm} not in scope"]
       go i ((x, ty) :: xs) = if x == nm then pure $ (Bnd i, ty) 
         else go (i + 1) xs
     -- need environment of name -> type..
@@ -45,12 +52,12 @@ parameters {0 m : Type -> Type} {auto _ : MonadError String m} (top : TopContext
     case tty of
       (VPi str icit' a b) => do
         u <- check ctx u a
-        pure (App t u, b $$ eval ctx.env t)
-      _ => throwError "Expected Pi type"    
+        pure (App t u, b $$ eval ctx.env CBN t)
+      _ => error [DS "Expected Pi type"]
   infer ctx RU = pure (U, VU) -- YOLO
   infer ctx (RPi nm icit ty ty2) = do
     ty' <- check ctx ty VU
-    let vty' := eval ctx.env ty'
+    let vty' := eval ctx.env CBN ty'
     let nm := fromMaybe "_" nm
     ty2' <- check (extend ctx nm vty') ty2 VU
     pure (Pi nm icit ty' ty2', VU)
@@ -58,13 +65,13 @@ parameters {0 m : Type -> Type} {auto _ : MonadError String m} (top : TopContext
   infer ctx (RSrcPos x tm) = infer ({pos := x} ctx) tm
   infer ctx (RAnn tm rty) = do
     ty <- check ctx rty VU
-    let vty = eval ctx.env ty 
+    let vty = eval ctx.env CBN ty 
     tm <- check ctx tm vty
     pure (tm, vty)
 
-  infer ctx (RLam str icit tm) = throwError "can't infer lambda"
+  infer ctx (RLam str icit tm) = error [DS "can't infer lambda"]
 
-  infer ctx _ = throwError "TODO"
+  infer ctx _ = error [DS "TODO"]
 
   -- I don't have types for these yet...
   -- infer ctx (RLit (LString str)) = ?rhs_10

src/Lib/Parser.idr

@@ -1,13 +1,11 @@
 module Lib.Parser
 import Lib.TT
 
--- NEXT - need to sort out parsing implicits
---
--- app:   foo {a} a b 
--- lam: λ {A} {b : A} (c : Blah) d e f. something
+-- app: foo {a} a b 
+-- lam: λ {A} {b : A} (c : Blah) d e f => something
+-- lam: \ {A} {b : A} (c : Blah) d e f => something
 -- pi: (A : Set) -> {b : A} -> (c : Foo b) -> c -> bar d
-
-
+-- pi: (A B : Set) {b : A} -> (c : Foo b) -> c -> bar d
 
 import Lib.Token
 import Lib.Parser.Impl
@@ -139,7 +137,7 @@ pLetArg = (Implicit,,) <$> braces ident <*> optional (sym ":" >> typeExpr)
 export
 lamExpr : Parser Raw
 lamExpr = do
-  keyword "\\"
+  keyword "\\" <|> keyword "λ"
   commit
   args <- some pLetArg
   keyword "=>"
@@ -170,7 +168,7 @@ caseExpr = do
   alts <- startBlock $ someSame $ caseAlt
   pure $ RCase sc alts
 
-term =  caseExpr
+term =  withPos $ caseExpr
     <|> letExpr
     <|> lamExpr
     <|> parseOp

src/Lib/Parser/Impl.idr

@@ -23,14 +23,14 @@ data Error = E SourcePos String
 
 public export
 showError : String -> Error -> String
-showError src (E (line, col) msg) = "Err at \{show (line,col)} \{msg}\n" ++ go 0 (lines src)
+showError src (E (line, col) msg) = "ERROR at \{show (line,col)}: \{msg}\n" ++ go 0 (lines src)
   where
     go : Int -> List String -> String
     go l [] = ""
     go l (x :: xs) = 
       if l == line then
-        "\{x}\n\{replicate (cast col) ' '}^\n"
-      else if line - 3 < l then x ++ "\n" ++ go (l + 1) xs 
+        "  \{x}\n  \{replicate (cast col) ' '}^\n"
+      else if line - 3 < l then "  " ++ x ++ "\n" ++ go (l + 1) xs 
       else go (l + 1) xs
 
 -- Result of a parse

src/Lib/Prettier.idr

@@ -57,10 +57,13 @@ best : Nat -> Nat -> Doc -> DOC
 best w k x = be w k [(0,x)]
 
 -- Public interface
+public export
+interface Pretty a where
+  pretty : a -> Doc
 
 export
-pretty : Nat -> Doc -> String
-pretty w x = layout (best w 0 x)
+render : Nat -> Doc -> String
+render w x = layout (best w 0 x)
 
 public export
 Semigroup Doc where x <+> y = Seq x (Seq (Text " ") y)
@@ -124,3 +127,7 @@ fill : List Doc -> Doc
 fill [] = Empty
 fill [x] = x
 fill (x :: y :: xs) = (flatten x <+> fill (flatten y :: xs)) `Alt` (x </> fill (y :: xs))
+
+public export
+FromString Doc where
+  fromString = text

src/Lib/TT.idr

@@ -3,11 +3,10 @@
 -- maybe watch https://www.youtube.com/watch?v=3gef0_NFz8Q
 -- or drop the indices for now.
 
--- The Control.App requires a patched idris. :(
-
 module Lib.TT
 -- For SourcePos
 import Lib.Parser.Impl
+import Lib.Prettier
 
 import Control.Monad.Error.Interface
 import Data.Fin
@@ -27,7 +26,8 @@ data Icit = Implicit | Explicit
 public export
 data Tm : Type where
   Bnd : Nat -> Tm
-  Ref : String -> Tm
+  -- Maybe Def here instead of Maybe Tm, we'll have DCon, TCon, etc.
+  Ref : String -> Maybe Tm -> Tm
   Lam : Name -> Icit -> Tm -> Tm
   App : Tm -> Tm -> Tm
   U   : Tm
@@ -38,8 +38,8 @@ data Tm : Type where
 
 public export
 Show Tm where
-  show (Bnd k) = "Bnd \{show k}"
-  show (Ref str) = "Ref \{show str}"
+  show (Bnd k) = "(Bnd \{show k})"
+  show (Ref str _) = "(Ref \{show str})"
   show (Lam nm Implicit t) = "(λ {\{nm}} => \{show  t})"
   show (Lam nm Explicit t) = "(λ \{nm}  => \{show  t})"
   show (App t u) = "(\{show t} \{show u})"
@@ -61,7 +61,7 @@ export
 Eq (Tm) where
   -- (Local x) == (Local y) = x == y
   (Bnd x) == (Bnd y) = x == y
-  (Ref x) == (Ref y) = x == y
+  (Ref x _) == (Ref y _) = x == y
   (Lam n icit t) == (Lam n' icit' t') = icit == icit' && t == t'
   (App t u) == App t' u' = t == t' && u == u'
   U == U = True
@@ -92,7 +92,7 @@ public export
 data Val : Type where
   -- This will be local / flex with spine.
   VVar : Nat -> Val
-  VRef : String -> Val
+  VRef : String -> Maybe Tm -> Val
   VApp : Val ->  Lazy (Val) -> Val
   VLam : Name -> Icit -> Closure -> Val
   VPi : Name -> Icit -> Lazy Val -> Closure -> Val
@@ -102,14 +102,17 @@ public export
 Env : Type
 Env = List Val
 
+public export
+data Mode = CBN | CBV
+
 export
-eval : Env -> Tm -> Val
+eval : Env -> Mode -> Tm -> Val
 
 data Closure = MkClosure Env Tm
 
 public export
-($$) : Closure -> Val -> Val
-($$) (MkClosure env tm) u = eval (u :: env) tm
+($$) : {auto mode : Mode} -> Closure -> Val -> Val
+($$) (MkClosure env tm) u = eval (u :: env) mode tm
 
 public export
 infixl 8 $$
@@ -122,40 +125,38 @@ vapp t u = VApp t u
 bind : Val -> Env -> Env
 bind v env = v :: env
 
-eval env (Ref x) = VRef x
-eval env (App t u) = vapp (eval env t) (eval env u)
-eval env U = VU
-eval env (Lam x icit t) = VLam x icit (MkClosure env t)
-eval env (Pi x icit a b) = VPi x icit (eval env a) (MkClosure env b)
-eval env (Let x icit ty t u) = eval (eval env t :: env) u
-eval env (Bnd i) = let Just rval = getAt i env | _ => ?out_of_index
+-- Do we want a def in here instead?  We'll need DCon/TCon eventually
+-- I need to be aggressive about reduction, I guess. I'll figure it out
+-- later, maybe need lazy glued values.
+eval env mode (Ref x (Just tm)) = eval env mode tm
+eval env mode (Ref x Nothing) = VRef x Nothing
+eval env mode (App (Ref x (Just tm)) u) = vapp (eval env mode tm) (eval env mode u)
+eval env mode (App t u) = vapp (eval env mode t) (eval env mode u)
+eval env mode U = VU
+eval env mode (Lam x icit t) = VLam x icit (MkClosure env t)
+eval env mode (Pi x icit a b) = VPi x icit (eval env mode a) (MkClosure env b)
+eval env mode (Let x icit ty t u) = eval (eval env mode t :: env) mode u
+eval env mode (Bnd i) = let Just rval = getAt i env | _ => ?out_of_index
                    in rval
 
 export
 quote : (lvl : Nat) -> Val -> Tm
 quote l (VVar k) = Bnd ((l `minus` k) `minus` 1) -- level to index
 quote l (VApp t u) = App (quote l t) (quote l u)
--- so this one is calling the kripke on [x] and a fresh var
-quote l (VLam x icit t) = Lam x icit (quote (S l) (t $$ VVar l)) -- that one is too big
+quote l (VLam x icit t) = Lam x icit (quote (S l) (t $$ VVar l))
 quote l (VPi x icit a b) = Pi x icit (quote l a) (quote (S l) (b $$ VVar l))
 quote l VU = U
-quote _ (VRef n) = Ref n
+quote l (VRef n tm) = Ref n tm
 
 -- how are we using this?  Can we assume completely closed?
 -- ezoo only seems to use it at [], but essentially does this:
 export
 nf : Env -> Tm -> Tm
-nf env t = quote (length env) (eval env t)
+nf env t = quote (length env) (eval env CBN t)
 
 public export
 conv : (lvl : Nat) -> Val -> Val -> Bool
 
--- data BD = Bound | Defined
-
--- public export
--- Types : Type
--- Types = List (Name, Lazy Val)
-
 
 {-
 smalltt
@@ -208,6 +209,25 @@ export partial
 Show Context where
   show ctx = "Context \{show $ map fst $ ctx.types}"
 
+-- TODO Pretty Context
+
+
+
+-- idea cribbed from pi-forall
+public export
+data ErrorSeg : Type where
+  DD : Pretty a => a -> ErrorSeg
+  DS : String -> ErrorSeg
+
+toDoc : ErrorSeg -> Doc
+toDoc (DD x) = pretty x
+toDoc (DS str) = text str
+
+export
+error : {0 m : Type -> Type} -> {auto _ : MonadError Error m} ->
+    {auto ctx : Context} -> List ErrorSeg -> m a
+error xs = throwError $ E ctx.pos (render 80 $ spread $ map toDoc xs)
+
 ||| add a binding to environment
 export
 extend : Context -> String -> Val -> Context
@@ -220,10 +240,7 @@ define : Context -> String -> Val -> Val -> Context
 define (MkCtx lvl env types bds pos) name val ty =
   MkCtx (S lvl) (val :: env) ((name, ty) :: types) (Defined :: bds) pos
 
-
-update : Context -> String -> Tm -> Context
--- oof
-
+-- not used
 lookup : {0 m : Type -> Type} -> {auto _ : MonadError String m} ->
       Context -> String -> m Val
 lookup ctx nm = go ctx.types
@@ -232,3 +249,4 @@ lookup ctx nm = go ctx.types
     go [] = throwError "Name \{nm} not in scope"
     go ((n, ty) :: xs) = if n == nm then pure ty else go xs
 
+

src/Lib/TopContext.idr

@@ -25,7 +25,7 @@ record TopEntry where
 
 export
 Show TopEntry where
-  show (MkEntry name type def) = "\{show name} : \{show type} := \{show def}"
+  show (MkEntry name type def) = "\{name} : \{show type} := \{show def}"
 
 ||| Top level context.
 ||| Most of the reason this is separate is to have a different type
@@ -65,5 +65,10 @@ claim tc name ty = { defs $= (MkEntry name ty Axiom ::) } tc
 
 public export
 addDef : TopContext -> String -> Tm -> Tm -> TopContext
-addDef tc name tm ty = { defs $= (MkEntry name ty (Fn tm) ::) } tc
+addDef tc name tm ty = { defs $= go } tc
+  where
+    go : List TopEntry -> List TopEntry
+    -- FIXME throw if we hit [] or is not an axiom
+    go [] = []
+    go ((MkEntry nm _ _) :: xs) = MkEntry nm ty (Fn tm) :: xs
 

src/Main.idr

@@ -1,6 +1,6 @@
 module Main
 
-import Control.App
+-- import Control.App
 import Data.String
 import Data.Vect
 import Data.List
@@ -23,22 +23,28 @@ import System.File
 
 {-
 
-- [ ] Replace on define
-- [ ] more sugar on lambdas
+Main2.idr has an older App attempt without the code below.
 
-
-Currently working through checking of decl / def
-
-Running check is awkward. I need a monad stack.
-Main2.idr has an older App attempt without the code below. Retrofit.
-
-App isn't compatible with javascript (without a way to short circuit 
-the fork foreign function.)
+App was not compatible with javascript, but I have a remedy for
+that now. 
 
 -}
 
+-- TODO We're shadowing Control.App.Error do we want that?
+
 M : Type -> Type
-M = (StateT TopContext (EitherT String IO))
+M = (StateT TopContext (EitherT Impl.Error IO))
+
+
+dumpContext : TopContext -> M ()
+dumpContext top = do
+    putStrLn "Context:"
+    go top.defs
+    putStrLn "---"
+  where
+    go : List TopEntry -> M ()
+    go [] = pure ()
+    go (x :: xs) = go xs >> putStrLn "    \{show x}"
 
 processDecl : Decl -> M ()
 processDecl (TypeSig nm tm) = do
@@ -53,15 +59,15 @@ processDecl (Def nm raw) = do
   putStrLn "def \{show nm}"
   ctx <- get
   let Just entry = lookup nm ctx
-    | Nothing => printLn "skip def \{nm} without Decl"
+    | Nothing => throwError $ E (0,0) "skip def \{nm} without Decl"
   let (MkEntry name ty Axiom) := entry
     -- FIXME error
-    | _ => printLn "\{nm} already defined"
+    | _ => throwError $ E (0,0) "\{nm} already defined"
   putStrLn "check \{nm} = \{show raw} at \{show $ ty}"
-  let vty = eval empty ty
-  Right tm <- pure $ the (Either String Tm) (check ctx empty raw vty)
-    | Left err => printLn err
-  putStrLn "got \{show tm}"
+  let vty = eval empty CBN ty
+  Right tm <- pure $ the (Either Impl.Error Tm) (check ctx empty raw vty)
+    | Left err => throwError err
+  putStrLn "Ok \{show tm}"
   put (addDef ctx nm tm ty)
   
 processDecl decl = putStrLn "skip \{show decl}"
@@ -69,29 +75,31 @@ processDecl decl = putStrLn "skip \{show decl}"
 processFile : String -> M ()
 processFile fn = do
   putStrLn "*** Process \{fn}"
-  Right src <- readFile $ "eg/" ++ fn
+  Right src <- readFile $ fn
     | Left err => printLn err
   let toks = tokenise src
   let Right res = parse parseMod toks
     | Left y => putStrLn (showError src y)
-  putStrLn $ pretty 80 $ pretty res
+  putStrLn $ render 80 $ pretty res
   printLn "process Decls"
-  traverse_ processDecl res.decls
-  putStrLn "done \{show !get}"
-
+  Right _ <- tryError $ traverse_ processDecl res.decls
+    | Left y => putStrLn (showError src y)
+  
+  dumpContext !get
+  
 main' : M ()
 main' = do
   args <- getArgs
   putStrLn "Args: \{show args}"
-
-  Right files <- listDir "eg"
-    | Left err => printLn err
-  -- TODO use args
+  let (_ :: files) = args
+    | _ => putStrLn "Usage: newt foo.newt"
+  -- Right files <- listDir "eg"
+  --   | Left err => printLn err
   
   traverse_ processFile (filter (".newt" `isSuffixOf`) files)
 
 main : IO ()
 main = do
-  foo <- runEitherT $ runStateT empty $ main'
+  Right _  <- runEitherT $ runStateT empty $ main'
+    | Left (E (c, r) str) => putStrLn "Error: \{show c} \{show r} \{show str}"
   putStrLn "done"
-    

src/Syntax.idr

@@ -136,9 +136,6 @@ Show Raw where
   show RU = "U"
   show (RSrcPos pos tm) = show tm
 
-export
-interface Pretty a where
-  pretty : a -> Doc
 
 export
 Pretty Raw where