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

predef types in gfcc

Browse Source
This commit is contained in:
aarne
2006-09-17 14:57:46 +00:00
parent 35f81967ea
commit 1242b8cc91
2 changed files with 7 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/GF/Canon/CanonToGFCC.hs
View File

@@ -177,7 +177,9 @@ paramValues cgr = (labels,untyps,typs) where
jments = [(m,j) | (m,mo) <- M.allModMod cgr, j <- tree2list $ M.jments mo] jments = [(m,j) | (m,mo) <- M.allModMod cgr, j <- tree2list $ M.jments mo]
typs = Map.fromList [(ci,Map.fromList (zip vs [0..])) | (ci,vs) <- params] typs = Map.fromList [(ci,Map.fromList (zip vs [0..])) | (ci,vs) <- params]
untyps = Map.fromList $ concatMap Map.toList [typ | (_,typ) <- Map.toList typs] untyps = Map.fromList $ concatMap Map.toList [typ | (_,typ) <- Map.toList typs]
lincats = [(cat,ls) | (_,(cat,CncCat (RecType ls) _ _)) <- jments] lincats =
[(IC cat,[Lbg (L (IC "s")) TStr]) | cat <- ["Int", "Float", "String"]] ++
[(cat,ls) | (_,(cat,CncCat (RecType ls) _ _)) <- jments]
labels = Map.fromList $ concat labels = Map.fromList $ concat
[((cat,[lab]),(typ,i)): [((cat,[lab]),(typ,i)):
[((cat,[lab2,lab]),(ty,j)) | [((cat,[lab2,lab]),(ty,j)) |

5
src/GF/Canon/GFCC/GenGFCC.hs
View File

@@ -39,13 +39,16 @@ generateRandom gen gfcc cat = genTrees (randomRs (0.0, 1.0) gen) cat where
(genTrees ds2 cat) -- else (drop k ds) (genTrees ds2 cat) -- else (drop k ds)
genTree rs = gett rs where genTree rs = gett rs where
gett ds (CId "String") = (Tr (AS "foo") [], 1)
gett ds (CId "Int") = (Tr (AI 12345) [], 1)
gett ds cat = case fns cat of gett ds cat = case fns cat of
fs -> let fs -> let
d:ds2 = ds d:ds2 = ds
(f,args) = getf d fs (f,args) = getf d fs
(ts,k) = getts ds2 args (ts,k) = getts ds2 args
in (Tr (AC f) ts, k+1) in (Tr (AC f) ts, k+1)
getf d fs = fs !! floor (d * fromIntegral (length fs)) getf d fs = let lg = (length fs) in
fs !! (floor (d * fromIntegral lg))
getts ds cats = case cats of getts ds cats = case cats of
c:cs -> let c:cs -> let
(t, k) = gett ds c (t, k) = gett ds c