msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

an FFI for GF

Browse Source
This commit is contained in:
Krasimir Angelov
2024-01-23 17:33:39 +01:00
parent c72fb9b958
commit 021e271f29
8 changed files with 99 additions and 83 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
src/compiler/api/GF/Compile/GrammarToCanonical.hs
View File

@@ -19,7 +19,7 @@ import GF.Infra.Ident(ModuleName(..),Ident,identW,ident2raw,rawIdentS,showIdent)
import GF.Infra.Option(Options,optionsPGF)
import GF.Infra.CheckM
import PGF2(Literal(..))
import GF.Compile.Compute.Concrete(normalForm)
import GF.Compile.Compute.Concrete(normalForm,Globals(..),stdPredef)
import GF.Grammar.Canonical as C
import System.FilePath ((</>), (<.>))
import qualified Debug.Trace as T
@@ -93,13 +93,13 @@ concrete2canonical gr absname cnc modinfo = do
toCanonical gr absname (name,jment) =
case jment of
CncCat (Just (L loc typ)) _ _ pprn _ -> do
ntyp <- normalForm gr typ
ntyp <- normalForm (Gl gr stdPredef) typ
let pts = paramTypes gr ntyp
return [(pts,Left (LincatDef (gId name) (convType ntyp)))]
CncFun (Just r@(_,cat,ctx,lincat)) (Just (L loc def)) pprn _ -> do
let params = [(b,x)|(b,x,_)<-ctx]
args = map snd params
e0 <- normalForm gr (mkAbs params (mkApp def (map Vr args)))
e0 <- normalForm (Gl gr stdPredef) (mkAbs params (mkApp def (map Vr args)))
let e = cleanupRecordFields lincat (unAbs (length params) e0)
tts = tableTypes gr [e]
return [(tts,Right (LinDef (gId name) (map gId args) (convert gr e)))]