GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-23 09:52:55 -06:00
Code Issues Packages Projects Releases Wiki Activity

function application under tables

Browse Source
This commit is contained in:
Krasimir Angelov
2025-03-20 16:06:33 +01:00
parent b0d363c311
commit 81d472235a
1 changed files with 15 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
src/compiler/api/GF/Compile/Compute/Concrete2.hs
View File

@@ -27,7 +27,6 @@ import qualified Data.Map as Map
import Data.Maybe (fromMaybe,fromJust) import Data.Maybe (fromMaybe,fromJust)
import Data.List import Data.List
import Data.Char import Data.Char
import Debug.Trace
type Env = [(Ident,Value)] type Env = [(Ident,Value)]
type Scope = [(Ident,Value)] type Scope = [(Ident,Value)]
@@ -752,7 +751,18 @@ value2termM flat xs (VV vty vs)= do
ty <- value2termM flat xs vty ty <- value2termM flat xs vty
ts <- mapM (value2termM flat xs) vs ts <- mapM (value2termM flat xs) vs
return (V ty ts) return (V ty ts)
value2termM flat xs (VS v1 v2 vs) = do value2termM flat xs (VS v1 v2 vs) =
case v1 of
VT vty env s cs -> do
ty <- value2termM flat xs vty
cs <- forM cs $ \(p,t) -> do
let (_,xs',env') = pattVars (length xs,xs,env) p
g <- globals
t <- value2termM flat xs' (eval g env' s t vs)
return (p,t)
t2 <- value2termM flat xs v2
return (S (T (TTyped ty) cs) t2)
v1 -> do
t1 <- value2termM flat xs v1 t1 <- value2termM flat xs v1
t2 <- value2termM flat xs v2 t2 <- value2termM flat xs v2
foldM (\e1 tnk -> fmap (App e1) (value2termM flat xs tnk)) (S t1 t2) vs foldM (\e1 tnk -> fmap (App e1) (value2termM flat xs tnk)) (S t1 t2) vs