dunhamsteve.bsky.social
Newt - a dependent typed programming language
derive Show and Eq, improvements to LSP
+281
-39
+11
-5
newt-vscode-lsp/src/lsp.ts
+11
-5
newt-vscode-lsp/src/lsp.ts
···
16
16
InitializeResult,
17
17
TextDocumentSyncKind,
18
18
Location,
19
+
TextDocumentIdentifier,
19
20
} from "vscode-languageserver/node";
20
21
import { TextDocument } from "vscode-languageserver-textdocument";
21
22
···
24
25
25
26
// the last is the most important to the user, but we run FIFO
26
27
// to ensure dependencies are seen in causal order
27
-
let changes: TextDocument[] = []
28
+
let changes: (TextDocument|TextDocumentIdentifier)[] = []
28
29
let running = false
29
30
let lastChange = 0
30
-
function addChange(doc: TextDocument) {
31
+
function addChange(doc: TextDocument | TextDocumentIdentifier) {
31
32
console.log('enqueue', doc.uri)
32
33
// drop stale pending changes
33
34
let before = changes.length
···
94
95
console.log('HOVER', uri, pos)
95
96
let res = LSP_hoverInfo(uri, pos.line, pos.character)
96
97
if (!res) return null
97
-
console.log('HOVER is ', res)
98
-
return { contents: { kind: "plaintext", value: res.info } };
98
+
if (res == true) {
99
+
addChange(params.textDocument)
100
+
return null
101
+
} else {
102
+
console.log('HOVER is ', res)
103
+
return { contents: { kind: "plaintext", value: res.info } };
104
+
}
99
105
});
100
106
101
107
connection.onDefinition((params): Location | null => {
102
108
const uri = params.textDocument.uri;
103
109
const pos = params.position;
104
110
let value = LSP_hoverInfo(uri, pos.line, pos.character)
105
-
if (!value) return null;
111
+
if (!value || value == true) return null;
106
112
return value.location
107
113
})
108
114
+1
-1
newt-vscode-lsp/src/newt.d.ts
+1
-1
newt-vscode-lsp/src/newt.d.ts
···
6
6
info: string
7
7
location: Location
8
8
}
9
-
export function LSP_hoverInfo(name: string, row: number, col: number): HoverResult|null;
9
+
export function LSP_hoverInfo(name: string, row: number, col: number): HoverResult|boolean|null;
10
10
export function LSP_codeActionInfo(name: string, row: number, col: number): CodeAction[]|null;
+1
-1
newt-vscode-lsp/syntaxes/newt.tmLanguage.json
+1
-1
newt-vscode-lsp/syntaxes/newt.tmLanguage.json
···
20
20
},
21
21
{
22
22
"name": "keyword.newt",
23
-
"match": "\\b(λ|=>|<-|->|→|:=|\\$|data|record|constructor|where|do|class|uses|instance|case|of|let|if|then|else|forall|∀|in|U|module|import|ptype|pfunc|infix|infixl|infixr)\\b"
23
+
"match": "\\b(λ|=>|<-|->|→|:=|\\$|data|record|constructor|where|do|derive|class|uses|instance|case|of|let|if|then|else|forall|∀|in|U|module|import|ptype|pfunc|infix|infixl|infixr)\\b"
24
24
},
25
25
{
26
26
"name": "string.js",
+1
playground/src/cmeditor.ts
+1
playground/src/cmeditor.ts
+20
-15
src/Commands.newt
+20
-15
src/Commands.newt
···
35
35
-- TODO processing on hover is expensive, but info is not always there
36
36
-- I suspect this picks up the case where a file has been invalidated by a change to
37
37
-- another file and we switch editors. Handle that (enqueue a check) and switch this back.
38
+
-- this is also broken, because diagnostics don't get updated..
38
39
top <- getTop
39
-
mod <- processModule emptyFC repo Nil modns
40
-
-- let (Just mod) = lookupMap' modns top.modules | Nothing => pure Nothing
40
+
-- mod <- processModule emptyFC repo Nil modns
41
+
let (Just mod) = lookupMap' modns top.modules | Nothing => pure Nothing
41
42
modifyTop [ currentMod := mod; ops := mod.modOps ]
42
43
pure $ Just mod
43
44
45
+
data HoverInfo = NoHoverInfo | NeedCheck | HasHover FC String
46
+
44
47
-- The cheap version of type at point, find the token, lookup in global context
45
48
-- Later we will either get good FC for entries or scan them all and build a cache.
46
-
getHoverInfo : FileSource → String → Int → Int → M (Maybe (String × FC))
49
+
getHoverInfo : FileSource → String → Int → Int → M HoverInfo
47
50
getHoverInfo repo modns row col = do
48
-
Just mod <- switchModule repo modns | _ => pure Nothing
51
+
Just mod <- switchModule repo modns | _ => pure NeedCheck
49
52
top <- getTop
50
53
51
54
-- Find the token at the point
52
55
let lines = split mod.modSource "\n"
53
56
let line = fromMaybe "" (getAt' row lines)
54
-
let (Right toks) = tokenise "" line | Left _ => pure Nothing
55
-
let (Just name) = getTok toks | _ => pure Nothing
57
+
let (Right toks) = tokenise "" line | Left _ => pure NoHoverInfo
58
+
let (Just name) = getTok toks | _ => pure NoHoverInfo
56
59
57
60
let (Left _) = partialParse "" parseImport emptyMap toks
58
61
| Right ((MkImport _ (fc, nm)), _, _) => do
59
62
let (baseDir, _) = splitFileName fc.file
60
-
let fc = MkFC (repo.baseDir ++ "/" ++ joinBy "/" (split nm ".")) (MkBounds 0 0 0 0)
61
-
pure $ Just ("module \{nm}", fc)
62
-
63
+
let fc = MkFC ("\{repo.baseDir}/\{joinBy "/" (split nm ".")}.newt") (MkBounds 0 0 0 0)
64
+
pure $ HasHover fc "module \{nm}"
65
+
putStrLn "Hover name is \{show name}"
63
66
-- Lookup the name
64
-
let (Just e) = lookupRaw name top | _ => pure Nothing
67
+
let (Just e) = lookupRaw name top | _ => pure NoHoverInfo
65
68
ty <- nf Nil e.type
66
-
pure $ Just ("\{show e.name} : \{rpprint Nil ty}", e.fc)
69
+
pure $ HasHover e.fc ("\{show e.name} : \{rpprint Nil ty}")
67
70
68
71
where
69
72
getTok : List BTok → Maybe String
···
140
143
let phead = pack head
141
144
let indent = getIndent 0 head
142
145
let nextrow = scan indent lines (sr + 1)
143
-
146
+
-- FIXME - doesn't handle `let`, but that's a little messy
147
+
-- need to remove let and add `|`, but also indent.
148
+
-- Existing `|` would have their own indent, indent of let matters. etc.
144
149
-- No init or first :: rest for add missing case
145
150
let (edits, rest) = doFirst inPlace cons
146
151
···
193
198
pure $ Just $ CaseSplitAction edits
194
199
195
200
posInFC : Int → Int → FC → Bool
196
-
-- FIXME ec + 1 again...
197
-
posInFC row col (MkFC _ (MkBounds sr sc er ec)) = (sr <= row && row <= er) && (sc <= col && col <= ec + 1)
201
+
posInFC row col (MkFC _ (MkBounds 0 0 0 0)) = False
202
+
posInFC row col (MkFC _ (MkBounds sr sc er ec)) = (sr <= row && row <= er) && (sc <= col && col <= ec)
198
203
199
204
getHole : ModContext → Int → Int → Maybe MetaEntry
200
205
getHole mod row col =
···
243
248
244
249
errorActions : Int → Int → Error → M (List CodeAction)
245
250
errorActions row col err = do
246
-
let (ENotFound fc nm) = err | _ => pure Nil
251
+
let (ENotInScope fc nm) = err | _ => pure Nil
247
252
let (True) = posInFC row col fc | _ => pure Nil
248
253
top <- getTop
249
254
let mods = map (\e => e.name.qns) $ lookupAll nm top
+7
-3
src/LSP.newt
+7
-3
src/LSP.newt
···
94
94
st <- readIORef state
95
95
repo <- lspFileSource
96
96
-- We're proactively running check if there is no module information, make sure we save it
97
-
Right (top, Just (msg, fc)) <- (getHoverInfo repo modns line col).runM st.topContext
98
-
| Right (top, _) => do
97
+
Right (top, HasHover fc msg) <- (getHoverInfo repo modns line col).runM st.topContext
98
+
| Right (top, NeedCheck) => do
99
+
modifyIORef state $ [ topContext := top ]
100
+
putStrLn $ "NeedsCheck"
101
+
pure $ js_castBool True
102
+
| Right (top, NoHoverInfo) => do
99
103
modifyIORef state $ [ topContext := top ]
100
104
putStrLn $ "Nothing to see here"
101
-
pure $ jsonToJObject JsonNull
105
+
pure $ js_castBool True
102
106
| Left err => do
103
107
putStrLn $ showError "" err
104
108
pure $ jsonToJObject JsonNull
+151
src/Lib/Derive.newt
+151
src/Lib/Derive.newt
···
1
+
module Lib.Derive
2
+
3
+
import Prelude
4
+
import Lib.Common
5
+
import Lib.Types
6
+
import Lib.Syntax
7
+
import Lib.TopContext
8
+
import Lib.Error
9
+
import Lib.Elab -- (lookupDCon)
10
+
import Lib.Prettier
11
+
12
+
-- describe type
13
+
14
+
data Desc : U
15
+
16
+
data DConst : U where
17
+
MkConst : (name : String) → List (String × Desc) → DConst
18
+
19
+
20
+
data Desc : U where
21
+
DInd : List DConst → Desc
22
+
23
+
-- So I guess we do a few of these and then figure out how to make it easier
24
+
25
+
deriveEq : FC → String → M (List Decl)
26
+
deriveEq fc name = do
27
+
top <- getTop
28
+
let (Just (MkEntry fc qname type (TCon _ names) eflags)) = lookupRaw name top
29
+
| Just _ => throwError $ E fc "\{name} is not a type constructor"
30
+
| _ => throwError $ ENotInScope fc name
31
+
dcons <- traverse lookupDCon names
32
+
clauses <- traverse makeClause dcons
33
+
let fallback = (buildApp "_==_" (rvar "_" :: rvar "_" :: Nil), Just (rvar "False"))
34
+
let eqDecl = FunDef fc "_==_" (snoc clauses fallback)
35
+
let inst = Instance fc (buildApp "Eq" (rvar name :: Nil)) (Just $ eqDecl :: Nil)
36
+
pure $ inst :: Nil
37
+
38
+
where
39
+
arr : Raw → Raw → Raw
40
+
arr a b = RPi emptyFC (BI fc "_" Explicit Many) a b
41
+
42
+
rvar : String → Raw
43
+
rvar nm = RVar emptyFC nm
44
+
45
+
getExplictNames : SnocList String → Tm → List String
46
+
getExplictNames acc (Pi fc nm Explicit quant a b) = getExplictNames (acc :< nm) b
47
+
getExplictNames acc (Pi fc nm Implicit quant a b) = getExplictNames acc b
48
+
getExplictNames acc (Pi fc nm Auto quant a b) = getExplictNames acc b
49
+
getExplictNames acc _ = acc <>> Nil
50
+
51
+
buildApp : String → List Raw → Raw
52
+
buildApp nm nms = foldl (\ t u => RApp emptyFC t u Explicit) (rvar nm) $ nms
53
+
54
+
equate : (Raw × Raw) → Raw
55
+
equate (a,b) = buildApp "_==_" (a :: b :: Nil)
56
+
57
+
makeClause : (QName × Int × Tm) → M (Raw × Maybe Raw)
58
+
makeClause ((QN ns nm), _, ty) = do
59
+
-- We're only looking at explicit args for now.
60
+
-- TODO check quantity
61
+
let names = getExplictNames Lin ty
62
+
anames <- map rvar <$> traverse freshName names
63
+
bnames <- map rvar <$> traverse freshName names
64
+
let a = buildApp nm anames
65
+
let b = buildApp nm bnames
66
+
67
+
let left = equate (a,b)
68
+
let right = case map equate $ zip anames bnames of
69
+
Nil => rvar "True"
70
+
(hd :: tl) => foldr (\a b => buildApp "_&&_" (a :: b :: Nil)) hd tl
71
+
72
+
pure (left, Just right)
73
+
74
+
75
+
-- This is a little more of a pain, we'll generate a number for each constructor
76
+
-- and use that as the fallback. Eventually we'll want something like quasi-quote
77
+
deriveShow : FC → String → M (List Decl)
78
+
deriveShow fc name = do
79
+
top <- getTop
80
+
let (Just (MkEntry fc qname type (TCon _ names) eflags)) = lookupRaw name top
81
+
| Just _ => throwError $ E fc "\{name} is not a type constructor"
82
+
| _ => throwError $ ENotInScope fc name
83
+
dcons <- traverse lookupDCon names
84
+
clauses <- traverse makeClause dcons
85
+
86
+
let eqDecl = FunDef fc "show" clauses
87
+
let inst = Instance fc (buildApp "Show" (rvar name :: Nil)) (Just $ eqDecl :: Nil)
88
+
pure $ inst :: Nil
89
+
90
+
where
91
+
arr : Raw → Raw → Raw
92
+
arr a b = RPi emptyFC (BI fc "_" Explicit Many) a b
93
+
94
+
rvar : String → Raw
95
+
rvar nm = RVar emptyFC nm
96
+
97
+
lstring : String → Raw
98
+
lstring s = RLit emptyFC (LString s)
99
+
100
+
getExplictNames : SnocList String → Tm → List String
101
+
getExplictNames acc (Pi fc nm Explicit quant a b) = getExplictNames (acc :< nm) b
102
+
getExplictNames acc (Pi fc nm Implicit quant a b) = getExplictNames acc b
103
+
getExplictNames acc (Pi fc nm Auto quant a b) = getExplictNames acc b
104
+
getExplictNames acc _ = acc <>> Nil
105
+
106
+
buildApp : String → List Raw → Raw
107
+
buildApp nm nms = foldl (\ t u => RApp emptyFC t u Explicit) (rvar nm) $ nms
108
+
109
+
equate : (Raw × Raw) → Raw
110
+
equate (a,b) = buildApp "_==_" (a :: b :: Nil)
111
+
112
+
makeList : List Raw → Raw
113
+
makeList Nil = rvar "Nil"
114
+
makeList (x :: xs) = buildApp "_::_" (x :: makeList xs :: Nil)
115
+
116
+
makeClause : (QName × Int × Tm) → M (Raw × Maybe Raw)
117
+
makeClause ((QN ns nm), _, ty) = do
118
+
let names = getExplictNames Lin ty
119
+
anames <- map rvar <$> traverse freshName names
120
+
let left = buildApp "show" $ buildApp nm anames :: Nil
121
+
let shows = map (\ nm => RApp emptyFC (rvar "show") nm Explicit) anames
122
+
let right = case anames of
123
+
Nil => lstring nm
124
+
_ =>
125
+
let parts = makeList $ lstring ("(" ++ nm) :: shows in
126
+
buildApp "_++_" $ buildApp "joinBy" (lstring " " :: parts :: Nil) :: lstring ")" :: Nil
127
+
128
+
pure (left, Just right)
129
+
130
+
131
+
132
+
-- -- A description would be nice.
133
+
-- deriveShow : FC → QName → M Raw
134
+
-- deriveShow fc qn = do
135
+
-- top <- getTop
136
+
-- case lookup qn top : Maybe TopEntry of
137
+
-- Nothing => error {Raw} fc "Can't find \{show qn} in derive Show"
138
+
-- -- I want case split too... I need to tie the editor into the repl.
139
+
-- (Just (MkEntry fc name type (TCon _ conNames) eflags) ) => ?
140
+
-- (Just (MkEntry fc name type (Axiom) eflags) ) => ?
141
+
-- (Just (MkEntry fc name type (DCon _ _ _ _) eflags) ) => ?
142
+
-- (Just (MkEntry fc name type (Fn _) eflags) ) => ?
143
+
-- (Just (MkEntry fc name type (PrimTCon _) eflags) ) => ?
144
+
-- (Just (MkEntry fc name type (PrimFn _ _ _) eflags) ) => ?
145
+
-- (Just (MkEntry fc name type (PrimOp _) eflags) ) => ?
146
+
147
+
-- error fc "TODO"
148
+
149
+
150
+
-- HasFC as example of user-defined derivation (when we get to that)
151
+
-- SetFC would be nice, too.
+4
-2
src/Lib/Elab.newt
+4
-2
src/Lib/Elab.newt
···
1544
1544
debug $ \ _ => "lookup \{show name} as \{show def}"
1545
1545
vty <- eval Nil ty
1546
1546
pure (Ref fc name, vty)
1547
-
-- Can we soften this without introducing a meta?
1548
-
Nothing => throwError $ ENotFound fc nm
1547
+
-- Can we soften this without introducing a meta for the type
1548
+
-- it might be additional errors, but also could lead to narrowing of possible names...
1549
+
-- especially when we hit this for .foo
1550
+
Nothing => throwError $ ENotInScope fc nm
1549
1551
go i ((x, ty) :: xs) = if x == nm then pure (Bnd fc i, ty)
1550
1552
else go (i + 1) xs
1551
1553
+3
-3
src/Lib/Error.newt
+3
-3
src/Lib/Error.newt
···
7
7
-- and a pretty printer in the monad
8
8
data Error
9
9
= E FC String
10
-
| ENotFound FC String
10
+
| ENotInScope FC String
11
11
| Postpone FC QName String
12
12
13
13
14
14
instance HasFC Error where
15
15
getFC (E x str) = x
16
-
getFC (ENotFound x _) = x
16
+
getFC (ENotInScope x _) = x
17
17
getFC (Postpone x k str) = x
18
18
19
19
errorMsg : Error -> String
20
20
errorMsg (E x str) = str
21
-
errorMsg (ENotFound x nm) = "\{nm} not in scope"
21
+
errorMsg (ENotInScope x nm) = "\{nm} not in scope"
22
22
errorMsg (Postpone x k str) = str
23
23
24
24
showError : (src : String) -> Error -> String
+13
-2
src/Lib/Parser.newt
+13
-2
src/Lib/Parser.newt
···
538
538
-- TODO revisit when we have parser for qualified names in source
539
539
(nameFC, ident) <- withFC uident
540
540
(restFC,rest) <- withFC $ many $ token Projection
541
+
let nameFC = case rest of
542
+
Nil => nameFC
543
+
(_ :: _) => nameFC + restFC
541
544
let name = joinBy "" (ident :: rest)
542
-
pure $ MkImport fc (nameFC + restFC, name)
545
+
pure $ MkImport fc (nameFC, name)
543
546
544
547
-- Do we do pattern stuff now? or just name = lambda?
545
548
-- TODO multiple names
···
679
682
names <- many $ withFC ident
680
683
pure $ Exports loc names
681
684
685
+
parseDerive : Parser Decl
686
+
parseDerive = do
687
+
loc <- getPos
688
+
keyword "derive"
689
+
className <- withFC uident
690
+
name <- withFC uident
691
+
pure $ DDerive loc className name
692
+
682
693
parseDecl : Parser Decl
683
694
parseDecl = parseMixfix <|> parsePType <|> parsePFunc
684
695
<|> parseNorm <|> parseData <|> parseShortData
685
696
<|> parseClass <|> parseInstance <|> parseRecord
686
-
<|> parseExport
697
+
<|> parseExport <|> parseDerive
687
698
-- We'll put the backtracing stuff last, but there is a commit issue in parseDef
688
699
<|> parseSig <|> parseDef
689
700
+13
src/Lib/ProcessDecl.newt
+13
src/Lib/ProcessDecl.newt
···
16
16
import Lib.Types
17
17
import Lib.Util
18
18
import Lib.Erasure
19
+
import Lib.Derive
19
20
20
21
dumpEnv : Context -> M String
21
22
dumpEnv ctx =
···
529
530
let deps = ((name, RApp fc (RVar fc pname) (RVar fc "$self") Explicit) :: deps)
530
531
processFields autoPat tail deps rest
531
532
533
+
processDerive : String → FC → FC × String → (FC × String) → M Unit
534
+
processDerive ns fc (clFC, clName) (fc, name) = do
535
+
case clName of
536
+
"Eq" => do
537
+
decls <- deriveEq fc name
538
+
for_ decls $ processDecl ns
539
+
"Show" => do
540
+
decls <- deriveShow fc name
541
+
for_ decls $ processDecl ns
542
+
_ => error fc "derive \{clName} is not supported"
543
+
532
544
processExports : String → FC → List (FC × String) → M Unit
533
545
processExports ns fc names = do
534
546
top <- getTop
···
542
554
-- currently mixfix registration is handled in the parser
543
555
-- since we now run a decl at a time we could do it here.
544
556
processDecl ns (PMixFix _ _ _ _) = pure MkUnit
557
+
processDecl ns (DDerive fc tclass name) = processDerive ns fc tclass name
545
558
processDecl ns (TypeSig fc names tm) = processTypeSig ns fc names tm
546
559
processDecl ns (PType fc nm ty) = processPrimType ns fc nm ty
547
560
processDecl ns (PFunc fc nm used ty src) = processPrimFn ns fc nm used ty src
+6
-2
src/Lib/Syntax.newt
+6
-2
src/Lib/Syntax.newt
···
88
88
= TypeSig FC (List Name) Raw
89
89
| FunDef FC Name (List (Raw × Maybe Raw))
90
90
| DCheck FC Raw Raw
91
+
| DDerive FC (FC × String) (FC × String)
91
92
-- TODO maybe add Telescope (before `:`) and auto-add to constructors...
92
93
| Data FC (FC × Name) Raw (Maybe $ List Decl)
93
94
| ShortData FC Raw (List Raw)
···
113
114
getFC (Class x str xs ys) = x
114
115
getFC (Instance x tm xs) = x
115
116
getFC (Record x str tm str1 xs) = x
117
+
getFC (DDerive x _ _) = x
116
118
117
119
118
120
record Module where
···
126
128
127
129
instance Show Raw
128
130
129
-
130
131
instance Show Clause where
131
132
show (MkClause fc cons pats expr) = show (fc, cons, pats, expr)
132
133
···
140
141
141
142
instance Show Decl where
142
143
show (TypeSig _ str x) = foo ("TypeSig" :: show str :: show x :: Nil)
144
+
show (DDerive _ x y) = foo ("DDerive" :: show x :: show y :: Nil)
143
145
show (FunDef _ str clauses) = foo ("FunDef" :: show str :: show clauses :: Nil)
144
146
show (Data _ str xs ys) = foo ("Data" :: show str :: show xs :: show ys :: Nil)
145
147
show (DCheck _ x y) = foo ("DCheck" :: show x :: show y :: Nil)
···
248
250
249
251
instance Pretty Decl where
250
252
pretty (TypeSig _ nm ty) = spread (map text nm) <+> text ":" <+> nest 2 (pretty ty)
253
+
pretty (DDerive _ x y) = text "derive" <+> text (snd x) <+> text (snd y)
251
254
pretty (FunDef _ nm clauses) = stack $ map prettyPair clauses
252
255
where
253
256
prettyPair : Raw × Maybe Raw → Doc
···
264
267
<+> (nest 2 $ text "where" </> stack (maybe empty (\ nm' => text "constructor" <+> text (snd nm')) cname :: map pretty decls))
265
268
pretty (Class _ (_,nm) tele decls) = text "class" <+> text nm <+> text ":" <+> spread (map prettyBind tele)
266
269
<+> (nest 2 $ text "where" </> stack (map pretty decls))
267
-
pretty (Instance _ _ _) = text "TODO pretty Instance"
270
+
pretty (Instance fc top Nothing) = text "instance" <+> pretty top
271
+
pretty (Instance fc top (Just decls)) = text "instance" <+> pretty top <+> nest 2 (text "where" </> stack (map pretty decls))
268
272
pretty (ShortData _ lhs sigs) = text "data" <+> pretty lhs <+> text "=" <+> pipeSep (map pretty sigs)
269
273
pretty (Exports _ nms) = text "#export" <+> spread (map (text ∘ show ∘ snd) nms)
270
274
+1
-1
src/Lib/Tokenizer.newt
+1
-1
src/Lib/Tokenizer.newt
···
20
20
keywords : List String
21
21
keywords = ("let" :: "in" :: "where" :: "case" :: "of" :: "data" :: "U" :: "do" ::
22
22
"ptype" :: "pfunc" :: "module" :: "infixl" :: "infixr" :: "infix" ::
23
-
"∀" :: "forall" :: "import" :: "uses" ::
23
+
"∀" :: "forall" :: "import" :: "uses" :: "derive" ::
24
24
"class" :: "instance" :: "record" :: "constructor" ::
25
25
"if" :: "then" :: "else" ::
26
26
-- it would be nice to find a way to unkeyword "." so it could be
+8
-1
src/Lib/TopContext.newt
+8
-1
src/Lib/TopContext.newt
···
46
46
show top = "\nContext:\n [\{ joinBy "\n" $ map (show ∘ snd) $ toList top.currentMod.modDefs}]"
47
47
48
48
emptyTop : TopContext
49
-
emptyTop = MkTop emptyMap emptyMap (emptyModCtx "" "") 0 emptyMap
49
+
emptyTop = MkTop emptyMap emptyMap (emptyModCtx "" "") 0 emptyMap 0
50
50
51
51
setFlag : QName → FC → EFlag → M Unit
52
52
setFlag name fc flag = do
···
94
94
95
95
addInfo : EditorInfo → M Unit
96
96
addInfo info = modifyTop [ currentMod $= [modInfos $= (info ::) ] ]
97
+
98
+
-- temporary? used in derive for now
99
+
freshName : String → M String
100
+
freshName nm = do
101
+
top <- getTop
102
+
modifyTop [ freshIx $= 1 + ]
103
+
pure $ "f$" ++ nm ++ show top.freshIx
+6
-3
src/Lib/Types.newt
+6
-3
src/Lib/Types.newt
···
81
81
Lam : FC -> Name -> Icit -> Quant -> Tm -> Tm
82
82
App : FC -> Tm -> Tm -> Tm
83
83
UU : FC -> Tm
84
-
Pi : FC -> Name -> Icit -> Quant -> Tm -> Tm -> Tm
84
+
Pi : (fc : FC) -> (nm : Name) -> Icit -> Quant -> (a : Tm) -> (b : Tm) -> Tm
85
85
Case : FC -> Tm -> List CaseAlt -> Tm
86
86
-- need type?
87
87
Let : FC -> Name -> Tm -> Tm -> Tm
···
442
442
currentMod : ModContext
443
443
verbose : Int -- command line flag increments this
444
444
ops : Operators
445
+
freshIx : Int
445
446
446
447
-- we'll use this for typechecking, but need to keep a TopContext around too.
447
448
···
594
595
mkCtx : FC -> Context
595
596
mkCtx fc = MkCtx 0 Nil Nil Nil fc
596
597
598
+
-- Used by Syntax and Elab
599
+
597
600
data Pattern
598
601
= PatVar FC Icit Name
599
602
| PatCon FC Icit QName (List Pattern) (Maybe Name)
···
627
630
show (PC nm pat ty) = show (nm,pat,ty)
628
631
629
632
-- Lazy because `let` would do work at the top of a `M a`
630
-
prof : ∀ a. String → Lazy (M a) → M a
631
-
prof desc work = do
633
+
profile : ∀ a. String → Lazy (M a) → M a
634
+
profile desc work = do
632
635
start <- getTime
633
636
res <- force work
634
637
end <- getTime
+14
tests/Derive.newt
+14
tests/Derive.newt
+7
tests/ImportError.newt
+7
tests/ImportError.newt
+2
tests/ImportError.newt.fail
+2
tests/ImportError.newt.fail
+8
tests/UnsafeIO.newt
+8
tests/UnsafeIO.newt
+1
tests/UnsafeIO.newt.golden
+1
tests/UnsafeIO.newt.golden
···
1
+
Hello, World!