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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
package hm
import (
"fmt"
"log"
"strings"
"github.com/pkg/errors"
)
const digits = "0123456789"
type TyperExpression interface {
Expression
Typer
}
type λ struct {
name string
body Expression
}
func (n λ) Name() string { return n.name }
func (n λ) Body() Expression { return n.body }
func (n λ) IsLambda() bool { return true }
type lit string
func (n lit) Name() string { return string(n) }
func (n lit) Body() Expression { return n }
func (n lit) Type() Type {
switch {
case strings.ContainsAny(digits, string(n)) && strings.ContainsAny(digits, string(n[0])):
return Float
case string(n) == "true" || string(n) == "false":
return Bool
default:
return nil
}
}
func (n lit) IsLit() bool { return true }
func (n lit) IsLambda() bool { return true }
type app struct {
f Expression
arg Expression
}
func (n app) Fn() Expression { return n.f }
func (n app) Body() Expression { return n.arg }
func (n app) Arg() Expression { return n.arg }
type let struct {
name string
def Expression
in Expression
}
func (n let) Name() string { return n.name }
func (n let) Def() Expression { return n.def }
func (n let) Body() Expression { return n.in }
type letrec struct {
name string
def Expression
in Expression
}
func (n letrec) Name() string { return n.name }
func (n letrec) Def() Expression { return n.def }
func (n letrec) Body() Expression { return n.in }
func (n letrec) Children() []Expression { return []Expression{n.def, n.in} }
func (n letrec) IsRecursive() bool { return true }
type prim byte
const (
Float prim = iota
Bool
)
// implement Type
func (t prim) Name() string { return t.String() }
func (t prim) Apply(Subs) Substitutable { return t }
func (t prim) FreeTypeVar() TypeVarSet { return nil }
func (t prim) Normalize(TypeVarSet, TypeVarSet) (Type, error) { return t, nil }
func (t prim) Types() Types { return nil }
func (t prim) Eq(other Type) bool {
if ot, ok := other.(prim); ok {
return ot == t
}
return false
}
func (t prim) Format(s fmt.State, c rune) { fmt.Fprintf(s, t.String()) }
func (t prim) String() string {
switch t {
case Float:
return "Float"
case Bool:
return "Bool"
}
return "HELP"
}
//Phillip Greenspun's tenth law says:
// "Any sufficiently complicated C or Fortran program contains an ad hoc, informally-specified, bug-ridden, slow implementation of half of Common Lisp."
//
// So let's implement a half-arsed lisp (Or rather, an AST that can optionally be executed upon if you write the correct interpreter)!
func Example_greenspun() {
// haskell envy in a greenspun's tenth law example function!
//
// We'll assume the following is the "input" code
// let fac n = if n == 0 then 1 else n * fac (n - 1) in fac 5
// and what we have is the AST
fac := letrec{
"fac",
λ{
"n",
app{
app{
app{
lit("if"),
app{
lit("isZero"),
lit("n"),
},
},
lit("1"),
},
app{
app{lit("mul"), lit("n")},
app{lit("fac"), app{lit("--"), lit("n")}},
},
},
},
app{lit("fac"), lit("5")},
}
// but first, let's start with something simple:
// let x = 3 in x+5
simple := let{
"x",
lit("3"),
app{
app{
lit("+"),
lit("5"),
},
lit("x"),
},
}
env := SimpleEnv{
"--": &Scheme{tvs: TypeVarSet{'a'}, t: NewFnType(TypeVariable('a'), TypeVariable('a'))},
"if": &Scheme{tvs: TypeVarSet{'a'}, t: NewFnType(Bool, TypeVariable('a'), TypeVariable('a'), TypeVariable('a'))},
"isZero": &Scheme{t: NewFnType(Float, Bool)},
"mul": &Scheme{t: NewFnType(Float, Float, Float)},
"+": &Scheme{tvs: TypeVarSet{'a'}, t: NewFnType(TypeVariable('a'), TypeVariable('a'), TypeVariable('a'))},
}
var scheme *Scheme
var err error
scheme, err = Infer(env, simple)
if err != nil {
log.Printf("%+v", errors.Cause(err))
}
simpleType, ok := scheme.Type()
fmt.Printf("simple Type: %v | isMonoType: %v | err: %v\n", simpleType, ok, err)
scheme, err = Infer(env, fac)
if err != nil {
log.Printf("%+v", errors.Cause(err))
}
facType, ok := scheme.Type()
fmt.Printf("fac Type: %v | isMonoType: %v | err: %v", facType, ok, err)
// Output:
// simple Type: Float | isMonoType: true | err: <nil>
// fac Type: Float | isMonoType: true | err: <nil>
}
|
