diff options
| author | peb <peb@cs.chalmers.se> | 2006-04-04 09:33:22 +0000 |
|---|---|---|
| committer | peb <peb@cs.chalmers.se> | 2006-04-04 09:33:22 +0000 |
| commit | c437f63404dc0a4fdb42cd6eff661b071d3fca1d (patch) | |
| tree | a455ae560107cdf92cc942bd61d124d3fcb67130 /src/GF/Conversion/Prolog.hs | |
| parent | f1000ca8c3c07f851f1f278fc75fdf7caec9848e (diff) | |
adding support for 2nd order functions in SimpleGFC format
Diffstat (limited to 'src/GF/Conversion/Prolog.hs')
| -rw-r--r-- | src/GF/Conversion/Prolog.hs | 15 |
1 files changed, 10 insertions, 5 deletions
diff --git a/src/GF/Conversion/Prolog.hs b/src/GF/Conversion/Prolog.hs index ebad8e587..b930cb476 100644 --- a/src/GF/Conversion/Prolog.hs +++ b/src/GF/Conversion/Prolog.hs @@ -81,8 +81,8 @@ prtSRule lang (Rule (Abs cat cats (Name fun _prof)) (Cnc _ _ mterm)) = (if null lang then "" else prtQ lang ++ " : ") ++ prtFunctor "rule" [plfun, plcat, plcats, plcnc] ++ "." where plfun = prtQ fun - plcat = prtSCat cat - plcats = prtFunctor "c" (map prtSCat cats) + plcat = prtSDecl cat + plcats = prtFunctor "c" (map prtSDecl cats) plcnc = "\n\t" ++ prtSTerm (maybe Empty id mterm) prtSTerm (Arg n c p) = prtFunctor "arg" [prtQ c, prt (n+1), prtSPath p] @@ -101,9 +101,14 @@ prtSTerm (term :! sel) = prtOper "/" (prtSTerm term) (prtSTerm sel) prtSPath (Path path) = prtPList (map (either prtQ prtSTerm) path) -prtSCat (Decl var cat args) = prVar ++ prtFunctor (prtQ cat) (map prtSTTerm args) - where prVar | var == anyVar = "" - | otherwise = "_" ++ prtVar var ++ ":" +prtSDecl (Decl var typ) | var == anyVar = prtSAbsType typ + | otherwise = "_" ++ prtVar var ++ ":" ++ prtSAbsType typ + + +prtSAbsType ([] ::--> typ) = prtSFOType typ +prtSAbsType (args ::--> typ) = prtOper ":->" (prtPList (map prtSFOType args)) (prtSFOType typ) + +prtSFOType (cat ::@ args) = prtFunctor (prtQ cat) (map prtSTTerm args) prtSTTerm (con :@ args) = prtFunctor (prtQ con) (map prtSTTerm args) prtSTTerm (TVar var) = "_" ++ prtVar var |