GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-08-19 18:56:21 -06:00
Code Issues Packages Projects Releases Wiki Activity

value2termM now restores implicit arguments

Browse Source
This commit is contained in:
Krasimir Angelov
2026-02-13 15:57:30 +01:00
parent 51896135c4
commit c8f34ff9e2
1 changed files with 16 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/compiler/api/GF/Compile/Compute.hs
+16 -4
View File
@@ -16,7 +16,7 @@ import GF.Infra.Ident
import GF.Infra.CheckM import GF.Infra.CheckM
import GF.Data.Operations(Err(..)) import GF.Data.Operations(Err(..))
import GF.Data.Utilities(maybeAt,splitAt',(<||>),anyM,secondM,bimapM) import GF.Data.Utilities(maybeAt,splitAt',(<||>),anyM,secondM,bimapM)
import GF.Grammar.Lookup(lookupAbsDef,lookupResDef,lookupOrigInfo) import GF.Grammar.Lookup
import GF.Grammar.Grammar import GF.Grammar.Grammar
import GF.Grammar.Macros import GF.Grammar.Macros
import GF.Grammar.Predef import GF.Grammar.Predef
@@ -827,11 +827,11 @@ setMeta i ms = EvalM (\g k (State input choices metas opts) r msgs ->
value2termM :: Bool -> [Ident] -> Value -> EvalM Term value2termM :: Bool -> [Ident] -> Value -> EvalM Term
value2termM flat xs (VApp q vs) = value2termM flat xs (VApp q vs) =
foldM (\t v -> fmap (App t) (value2termM flat xs v)) (QC q) vs vapp2termM flat xs q (QC q) vs
value2termM flat xs (VPAP _ q vs) = value2termM flat xs (VPAP _ q vs) =
foldM (\t v -> fmap (App t) (value2termM flat xs v)) (Q q) vs vapp2termM flat xs q (Q q) vs
value2termM flat xs (VConst q vs) = value2termM flat xs (VConst q vs) =
foldM (\t v -> fmap (App t) (value2termM flat xs v)) (Q q) vs vapp2termM flat xs q (Q q) vs
value2termM flat xs (VMeta i vs) = do value2termM flat xs (VMeta i vs) = do
mv <- getMeta i mv <- getMeta i
case mv of case mv of
@@ -1061,6 +1061,18 @@ value2termM flat xs (VError msg) = evalError msg
value2termM flat xs (VInts n _) = return (App (Q (cPredef,cInts)) (EInt n)) value2termM flat xs (VInts n _) = return (App (Q (cPredef,cInts)) (EInt n))
value2termM flat xs v = evalError ("value2termM" <+> ppValue Unqualified 5 v) value2termM flat xs v = evalError ("value2termM" <+> ppValue Unqualified 5 v)
vapp2termM flat xs q t vs = do
g@(Gl gr _ isAbstract) <- globals
case (if isAbstract then fmap snd (lookupAbsType gr q) else lookupResType gr q) of
Bad msg -> evalError (pp msg)
Ok ty -> do (t,_) <- foldM app (t,ty) vs
return t
where
app (t,Prod bt _ _ ty) v = do
arg <- value2termM flat xs v
case bt of
Explicit -> return (App t arg,ty)
Implicit -> return (App t (ImplArg arg),ty)
pattVars st (PP _ ps) = foldl pattVars st ps pattVars st (PP _ ps) = foldl pattVars st ps
pattVars st (PV x) = case st of pattVars st (PV x) = case st of