summaryrefslogtreecommitdiff
path: root/Library/Generator.hs
blob: ef9dfe20a018bfdedb36dac56df6bb29ddf12ad3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
module Library.Generator (
    listGen,
    substitutionGen,
    termGen,
    varGen,
    typeGen,
    typeOpGen,
    constGen,
    nameGen
    ) where


import Data.List
import Library.Term
import Library.TypeVar



listGen :: (a -> [String]) -> [a] -> [String]
listGen f list =
    concat (map f list) ++ ["nil"] ++ replicate (length list) "cons"



substitutionGen :: Substitution -> [String]
substitutionGen sub =
    let varTermList = listGen varTermPair (snd sub)
        nameTypeList = listGen nameTypePair (fst sub)
    in nameTypeList ++ varTermList ++ ["nil", "cons", "cons"]



varTermPair :: (Var, Term) -> [String]
varTermPair (var, term) =
    (varGen var) ++ (termGen term) ++ ["nil", "cons", "cons"]



nameTypePair :: (Name, Type) -> [String]
nameTypePair (name, ty) =
    (nameGen name) ++ (typeGen ty) ++ ["nil", "cons", "cons"]



termGen :: Term -> [String]
termGen (TVar v) = (varGen v) ++ ["varTerm"]
termGen (TConst c ty) = (constGen c) ++ (typeGen ty) ++ ["constTerm"]
termGen (TApp h x) = (termGen h) ++ (termGen x) ++ ["appTerm"]
termGen (TAbs x t) = (termGen x) ++ (termGen t) ++ ["absTerm"]



varGen :: Var -> [String]
varGen var =
    (nameGen . varName $ var) ++ (typeGen . varTy $ var) ++ ["var"]



typeGen :: Type -> [String]
typeGen (TypeVar v) = (nameGen v) ++ ["varType"]
typeGen (AType ty op) = 
    let list = listGen typeGen ty
    in (typeOpGen op) ++ list ++ ["opType"]



typeOpGen :: TypeOp -> [String]
typeOpGen op = 
    (nameGen . tyOp $ op) ++ ["typeOp"]



constGen :: Const -> [String]
constGen c =
    (nameGen . constName $ c) ++ ["const"]



nameGen :: Name -> [String]
nameGen name =
    ["\"" ++ intercalate "." (nameSpace name ++ [nameId name]) ++ "\""]