GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-01 15:22:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

create lin/lincat can now fetch the definitions from the source grammar

Browse Source
This commit is contained in:
Krasimir Angelov
2024-02-08 15:14:05 +01:00
parent ab30f1f9e5
commit 3b4f12e621
3 changed files with 46 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
src/compiler/api/GF/Command/Parse.hs
View File

@@ -84,28 +84,32 @@ pTransactionCommand = do
return (DropConcrete opts name)
"lin" | elem (take 1 cmd) ["c","a"] -> do
f <- pIdent
skipSpaces
args <- sepBy pIdent skipSpaces
skipSpaces
char '='
skipSpaces
t <- readS_to_P (\s -> case runPartial pTerm s of
Right (s,t) -> [(t,s)]
_ -> [])
return (CreateLin opts f (foldr (Abs Explicit . identS) t args) (take 1 cmd == "a"))
body <- option Nothing $ do
skipSpaces
args <- sepBy pIdent skipSpaces
skipSpaces
char '='
skipSpaces
t <- readS_to_P (\s -> case runPartial pTerm s of
Right (s,t) -> [(t,s)]
_ -> [])
return (Just (foldr (Abs Explicit . identS) t args))
return (CreateLin opts f body (take 1 cmd == "a"))
| take 1 cmd == "d" -> do
f <- pIdent
return (DropLin opts f)
"lincat"
| take 1 cmd == "c" -> do
f <- pIdent
skipSpaces
char '='
skipSpaces
t <- readS_to_P (\s -> case runPartial pTerm s of
Right (s,t) -> [(t,s)]
_ -> [])
return (CreateLincat opts f t)
body <- option Nothing $ do
skipSpaces
char '='
skipSpaces
t <- readS_to_P (\s -> case runPartial pTerm s of
Right (s,t) -> [(t,s)]
_ -> [])
return (Just t)
return (CreateLincat opts f body)
| take 1 cmd == "d" -> do
f <- pIdent
return (DropLincat opts f)