summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/GF/Command/TreeOperations.hs23
-rw-r--r--src/PGF/Macros.hs6
2 files changed, 26 insertions, 3 deletions
diff --git a/src/GF/Command/TreeOperations.hs b/src/GF/Command/TreeOperations.hs
index 88b962bdc..f05b8dec3 100644
--- a/src/GF/Command/TreeOperations.hs
+++ b/src/GF/Command/TreeOperations.hs
@@ -11,8 +11,10 @@ import GF.Compile.AbsCompute
-- for conversions
import PGF.Data
--import GF.Compile.GrammarToGFCC (mkType,mkExp)
-import GF.Grammar.Grammar
+import qualified GF.Grammar.Grammar as G
+import qualified GF.Grammar.Macros as M
+import Data.List
type TreeOp = [Tree] -> [Tree]
@@ -24,7 +26,7 @@ allTreeOps = [
("compute",("compute by using semantic definitions (def)",
id)),
("smallest",("sort trees from smallest to largest, in number of nodes",
- id)),
+ smallest)),
("typecheck",("type check and solve metavariables; reject if incorrect",
id))
]
@@ -35,7 +37,24 @@ typeCheck pgf t = (t,(True,[]))
compute :: PGF -> Tree -> Tree
compute pgf t = t
+smallest :: [Tree] -> [Tree]
+smallest = sortBy (\t u -> compare (size t) (size u)) where
+ size t = case t of
+ Abs _ b -> size b + 1
+ Fun f ts -> sum (map size ts) + 1
+ _ -> 1
+
+{-
+toTree :: G.Term -> Tree
+toTree t = case M.termForm t of
+ Ok (xx,f,aa) -> Abs xx (Fun f (map toTree aa))
+fromTree :: Tree -> G.Term
+fromTree t = case t of
+ Abs xx b -> M.mkAbs xx (fromTree b)
+ Var x -> M.vr x
+ Fun f ts -> M.mkApp f (map fromTree ts)
+-}
{-
data Tree =
diff --git a/src/PGF/Macros.hs b/src/PGF/Macros.hs
index f579c07dd..b79715f44 100644
--- a/src/PGF/Macros.hs
+++ b/src/PGF/Macros.hs
@@ -34,6 +34,10 @@ lookType :: PGF -> CId -> Type
lookType pgf f =
fst $ lookMap (error $ "lookType " ++ show f) f (funs (abstract pgf))
+lookDef :: PGF -> CId -> Expr
+lookDef pgf f =
+ snd $ lookMap (error $ "lookDef " ++ show f) f (funs (abstract pgf))
+
lookValCat :: PGF -> CId -> CId
lookValCat pgf = valCat . lookType pgf
@@ -137,4 +141,4 @@ combinations t = case t of
aa:uu -> [a:u | a <- aa, u <- combinations uu]
isLiteralCat :: CId -> Bool
-isLiteralCat = (`elem` [mkCId "String", mkCId "Float", mkCId "Int"]) \ No newline at end of file
+isLiteralCat = (`elem` [mkCId "String", mkCId "Float", mkCId "Int"])