├── README.md ├── gli.go ├── lisp ├── data.go ├── interpreter.go ├── primitives.go └── syntax.go ├── manual.lyx └── prelude.golisp /README.md: -------------------------------------------------------------------------------- 1 | GoLisp -- A dialect of Lisp written in Go 2 | ========================================= 3 | 4 | Hello everyone! Here's a very, very primitive Lisp implementation in Go. 5 | 6 | Compiling GoLisp 7 | ---------------- 8 | 9 | ``` 10 | $ go get github.com/bobappleyard/golisp 11 | $ golisp 12 | ``` 13 | 14 | Gives you a REPL. 15 | -------------------------------------------------------------------------------- /gli.go: -------------------------------------------------------------------------------- 1 | package main 2 | 3 | import ( 4 | "github.com/bobappleyard/golisp/lisp" 5 | "os" 6 | ) 7 | 8 | func main() { 9 | i := lisp.New() 10 | i.Repl(os.Stdin, os.Stdout) 11 | } 12 | -------------------------------------------------------------------------------- /lisp/data.go: -------------------------------------------------------------------------------- 1 | package lisp 2 | 3 | import ( 4 | "bufio" 5 | "errors" 6 | "fmt" 7 | "io" 8 | "unsafe" 9 | ) 10 | 11 | /* 12 | Basic types 13 | */ 14 | 15 | type Symbol string 16 | 17 | func (self Symbol) GoString() string { 18 | return string(self) 19 | } 20 | 21 | type Environment map[Symbol]interface{} 22 | 23 | type Constant struct { 24 | str string 25 | } 26 | 27 | func NewConstant(str string) interface{} { 28 | return &Constant{str} 29 | } 30 | 31 | func (self *Constant) String() string { 32 | return self.GoString() 33 | } 34 | 35 | func (self *Constant) GoString() string { 36 | return self.str 37 | } 38 | 39 | // interface{}thing except the boolean value false counts as true. 40 | func True(x interface{}) bool { 41 | if b, ok := x.(bool); ok { 42 | return b 43 | } 44 | return true 45 | } 46 | 47 | /* 48 | Functions 49 | */ 50 | 51 | type Function interface { 52 | Apply(args interface{}) interface{} 53 | } 54 | 55 | func Call(f Function, args ...interface{}) interface{} { 56 | return f.Apply(vecToLs(Vector(args))) 57 | } 58 | 59 | type Primitive func(args interface{}) interface{} 60 | 61 | func (self Primitive) Apply(args interface{}) interface{} { 62 | return self(args) 63 | } 64 | 65 | func (self Primitive) String() string { 66 | return self.GoString() 67 | } 68 | 69 | func (self Primitive) GoString() string { 70 | return "#" 71 | } 72 | 73 | // Takes a function, which can take interface{}thing from none to five lisp.interface{} and 74 | // must return lisp.interface{}, and returns a function that can be called by the 75 | // lisp system. Crashes if it fails to match, which I suppose is pretty 76 | // bad, really. 77 | func WrapPrimitive(_f interface{}) Function { 78 | wrap := func(l int, f func(Vector) interface{}) Function { 79 | var res Function 80 | res = Primitive(func(args interface{}) interface{} { 81 | as := lsToVec(args).(Vector) 82 | if len(as) != l { 83 | ArgumentError(res, args) 84 | } 85 | return f(as) 86 | }) 87 | return res 88 | } 89 | switch f := _f.(type) { 90 | case func() interface{}: 91 | return wrap(0, func(args Vector) interface{} { 92 | return f() 93 | }) 94 | case func(a interface{}) interface{}: 95 | return wrap(1, func(args Vector) interface{} { 96 | return f(args[0]) 97 | }) 98 | case func(a, b interface{}) interface{}: 99 | return wrap(2, func(args Vector) interface{} { 100 | return f(args[0], args[1]) 101 | }) 102 | case func(a, b, c interface{}) interface{}: 103 | return wrap(3, func(args Vector) interface{} { 104 | return f(args[0], args[1], args[2]) 105 | }) 106 | case func(a, b, c, d interface{}) interface{}: 107 | return wrap(4, func(args Vector) interface{} { 108 | return f(args[0], args[1], args[2], args[3]) 109 | }) 110 | case func(a, b, c, d, e interface{}) interface{}: 111 | return wrap(5, func(args Vector) interface{} { 112 | return f(args[0], args[1], args[2], args[3], args[4]) 113 | }) 114 | } 115 | Error(fmt.Sprintf("invalid primitive function: %s", toWrite("%#v", _f))) 116 | return nil 117 | } 118 | 119 | // Takes a map, containing functions to be passed to WrapPrimitive. Returns 120 | // an environment. 121 | func WrapPrimitives(env map[string]interface{}) Environment { 122 | res := make(Environment) 123 | for k, v := range env { 124 | res[Symbol(k)] = WrapPrimitive(v) 125 | } 126 | return res 127 | } 128 | 129 | /* 130 | Errors 131 | */ 132 | 133 | type errorStruct struct { 134 | kind Symbol 135 | msg interface{} 136 | } 137 | 138 | func (self *errorStruct) Error() string { 139 | return self.GoString() 140 | } 141 | 142 | func (self *errorStruct) String() string { 143 | return self.GoString() 144 | } 145 | 146 | func (self *errorStruct) GoString() string { 147 | return fmt.Sprintf("%v: %s", self.kind, toWrite("%v", self.msg)) 148 | } 149 | 150 | func Failed(x interface{}) bool { 151 | _, failed := x.(*errorStruct) 152 | return failed 153 | } 154 | 155 | func WrapError(err interface{}) error { 156 | switch e := err.(type) { 157 | case *errorStruct: 158 | return e 159 | case error: 160 | return &errorStruct{Symbol("system-error"), e.Error()} 161 | default: 162 | TypeError("error", err) 163 | } 164 | panic("unreachable") 165 | } 166 | 167 | func Throw(kind Symbol, msg interface{}) { 168 | panic(&errorStruct{kind, msg}) 169 | } 170 | 171 | func Error(msg string) { 172 | Throw(Symbol("error"), msg) 173 | } 174 | 175 | func TypeError(expected string, obj interface{}) { 176 | msg := fmt.Sprintf("expecting %s: %s", expected, toWrite("%#v", obj)) 177 | Throw(Symbol("type-error"), msg) 178 | } 179 | 180 | func ArgumentError(f, args interface{}) { 181 | msg := fmt.Sprintf("wrong number of arguments to %v: %#v", f, args) 182 | Throw(Symbol("argument-error"), msg) 183 | } 184 | 185 | func SystemError(err error) { 186 | Throw(Symbol("system-error"), err.Error()) 187 | } 188 | 189 | func SyntaxError(err string) { 190 | Throw(Symbol("syntax-error"), err) 191 | } 192 | 193 | /* 194 | Pairs 195 | */ 196 | 197 | var EMPTY_LIST = NewConstant("()") 198 | 199 | type Pair struct{ a, d interface{} } 200 | 201 | func (self *Pair) toWrite(def string) string { 202 | res := "" 203 | if self.d == EMPTY_LIST { 204 | res = fmt.Sprintf("(%s)", toWrite(def, self.a)) 205 | } else if d, ok := self.d.(*Pair); ok { 206 | res = fmt.Sprintf("(%s %s", toWrite(def, self.a), toWrite(def, d)[1:]) 207 | } else { 208 | res = fmt.Sprintf("(%s . %s)", toWrite(def, self.a), toWrite(def, self.d)) 209 | } 210 | return res 211 | } 212 | 213 | func (self *Pair) String() string { 214 | return self.toWrite("%v") 215 | } 216 | 217 | func (self *Pair) GoString() string { 218 | return self.toWrite("%#v") 219 | } 220 | 221 | func Cons(a, d interface{}) interface{} { 222 | return &Pair{a, d} 223 | } 224 | 225 | func pairFunc(x interface{}, f func(*Pair) interface{}) interface{} { 226 | p, ok := x.(*Pair) 227 | if !ok { 228 | TypeError("pair", x) 229 | } 230 | return f(p) 231 | } 232 | 233 | func Car(x interface{}) interface{} { 234 | return pairFunc(x, func(p *Pair) interface{} { return p.a }) 235 | } 236 | 237 | func Cdr(x interface{}) interface{} { 238 | return pairFunc(x, func(p *Pair) interface{} { return p.d }) 239 | } 240 | 241 | func List(xs ...interface{}) interface{} { 242 | return vecToLs(Vector(xs)) 243 | } 244 | 245 | func ListLen(ls interface{}) int { 246 | res := 0 247 | for ; ls != EMPTY_LIST; ls, res = Cdr(ls), res+1 { 248 | } 249 | return res 250 | } 251 | 252 | func ListTail(ls interface{}, idx int) interface{} { 253 | for ; idx > 0; idx, ls = idx-1, Cdr(ls) { 254 | } 255 | return ls 256 | } 257 | 258 | func ListRef(ls interface{}, idx int) interface{} { 259 | return Car(ListTail(ls, idx)) 260 | } 261 | 262 | /* 263 | Vectors 264 | */ 265 | 266 | type Vector []interface{} 267 | 268 | func (self Vector) testRange(i int) { 269 | if i < 0 || i >= len(self) { 270 | Error(fmt.Sprintf("invalid index (%v)", i)) 271 | } 272 | } 273 | 274 | func (self Vector) Get(i int) interface{} { 275 | self.testRange(i) 276 | return self[i] 277 | } 278 | 279 | func (self Vector) Set(i int, v interface{}) interface{} { 280 | self.testRange(i) 281 | self[i] = v 282 | return nil 283 | } 284 | 285 | func (self Vector) Slice(lo, hi int) interface{} { 286 | self.testRange(lo) 287 | self.testRange(hi - 1) 288 | return self[lo:hi] 289 | } 290 | 291 | func (self Vector) toWrite(def string) string { 292 | res := "#(" 293 | for _, x := range self { 294 | res += toWrite(def, x) + " " 295 | } 296 | return res[0:len(res)-1] + ")" 297 | } 298 | 299 | func (self Vector) String() string { 300 | return self.toWrite("%v") 301 | } 302 | 303 | func (self Vector) GoString() string { 304 | return self.toWrite("%#v") 305 | } 306 | 307 | /* 308 | Ports 309 | */ 310 | var ( 311 | EOF_OBJECT = NewConstant("#eof-object") 312 | _PORT_CLOSED = errors.New("port closed") 313 | ) 314 | 315 | type InputPort struct { 316 | eof bool 317 | ref io.Reader 318 | r *bufio.Reader 319 | } 320 | 321 | func NewInput(r io.Reader) *InputPort { 322 | if p, ok := r.(*InputPort); ok { 323 | return p 324 | } 325 | return &InputPort{false, r, bufio.NewReader(r)} 326 | } 327 | 328 | func (self *InputPort) Read(bs []byte) (int, error) { 329 | if self.r == nil { 330 | return 0, _PORT_CLOSED 331 | } 332 | if self.eof { 333 | return 0, io.EOF 334 | } 335 | l, err := self.r.Read(bs) 336 | self.eof = err == io.EOF 337 | return l, err 338 | } 339 | 340 | func (self *InputPort) ReadChar() interface{} { 341 | if self.r == nil { 342 | SystemError(_PORT_CLOSED) 343 | } 344 | if self.eof { 345 | return EOF_OBJECT 346 | } 347 | res, _, err := self.r.ReadRune() 348 | if err != nil { 349 | self.eof = err == io.EOF 350 | if !self.eof { 351 | SystemError(err) 352 | } 353 | } 354 | return res 355 | } 356 | 357 | func (self *InputPort) ReadByte() interface{} { 358 | if self.r == nil { 359 | SystemError(_PORT_CLOSED) 360 | } 361 | if self.eof { 362 | return EOF_OBJECT 363 | } 364 | bs := []byte{0} 365 | _, err := self.Read(bs) 366 | if err != nil { 367 | self.eof = err == io.EOF 368 | if !self.eof { 369 | SystemError(err) 370 | } 371 | } 372 | return int(bs[0]) 373 | } 374 | 375 | func (self *InputPort) ReadLine() interface{} { 376 | if self.r == nil { 377 | SystemError(_PORT_CLOSED) 378 | } 379 | if self.eof { 380 | return EOF_OBJECT 381 | } 382 | res := "" 383 | for { 384 | b, _, err := self.r.ReadRune() 385 | if err != nil { 386 | self.eof = err == io.EOF 387 | if !self.eof { 388 | SystemError(err) 389 | } 390 | break 391 | } 392 | if b == '\n' { 393 | break 394 | } 395 | res += string(b) 396 | } 397 | return res 398 | } 399 | 400 | func (self *InputPort) Close() { 401 | if self.r == nil { 402 | SystemError(_PORT_CLOSED) 403 | } 404 | self.r = nil 405 | if c, ok := self.ref.(io.Closer); ok { 406 | err := c.Close() 407 | if err != nil { 408 | SystemError(err) 409 | } 410 | } 411 | } 412 | 413 | func (self *InputPort) Eof() bool { 414 | return self.eof 415 | } 416 | 417 | type OutputPort struct { 418 | ref io.Writer 419 | w *bufio.Writer 420 | } 421 | 422 | func NewOutput(w io.Writer) *OutputPort { 423 | if p, ok := w.(*OutputPort); ok { 424 | return p 425 | } 426 | return &OutputPort{w, bufio.NewWriter(w)} 427 | } 428 | 429 | func (self *OutputPort) Write(bs []byte) (int, error) { 430 | if self.w == nil { 431 | return 0, _PORT_CLOSED 432 | } 433 | return self.w.Write(bs) 434 | } 435 | 436 | func (self *OutputPort) WriteString(str string) { 437 | if self.w == nil { 438 | SystemError(_PORT_CLOSED) 439 | } 440 | _, err := self.w.WriteString(str) 441 | if err != nil { 442 | SystemError(err) 443 | } 444 | } 445 | 446 | func (self *OutputPort) WriteByte(b byte) { 447 | bs := []byte{b} 448 | _, err := self.Write(bs) 449 | if err != nil { 450 | SystemError(err) 451 | } 452 | } 453 | 454 | func (self *OutputPort) Flush() { 455 | if self.w == nil { 456 | SystemError(_PORT_CLOSED) 457 | } 458 | err := self.w.Flush() 459 | if err != nil { 460 | SystemError(err) 461 | } 462 | } 463 | 464 | func (self *OutputPort) Close() { 465 | if self.w == nil { 466 | SystemError(_PORT_CLOSED) 467 | } 468 | self.w = nil 469 | if c, ok := self.ref.(io.Closer); ok { 470 | err := c.Close() 471 | if err != nil { 472 | SystemError(err) 473 | } 474 | } 475 | } 476 | 477 | /* 478 | Custom types 479 | */ 480 | 481 | type Custom struct { 482 | name Symbol 483 | val interface{} 484 | } 485 | 486 | func NewCustom(name Symbol, val interface{}) *Custom { 487 | return &Custom{name, val} 488 | } 489 | 490 | func (self *Custom) Name() Symbol { 491 | return self.name 492 | } 493 | 494 | func (self *Custom) Get() interface{} { 495 | return self.val 496 | } 497 | 498 | func (self *Custom) Set(val interface{}) { 499 | self.val = val 500 | } 501 | 502 | func (self *Custom) String() string { 503 | return self.GoString() 504 | } 505 | 506 | func (self *Custom) GoString() string { 507 | return fmt.Sprintf("#<%s: %x>", self.name, unsafe.Pointer(self)) 508 | } 509 | -------------------------------------------------------------------------------- /lisp/interpreter.go: -------------------------------------------------------------------------------- 1 | package lisp 2 | 3 | import ( 4 | "fmt" 5 | "io" 6 | "os" 7 | "os/user" 8 | "path/filepath" 9 | "strings" 10 | 11 | "github.com/bobappleyard/bwl/errors" 12 | ) 13 | 14 | /* 15 | Interpreter related stuff 16 | */ 17 | 18 | var PreludeFile = "prelude.golisp" 19 | var PreludePaths = []string{} 20 | 21 | func init() { 22 | if wd, err := os.Getwd(); err == nil { 23 | PreludePaths = append(PreludePaths, filepath.Join(wd, PreludeFile)) 24 | } 25 | ps := strings.Split(os.Getenv("GOPATH"), string(filepath.ListSeparator)) 26 | for _, p := range ps { 27 | PreludePaths = append(PreludePaths, filepath.Join(p, "src/github.com/bobappleyard/golisp", PreludeFile)) 28 | } 29 | if u, err := user.Current(); err == nil { 30 | f := filepath.Join(u.HomeDir, ".golisp", PreludeFile) 31 | PreludePaths = append(PreludePaths, f) 32 | } 33 | } 34 | 35 | type Scope struct { 36 | env Environment 37 | parent *Scope 38 | } 39 | 40 | type closure struct { 41 | ctx *Scope 42 | vars, body interface{} 43 | } 44 | 45 | type macro struct { 46 | f Function 47 | } 48 | 49 | type tailStruct struct { 50 | f *Function 51 | args *interface{} 52 | } 53 | 54 | // Create a new execution Scope for some code. 55 | func NewScope(parent *Scope) *Scope { 56 | return &Scope{make(Environment), parent} 57 | } 58 | 59 | // patchy workaround... 60 | func tryLoad(paths []string) string { 61 | for _, v := range paths { 62 | // nope! openFile still panics "unconditionally" 63 | // if !Failed(openFile(v, Symbol("read"))) { 64 | if _, err := os.Open(v); err == nil { 65 | return v 66 | } 67 | } 68 | return "" 69 | } 70 | 71 | // Create a Scope that can be used as an interpreter. 72 | func New() *Scope { 73 | res := NewScope(nil) 74 | res.Bind(Primitives()) 75 | res.Bind(WrapPrimitives(map[string]interface{}{ 76 | "root-environment": func() interface{} { return res }, 77 | })) 78 | if PreludePath := tryLoad(PreludePaths); PreludePath != "" { 79 | res.Load(PreludePath) 80 | } else { 81 | panic("could not find " + PreludeFile + " file") 82 | } 83 | return res 84 | } 85 | 86 | // Scopes 87 | 88 | func (self *Scope) String() string { 89 | return self.GoString() 90 | } 91 | 92 | func (self *Scope) GoString() string { 93 | return "#" 94 | } 95 | 96 | func (self *Scope) Eval(x interface{}) interface{} { 97 | return self.evalExpr(self.Expand(x), nil) 98 | } 99 | 100 | func (self *Scope) EvalString(x string) interface{} { 101 | return self.Eval(ReadString(x)) 102 | } 103 | 104 | func (self *Scope) Expand(x interface{}) interface{} { 105 | done := false 106 | for !done { 107 | p, ok := x.(*Pair) 108 | if !ok { 109 | break 110 | } 111 | if s, ok := p.a.(Symbol); ok { 112 | switch string(s) { 113 | case "quote": 114 | return x 115 | case "if": 116 | return Cons(p.a, self.expandList(p.d)) 117 | case "lambda": 118 | { 119 | ctx := NewScope(self) 120 | return Cons(p.a, Cons(Car(p.d), ctx.expandList(Cdr(p.d)))) 121 | } 122 | case "set!": 123 | return List(p.a, Car(p.d), self.Expand(Car(Cdr(p.d)))) 124 | case "define": 125 | return Cons(p.a, self.expandDefinition(p.d)) 126 | case "define-macro": 127 | { 128 | expr := self.expandDefinition(p.d) 129 | expr = List(Symbol("define"), Car(expr), Cons(Symbol("macro"), Cdr(expr))) 130 | self.evalExpr(expr, nil) 131 | return expr 132 | } 133 | case "begin": 134 | return Cons(p.a, self.expandList(p.d)) 135 | } 136 | errors.Catch( 137 | func() { x = self.lookupSym(s).(*macro).f.Apply(p.d) }, 138 | func(_ interface{}) { x, done = self.expandList(x), true }, 139 | ) 140 | } else { 141 | x, done = self.expandList(x), true 142 | } 143 | } 144 | return x 145 | } 146 | 147 | func (self *Scope) Bind(env Environment) { 148 | for k, v := range env { 149 | self.env[k] = v 150 | } 151 | } 152 | 153 | func (self *Scope) Lookup(x string) interface{} { 154 | return self.lookupSym(Symbol(x)) 155 | } 156 | 157 | func (self *Scope) Load(path string) { 158 | src := openFile(path, Symbol("read")) 159 | exprs := ReadFile(src) 160 | for cur := exprs; cur != EMPTY_LIST; cur = Cdr(cur) { 161 | self.Eval(Car(cur)) 162 | } 163 | } 164 | 165 | func (self *Scope) Repl(in io.Reader, out io.Writer) { 166 | // set stuff up 167 | inp := NewInput(in) 168 | outp := NewOutput(out) 169 | read := func() interface{} { 170 | res := inp.ReadLine() 171 | if res == EOF_OBJECT { 172 | return nil 173 | } 174 | s := res.(string) 175 | if strings.TrimSpace(s) == "" { 176 | return nil 177 | } 178 | res = ReadString(s) 179 | if res == EOF_OBJECT { 180 | return nil 181 | } 182 | return res 183 | } 184 | self.Bind(WrapPrimitives(map[string]interface{}{ 185 | "standard-input": func() interface{} { return inp }, 186 | "standard-output": func() interface{} { return outp }, 187 | })) 188 | // main loop 189 | var x interface{} 190 | for !inp.Eof() { 191 | errors.Catch( 192 | func() { 193 | Display("> ", outp) 194 | outp.Flush() 195 | x = self.Eval(read()) 196 | }, 197 | func(err interface{}) { x = err }, 198 | ) 199 | if x != nil { 200 | Write(x, outp) 201 | Display("\n", outp) 202 | } 203 | } 204 | Display("\n", outp) 205 | outp.Flush() 206 | } 207 | 208 | func (self *Scope) evalExpr(_x interface{}, tail *tailStruct) interface{} { 209 | // pairs and symbols get treated specially 210 | switch x := _x.(type) { 211 | case *Pair: 212 | return self.evalPair(x, tail) 213 | case Symbol: 214 | return self.lookupSym(x) 215 | } 216 | // everything else is self-evaluating 217 | return _x 218 | } 219 | 220 | func (self *Scope) evalPair(x *Pair, tail *tailStruct) interface{} { 221 | switch n := x.a.(type) { 222 | case Symbol: 223 | switch string(n) { 224 | // standard forms 225 | case "quote": 226 | return Car(x.d) 227 | case "if": 228 | if True(self.evalExpr(ListRef(x.d, 0), nil)) { 229 | return self.evalExpr(ListRef(x.d, 1), tail) 230 | } else { 231 | return self.evalExpr(ListRef(x.d, 2), tail) 232 | } 233 | case "lambda": 234 | return &closure{self, Car(x.d), Cdr(x.d)} 235 | case "set!": 236 | { 237 | v := self.evalExpr(ListRef(x.d, 1), nil) 238 | self.mutate(Car(x.d), v) 239 | return nil 240 | } 241 | case "define": 242 | { 243 | self.evalDefine(x.d) 244 | return nil 245 | } 246 | case "begin": 247 | return self.evalBlock(x.d, tail) 248 | // otherwise fall through to a function call 249 | } 250 | case *Pair: // do nothing, it's handled below 251 | default: 252 | TypeError("pair or symbol", n) 253 | } 254 | // function application 255 | return self.evalCall(self.evalExpr(x.a, nil), x.d, tail) 256 | } 257 | 258 | func (self *Scope) lookupSym(x Symbol) interface{} { 259 | if self == nil { 260 | Error(fmt.Sprintf("unknown variable: %s", x)) 261 | } 262 | res, ok := self.env[x] 263 | if ok { 264 | return res 265 | } 266 | return self.parent.lookupSym(x) 267 | } 268 | 269 | func (self *Scope) mutate(_name, val interface{}) { 270 | if self == nil { 271 | Error(fmt.Sprintf("unknown variable: %s", _name)) 272 | } 273 | name, ok := _name.(Symbol) 274 | if !ok { 275 | TypeError("symbol", _name) 276 | } 277 | _, ok = self.env[name] 278 | if !ok { 279 | self.parent.mutate(_name, val) 280 | } 281 | self.env[name] = val 282 | } 283 | 284 | func (self *Scope) evalCall(f, args interface{}, tail *tailStruct) interface{} { 285 | var argvals interface{} = EMPTY_LIST 286 | p := new(Pair) 287 | // evaluate the arguments 288 | for cur := args; cur != EMPTY_LIST; cur = Cdr(cur) { 289 | if argvals == EMPTY_LIST { 290 | argvals = p 291 | } 292 | r := self.evalExpr(Car(cur), nil) 293 | p.a = r 294 | if Cdr(cur) == EMPTY_LIST { 295 | p.d = EMPTY_LIST 296 | break 297 | } 298 | next := new(Pair) 299 | p.d = next 300 | p = next 301 | } 302 | // get the function 303 | fn, ok := f.(Function) 304 | if !ok { 305 | TypeError("function", f) 306 | } 307 | // call it 308 | if tail == nil { 309 | return fn.Apply(argvals) 310 | } 311 | // in tail position 312 | *(tail.f) = fn 313 | *(tail.args) = argvals 314 | return nil 315 | } 316 | 317 | func (self *Scope) evalDefine(ls interface{}) { 318 | d := Car(ls) 319 | n, ok := d.(Symbol) 320 | if !ok { 321 | TypeError("symbol", d) 322 | } 323 | d = Car(Cdr(ls)) 324 | d = self.evalExpr(d, nil) 325 | self.env[n] = d 326 | } 327 | 328 | func (self *Scope) evalBlock(body interface{}, tail *tailStruct) interface{} { 329 | var res interface{} 330 | for cur := body; cur != EMPTY_LIST; cur = Cdr(cur) { 331 | if Cdr(cur) == EMPTY_LIST { // in tail position 332 | res = self.evalExpr(Car(cur), tail) 333 | } else { 334 | self.evalExpr(Car(cur), nil) 335 | } 336 | } 337 | return res 338 | } 339 | 340 | func (self *Scope) expandList(ls interface{}) interface{} { 341 | var res interface{} = EMPTY_LIST 342 | p := new(Pair) 343 | for cur := ls; cur != EMPTY_LIST; cur = Cdr(cur) { 344 | if res == EMPTY_LIST { 345 | res = p 346 | } 347 | p.a = self.Expand(Car(cur)) 348 | next := new(Pair) 349 | if Cdr(cur) == EMPTY_LIST { 350 | p.d = EMPTY_LIST 351 | break 352 | } 353 | if _, ok := Cdr(cur).(*Pair); !ok { 354 | p.d = self.Expand(Cdr(cur)) 355 | break 356 | } 357 | p.d = next 358 | p = next 359 | } 360 | return res 361 | } 362 | 363 | func (self *Scope) expandDefinition(ls interface{}) interface{} { 364 | for { 365 | if p, ok := Car(ls).(*Pair); ok { 366 | ls = List(p.a, Cons(Symbol("lambda"), Cons(p.d, Cdr(ls)))) 367 | } else { 368 | ls = Cons(Car(ls), self.expandList(Cdr(ls))) 369 | break 370 | } 371 | } 372 | return ls 373 | } 374 | 375 | // Closures 376 | 377 | func (self *closure) String() string { 378 | return self.GoString() 379 | } 380 | 381 | func (self *closure) GoString() string { 382 | return fmt.Sprintf("#", self.vars) 383 | } 384 | 385 | func (self *closure) Apply(args interface{}) interface{} { 386 | var res interface{} 387 | var f Function = self 388 | // closures can tail recurse, the for loop captures this 389 | tail := &tailStruct{&f, &args} 390 | for f != nil { 391 | if cl, ok := f.(*closure); ok { 392 | f = nil 393 | ctx := NewScope(cl.ctx) 394 | cl.bindArgs(ctx, args) 395 | res = ctx.evalBlock(cl.body, tail) 396 | } else { 397 | // primitive functions, or whatever 398 | return f.Apply(args) 399 | } 400 | } 401 | return res 402 | } 403 | 404 | func (self *closure) bindArgs(ctx *Scope, args interface{}) { 405 | vars := self.vars 406 | for { 407 | if vars == EMPTY_LIST && args == EMPTY_LIST { 408 | break 409 | } 410 | if vars == EMPTY_LIST { 411 | ArgumentError(self, args) 412 | } 413 | p, pair := vars.(*Pair) 414 | if args == EMPTY_LIST && pair { 415 | ArgumentError(self, args) 416 | } 417 | if !pair { 418 | self.bindArg(ctx, vars, args) 419 | break 420 | } 421 | self.bindArg(ctx, p.a, Car(args)) 422 | vars, args = p.d, Cdr(args) 423 | } 424 | } 425 | 426 | func (self *closure) bindArg(ctx *Scope, name, val interface{}) { 427 | n, ok := name.(Symbol) 428 | if !ok { 429 | TypeError("symbol", name) 430 | } 431 | ctx.env[n] = val 432 | } 433 | 434 | // Macros 435 | 436 | func (self *macro) String() string { 437 | return self.GoString() 438 | } 439 | 440 | func (self *macro) GoString() string { 441 | return "#" 442 | } 443 | -------------------------------------------------------------------------------- /lisp/primitives.go: -------------------------------------------------------------------------------- 1 | package lisp 2 | 3 | import ( 4 | "bytes" 5 | "fmt" 6 | "io" 7 | "math/big" 8 | "os" 9 | "strconv" 10 | "strings" 11 | 12 | "github.com/bobappleyard/bwl/errors" 13 | ) 14 | 15 | // All of the primitive functions defined by the library. 16 | func Primitives() Environment { 17 | return WrapPrimitives(map[string]interface{}{ 18 | // equality 19 | "==": eq, 20 | // syntax 21 | "read": Read, 22 | "read-file": ReadFile, 23 | "read-string": readStr, 24 | "write": Write, 25 | "display": Display, 26 | "macro": newMacro, 27 | // control 28 | "go": spawn, 29 | "load": load, 30 | "eval": eval, 31 | "apply": apply, 32 | "throw": throw, 33 | "catch": catch, 34 | "null-environment": nullEnv, 35 | "capture-environment": capEnv, 36 | "start-process": startProc, 37 | // type system 38 | "type-of": typeOf, 39 | "define-type": newCustom, 40 | // symbols 41 | "symbol->string": symToStr, 42 | "string->symbol": strToSym, 43 | "gensym": gensym, 44 | // numbers 45 | "fixnum->flonum": fixToFlo, 46 | "fixnum-add": fixnumAdd, 47 | "fixnum-sub": fixnumSub, 48 | "fixnum-mul": fixnumMul, 49 | "fixnum-div": fixnumDiv, 50 | "quotient": fixnumQuotient, 51 | "remainder": fixnumRemainder, 52 | "modulo": fixnumModulo, 53 | "flonum-add": flonumAdd, 54 | "flonum-sub": flonumSub, 55 | "flonum-mul": flonumMul, 56 | "flonum-div": flonumDiv, 57 | // strings 58 | "string-split": stringSplit, 59 | "string-join": stringJoin, 60 | "string->vector": strToVec, 61 | "object->string": objToStr, 62 | // pairs 63 | "cons": Cons, 64 | "car": Car, 65 | "cdr": Cdr, 66 | "list->vector": lsToVec, 67 | // vectors 68 | "make-vector": makeVector, 69 | "vector-length": vectorLength, 70 | "vector-ref": vectorRef, 71 | "vector-set!": vectorSet, 72 | "vector-slice": slice, 73 | "vector->list": vecToLs, 74 | "vector->string": vecToStr, 75 | // ports 76 | "open-file": openFile, 77 | "read-char": readChar, 78 | "read-byte": readByte, 79 | "eof-object?": isEof, 80 | "write-string": writeString, 81 | "write-byte": writeByte, 82 | "flush": flush, 83 | "close": closePort, 84 | // channels 85 | "make-channel": makeChannel, 86 | "channel-send": send, 87 | "channel-receive": receive, 88 | }) 89 | } 90 | 91 | /* 92 | Equality 93 | */ 94 | 95 | func eq(a, b interface{}) interface{} { 96 | var res interface{} 97 | errors.Catch( 98 | func() { res = a == b }, 99 | func(_ interface{}) { res = false }, 100 | ) 101 | return res 102 | } 103 | 104 | /* 105 | Syntax 106 | */ 107 | 108 | func readStr(str interface{}) interface{} { 109 | s, ok := str.(string) 110 | if !ok { 111 | TypeError("string", str) 112 | } 113 | return ReadString(s) 114 | } 115 | 116 | func newMacro(m interface{}) interface{} { 117 | f, ok := m.(Function) 118 | if !ok { 119 | TypeError("function", m) 120 | } 121 | return ¯o{f} 122 | } 123 | 124 | /* 125 | Control 126 | */ 127 | 128 | func spawn(f interface{}) interface{} { 129 | fn, ok := f.(Function) 130 | if !ok { 131 | TypeError("function", f) 132 | } 133 | go fn.Apply(EMPTY_LIST) 134 | return nil 135 | } 136 | 137 | func load(path, env interface{}) interface{} { 138 | ctx, ok := env.(*Scope) 139 | if !ok { 140 | TypeError("environment", env) 141 | } 142 | p, ok := path.(string) 143 | if !ok { 144 | TypeError("string", path) 145 | } 146 | ctx.Load(p) 147 | return nil 148 | } 149 | 150 | func eval(expr, env interface{}) interface{} { 151 | ctx, ok := env.(*Scope) 152 | if !ok { 153 | TypeError("environment", env) 154 | } 155 | return ctx.Eval(expr) 156 | } 157 | 158 | func apply(f, args interface{}) interface{} { 159 | fn, ok := f.(Function) 160 | if !ok { 161 | TypeError("function", f) 162 | } 163 | return fn.Apply(args) 164 | } 165 | 166 | func throw(kind, msg interface{}) interface{} { 167 | k, ok := kind.(Symbol) 168 | if !ok { 169 | TypeError("symbol", kind) 170 | } 171 | Throw(k, msg) 172 | panic("unreachable") 173 | } 174 | 175 | func catch(thk, hnd interface{}) interface{} { 176 | t, ok := thk.(Function) 177 | if !ok { 178 | TypeError("function", t) 179 | } 180 | h, ok := hnd.(Function) 181 | if !ok { 182 | TypeError("function", h) 183 | } 184 | var res interface{} 185 | errors.Catch( 186 | func() { res = Call(t) }, 187 | func(err interface{}) { 188 | e := WrapError(err).(*errorStruct) 189 | res = Call(h, e.kind, e.msg) 190 | }, 191 | ) 192 | return res 193 | } 194 | 195 | func nullEnv() interface{} { 196 | return NewScope(nil) 197 | } 198 | 199 | func capEnv(env interface{}) interface{} { 200 | e, ok := env.(*Scope) 201 | if !ok { 202 | TypeError("environment", env) 203 | } 204 | return NewScope(e) 205 | } 206 | 207 | func startProc(path, args interface{}) interface{} { 208 | p, ok := path.(string) 209 | if !ok { 210 | TypeError("string", path) 211 | } 212 | argv := make([]string, ListLen(args)) 213 | for cur, i := args, 0; cur != EMPTY_LIST; cur, i = Cdr(cur), i+1 { 214 | x := Car(cur) 215 | s, ok := x.(string) 216 | if !ok { 217 | TypeError("string", x) 218 | } 219 | argv[i] = s 220 | } 221 | inr, inw, err := os.Pipe() 222 | if err != nil { 223 | SystemError(err) 224 | } 225 | outr, outw, err := os.Pipe() 226 | if err != nil { 227 | SystemError(err) 228 | } 229 | proc := &os.ProcAttr{"", os.Environ(), []*os.File{inr, outw, os.Stderr}, nil} 230 | _, err = os.StartProcess(p, argv, proc) 231 | // _, err = os.ForkExec(p, argv, os.Envs, "", []*os.File { inr, outw, os.Stderr }) 232 | if err != nil { 233 | SystemError(err) 234 | } 235 | return Cons(NewOutput(inw), NewInput(outr)) 236 | } 237 | 238 | /* 239 | Type system 240 | */ 241 | 242 | func typeOf(x interface{}) interface{} { 243 | s := "unknown" 244 | switch x.(type) { 245 | case bool: 246 | s = "boolean" 247 | case int: 248 | s = "fixnum" 249 | case float32: 250 | s = "flonum" 251 | case string: 252 | s = "string" 253 | case Symbol: 254 | s = "symbol" 255 | case *Pair: 256 | s = "pair" 257 | case Vector: 258 | s = "vector" 259 | case *macro: 260 | s = "macro" 261 | case Function: 262 | s = "function" 263 | case *InputPort: 264 | s = "input-port" 265 | case *OutputPort: 266 | s = "output-port" 267 | case *Custom: 268 | return x.(*Custom).Name() 269 | case *big.Int: 270 | s = "bignum" 271 | case chan interface{}: 272 | s = "channel" 273 | } 274 | if x == nil { 275 | s = "void" 276 | } 277 | return Symbol(s) 278 | } 279 | 280 | func newCustom(name, fn interface{}) interface{} { 281 | n, ok := name.(Symbol) 282 | if !ok { 283 | TypeError("symbol", name) 284 | } 285 | f, ok := fn.(Function) 286 | if !ok { 287 | TypeError("function", fn) 288 | } 289 | wrap := WrapPrimitive(func(x interface{}) interface{} { 290 | return NewCustom(n, x) 291 | }) 292 | unwrap := WrapPrimitive(func(x interface{}) interface{} { 293 | c, ok := x.(*Custom) 294 | if !ok || c.name != n { 295 | TypeError(string(n), x) 296 | } 297 | return c.Get() 298 | }) 299 | set := WrapPrimitive(func(x, v interface{}) interface{} { 300 | c, ok := x.(*Custom) 301 | if !ok || c.name != n { 302 | TypeError(string(n), x) 303 | } 304 | c.Set(v) 305 | return nil 306 | }) 307 | Call(f, wrap, unwrap, set) 308 | return nil 309 | } 310 | 311 | /* 312 | Symbols 313 | */ 314 | 315 | func symToStr(sym interface{}) interface{} { 316 | s, ok := sym.(Symbol) 317 | if !ok { 318 | TypeError("symbol", sym) 319 | } 320 | return string(s) 321 | } 322 | 323 | func strToSym(str interface{}) interface{} { 324 | s, ok := str.(string) 325 | if !ok { 326 | TypeError("string", str) 327 | } 328 | return Symbol(s) 329 | } 330 | 331 | var gensyms = func() <-chan Symbol { 332 | syms := make(chan Symbol) 333 | go func() { 334 | i := 0 335 | for { 336 | syms <- Symbol("#gensym" + strconv.Itoa(i)) 337 | i++ 338 | } 339 | }() 340 | return syms 341 | }() 342 | 343 | func gensym() interface{} { 344 | return <-gensyms 345 | } 346 | 347 | /* 348 | Numbers 349 | */ 350 | 351 | func fixToFlo(_x interface{}) interface{} { 352 | switch x := _x.(type) { 353 | case int: 354 | return float32(x) 355 | case float32: 356 | return x 357 | } 358 | TypeError("number", _x) 359 | panic("unreachable") 360 | } 361 | 362 | func fixnumFunc(_a, _b interface{}, f func(a, b int) interface{}) interface{} { 363 | a, ok := _a.(int) 364 | if !ok { 365 | TypeError("fixnum", _a) 366 | } 367 | b, ok := _b.(int) 368 | if !ok { 369 | TypeError("fixnum", _b) 370 | } 371 | return f(a, b) 372 | } 373 | 374 | func fixnumAdd(_a, _b interface{}) interface{} { 375 | return fixnumFunc(_a, _b, func(a, b int) interface{} { return a + b }) 376 | } 377 | 378 | func fixnumSub(_a, _b interface{}) interface{} { 379 | return fixnumFunc(_a, _b, func(a, b int) interface{} { return a - b }) 380 | } 381 | 382 | func fixnumMul(_a, _b interface{}) interface{} { 383 | return fixnumFunc(_a, _b, func(a, b int) interface{} { return a * b }) 384 | } 385 | 386 | func fixnumDiv(_a, _b interface{}) interface{} { 387 | return fixnumFunc(_a, _b, func(a, b int) interface{} { 388 | if b == 0 { 389 | Error("divide by zero") 390 | } 391 | if a%b == 0 { 392 | return a / b 393 | } 394 | return float32(a) / float32(b) 395 | }) 396 | } 397 | 398 | func fixnumQuotient(_a, _b interface{}) interface{} { 399 | return fixnumFunc(_a, _b, func(a, b int) interface{} { 400 | if b == 0 { 401 | Error("divide by zero") 402 | } 403 | return a / b 404 | }) 405 | } 406 | 407 | func fixnumRemainder(_a, _b interface{}) interface{} { 408 | return fixnumFunc(_a, _b, func(a, b int) interface{} { 409 | if b == 0 { 410 | Error("divide by zero") 411 | } 412 | return a % b 413 | }) 414 | } 415 | 416 | func fixnumModulo(_a, _b interface{}) interface{} { 417 | return fixnumFunc(_a, _b, func(a, b int) interface{} { 418 | if b == 0 { 419 | Error("divide by zero") 420 | } 421 | r := a % b 422 | if !(r == 0 || (a > 0 && b > 0) || (a < 0 && b < 0)) { 423 | r += b 424 | } 425 | return r 426 | }) 427 | } 428 | 429 | func flonumFunc(_a, _b interface{}, f func(a, b float32) interface{}) interface{} { 430 | a, ok := _a.(float32) 431 | if !ok { 432 | TypeError("flonum", _a) 433 | } 434 | b, ok := _b.(float32) 435 | if !ok { 436 | TypeError("flonum", _b) 437 | } 438 | return f(a, b) 439 | } 440 | 441 | func flonumAdd(_a, _b interface{}) interface{} { 442 | return flonumFunc(_a, _b, func(a, b float32) interface{} { return a + b }) 443 | } 444 | 445 | func flonumSub(_a, _b interface{}) interface{} { 446 | return flonumFunc(_a, _b, func(a, b float32) interface{} { return a - b }) 447 | } 448 | 449 | func flonumMul(_a, _b interface{}) interface{} { 450 | return flonumFunc(_a, _b, func(a, b float32) interface{} { return a * b }) 451 | } 452 | 453 | func flonumDiv(_a, _b interface{}) interface{} { 454 | return flonumFunc(_a, _b, func(a, b float32) interface{} { 455 | if b == 0 { 456 | Error("divide by zero") 457 | } 458 | return a / b 459 | }) 460 | } 461 | 462 | /* 463 | Strings 464 | */ 465 | 466 | func stringSplit(str, sep interface{}) interface{} { 467 | s, ok := str.(string) 468 | if !ok { 469 | TypeError("string", str) 470 | } 471 | b, ok := sep.(string) 472 | if !ok { 473 | TypeError("string", sep) 474 | } 475 | ss := strings.Split(s, b) 476 | res := EMPTY_LIST 477 | for i := len(ss) - 1; i >= 0; i-- { 478 | res = Cons(ss[i], res) 479 | } 480 | return res 481 | } 482 | 483 | func stringJoin(strs, sep interface{}) interface{} { 484 | ss := make([]string, ListLen(strs)) 485 | b, ok := sep.(string) 486 | if !ok { 487 | TypeError("string", sep) 488 | } 489 | for cur, i := strs, 0; cur != EMPTY_LIST; cur, i = Cdr(cur), i+1 { 490 | x := Car(cur) 491 | s, ok := x.(string) 492 | if !ok { 493 | TypeError("string", x) 494 | } 495 | ss[i] = s 496 | } 497 | return strings.Join(ss, b) 498 | } 499 | 500 | func strToVec(str interface{}) interface{} { 501 | s, ok := str.(string) 502 | if !ok { 503 | TypeError("string", str) 504 | } 505 | rs := bytes.Runes([]byte(s)) 506 | res := make(Vector, len(rs)) 507 | for i, x := range rs { 508 | res[i] = x 509 | } 510 | return res 511 | } 512 | 513 | func objToStr(obj interface{}) interface{} { 514 | return toWrite("%v", obj) 515 | } 516 | 517 | /* 518 | Vectors 519 | */ 520 | 521 | func makeVector(size, fill interface{}) interface{} { 522 | s, ok := size.(int) 523 | if !ok { 524 | TypeError("vector", size) 525 | } 526 | res := make(Vector, s) 527 | for i, _ := range res { 528 | res[i] = fill 529 | } 530 | return res 531 | } 532 | 533 | func vectorLength(vec interface{}) interface{} { 534 | v, ok := vec.(Vector) 535 | if !ok { 536 | TypeError("vector", vec) 537 | } 538 | return len(v) 539 | } 540 | 541 | func vectorRef(vec, idx interface{}) interface{} { 542 | v, ok := vec.(Vector) 543 | if !ok { 544 | TypeError("vector", vec) 545 | } 546 | i, ok := idx.(int) 547 | if !ok { 548 | TypeError("fixnum", idx) 549 | } 550 | return v.Get(i) 551 | } 552 | 553 | func vectorSet(vec, idx, val interface{}) interface{} { 554 | v, ok := vec.(Vector) 555 | if !ok { 556 | TypeError("vector", vec) 557 | } 558 | i, ok := idx.(int) 559 | if !ok { 560 | TypeError("fixnum", idx) 561 | } 562 | return v.Set(i, val) 563 | } 564 | 565 | func slice(vec, lo, hi interface{}) interface{} { 566 | v, ok := vec.(Vector) 567 | if !ok { 568 | TypeError("vector", vec) 569 | } 570 | l, ok := lo.(int) 571 | if !ok { 572 | TypeError("fixnum", lo) 573 | } 574 | h, ok := hi.(int) 575 | if !ok { 576 | TypeError("fixnum", hi) 577 | } 578 | if l < 0 { 579 | Error(fmt.Sprintf("invalid index (%v)", h)) 580 | } 581 | if h > len(v) { 582 | Error(fmt.Sprintf("invalid index (%v)", h)) 583 | } 584 | return v[l:h] 585 | } 586 | 587 | func lsToVec(lst interface{}) interface{} { 588 | l := ListLen(lst) 589 | if l == -1 { 590 | TypeError("pair", lst) 591 | } 592 | res := make(Vector, l) 593 | for i := 0; lst != EMPTY_LIST; i, lst = i+1, Cdr(lst) { 594 | a := Car(lst) 595 | if Failed(a) { 596 | return a 597 | } 598 | res[i] = a 599 | } 600 | return res 601 | } 602 | 603 | func vecToLs(vec interface{}) interface{} { 604 | xs, ok := vec.(Vector) 605 | if !ok { 606 | TypeError("vector", vec) 607 | } 608 | var res interface{} = EMPTY_LIST 609 | for i := len(xs) - 1; i >= 0; i-- { 610 | res = Cons(xs[i], res) 611 | } 612 | return res 613 | } 614 | 615 | func vecToStr(vec interface{}) interface{} { 616 | cs, ok := vec.(Vector) 617 | if !ok { 618 | TypeError("vector", vec) 619 | } 620 | res := make([]rune, len(cs)) 621 | for i, c := range cs { 622 | r, ok := c.(rune) 623 | if !ok { 624 | TypeError("vector of fixnums", vec) 625 | } 626 | res[i] = r 627 | } 628 | return string(res) 629 | } 630 | 631 | /* 632 | Ports 633 | */ 634 | 635 | func openFile(path, mode interface{}) interface{} { 636 | p, ok := path.(string) 637 | if !ok { 638 | TypeError("string", path) 639 | } 640 | m, ok := mode.(Symbol) 641 | if !ok { 642 | TypeError("symbol", mode) 643 | } 644 | wrap := func(x interface{}) interface{} { return NewOutput(x.(io.Writer)) } 645 | filemode, perms := 0, 0 646 | switch string(m) { 647 | case "create": 648 | filemode, perms = os.O_CREATE, 0644 649 | case "read": 650 | filemode, wrap = os.O_RDONLY, func(x interface{}) interface{} { 651 | return NewInput(x.(io.Reader)) 652 | } 653 | case "write": 654 | filemode = os.O_WRONLY 655 | case "append": 656 | filemode = os.O_APPEND 657 | default: 658 | Error(fmt.Sprintf("wrong access token: %s", m)) 659 | } 660 | f, err := os.OpenFile(p, filemode, os.FileMode(perms)) 661 | if err != nil { 662 | SystemError(err) 663 | } 664 | return wrap(f) 665 | } 666 | 667 | func readChar(port interface{}) interface{} { 668 | p, ok := port.(*InputPort) 669 | if !ok { 670 | TypeError("input-port", port) 671 | } 672 | return p.ReadChar() 673 | } 674 | 675 | func readByte(port interface{}) interface{} { 676 | p, ok := port.(*InputPort) 677 | if !ok { 678 | TypeError("input-port", port) 679 | } 680 | return p.ReadByte() 681 | } 682 | 683 | func isEof(x interface{}) interface{} { 684 | return x == EOF_OBJECT 685 | } 686 | 687 | func writeString(port, str interface{}) interface{} { 688 | p, ok := port.(*OutputPort) 689 | if !ok { 690 | TypeError("output-port", port) 691 | } 692 | s, ok := str.(string) 693 | if !ok { 694 | TypeError("string", str) 695 | } 696 | p.WriteString(s) 697 | return nil 698 | } 699 | 700 | func writeByte(port, bte interface{}) interface{} { 701 | p, ok := port.(*OutputPort) 702 | if !ok { 703 | TypeError("output-port", port) 704 | } 705 | b, ok := bte.(int) 706 | if !ok { 707 | TypeError("fixnum", bte) 708 | } 709 | p.WriteByte(byte(b)) 710 | return nil 711 | } 712 | 713 | func flush(port interface{}) interface{} { 714 | p, ok := port.(*OutputPort) 715 | if !ok { 716 | TypeError("output-port", port) 717 | } 718 | p.Flush() 719 | return nil 720 | } 721 | 722 | func closePort(port interface{}) interface{} { 723 | switch p := port.(type) { 724 | case *InputPort: 725 | p.Close() 726 | case *OutputPort: 727 | p.Close() 728 | default: 729 | TypeError("port", port) 730 | } 731 | return nil 732 | } 733 | 734 | /* 735 | Channels 736 | */ 737 | 738 | func makeChannel() interface{} { 739 | return make(chan interface{}) 740 | } 741 | 742 | func send(ch, v interface{}) interface{} { 743 | channel, ok := ch.(chan interface{}) 744 | if !ok { 745 | TypeError("channel", ch) 746 | } 747 | channel <- v 748 | return nil 749 | } 750 | 751 | func receive(ch interface{}) interface{} { 752 | channel, ok := ch.(chan interface{}) 753 | if !ok { 754 | TypeError("channel", ch) 755 | } 756 | return <-channel 757 | } 758 | -------------------------------------------------------------------------------- /lisp/syntax.go: -------------------------------------------------------------------------------- 1 | package lisp 2 | 3 | import ( 4 | "fmt" 5 | "io" 6 | "math/big" 7 | "strconv" 8 | "strings" 9 | 10 | "github.com/bobappleyard/bwl/lexer" 11 | "github.com/bobappleyard/bwl/peg" 12 | ) 13 | 14 | const ( 15 | _DOT peg.Terminal = iota 16 | _LSTART 17 | _LEND 18 | _LSTART2 19 | _LEND2 20 | _VSTART 21 | _INT 22 | _FLOAT 23 | _STR 24 | _COMMENT 25 | _WS 26 | _QUOTE 27 | _SYMBOL 28 | _HASH 29 | ) 30 | 31 | var lex = lexer.RegexSet{ 32 | rune(_DOT): "\\.", 33 | rune(_LSTART): "\\(", 34 | rune(_LEND): "\\)", 35 | rune(_LSTART2): "\\[", 36 | rune(_LEND2): "\\]", 37 | rune(_VSTART): "#\\(", 38 | rune(_INT): "-?\\d+", 39 | rune(_FLOAT): "-?\\d+(\\.\\d+)?", 40 | rune(_STR): "\"([^\"]|\\.)*\"", 41 | rune(_COMMENT): ";[^\n]*", 42 | rune(_WS): "\\s+", 43 | rune(_QUOTE): "'|`|,|,@", 44 | rune(_SYMBOL): "[^#\\(\\)\"\n\r\t\\[\\]'`,@ ]+", 45 | rune(_HASH): "#.", 46 | } 47 | 48 | func listExpr(start, rec, end peg.Expr) peg.Expr { 49 | tail := peg.Bind( 50 | peg.Option(peg.Select(peg.And{_DOT, rec}, 1)), 51 | func(x interface{}) interface{} { 52 | o := x.([]interface{}) 53 | if len(o) != 0 { 54 | return o[0] 55 | } 56 | return EMPTY_LIST 57 | }, 58 | ) 59 | inner := peg.Bind( 60 | peg.Option(peg.And{peg.Multi(rec), tail}), 61 | func(x interface{}) interface{} { 62 | o := x.([]interface{}) 63 | if len(o) == 0 { 64 | return EMPTY_LIST 65 | } 66 | expr := o[0].([]interface{}) 67 | ls := expr[0].([]interface{}) 68 | res := expr[1] 69 | if Failed(res) { 70 | return res 71 | } 72 | for i := len(ls) - 1; i >= 0; i-- { 73 | x := ls[i] 74 | if Failed(x) { 75 | return x 76 | } 77 | res = Cons(x, res) 78 | } 79 | return res 80 | }, 81 | ) 82 | return peg.Select(peg.And{start, inner, end}, 1) 83 | } 84 | 85 | var syntax = func() *peg.ExtensibleExpr { 86 | expr := peg.Extensible() 87 | expr.Add(peg.Or{ 88 | peg.Bind(_INT, func(x interface{}) interface{} { 89 | s := x.(string) 90 | res, err := strconv.Atoi(s) 91 | if err != nil { 92 | num := big.NewInt(0) 93 | _, ok := num.SetString(s, 10) 94 | if !ok { 95 | SystemError(err) 96 | } 97 | return num 98 | } 99 | return res 100 | }), 101 | peg.Bind(_FLOAT, func(x interface{}) interface{} { 102 | res, err := strconv.ParseFloat(x.(string), 64) 103 | if err != nil { 104 | SystemError(err) 105 | } 106 | return res 107 | }), 108 | peg.Bind(_STR, func(x interface{}) interface{} { 109 | res, err := strconv.Unquote(x.(string)) 110 | if err != nil { 111 | SystemError(err) 112 | } 113 | return res 114 | }), 115 | listExpr(_LSTART, expr, _LEND), 116 | listExpr(_LSTART2, expr, _LEND2), 117 | peg.Bind( 118 | peg.Select(peg.And{_VSTART, peg.Repeat(expr), _LEND}, 1), 119 | func(x interface{}) interface{} { 120 | return Vector(x.([]interface{})) 121 | }, 122 | ), 123 | peg.Bind(peg.And{_QUOTE, expr}, func(x interface{}) interface{} { 124 | qu := x.([]interface{}) 125 | s := "" 126 | switch qu[0].(string) { 127 | case "'": 128 | s = "quote" 129 | case "`": 130 | s = "quasiquote" 131 | case ",": 132 | s = "unquote" 133 | case ",@": 134 | s = "unquote-splicing" 135 | } 136 | return List(Symbol(s), qu[1]) 137 | }), 138 | peg.Bind(_SYMBOL, func(x interface{}) interface{} { 139 | return Symbol(x.(string)) 140 | }), 141 | peg.Bind(_HASH, func(x interface{}) interface{} { 142 | s := x.(string) 143 | switch s[1] { 144 | case 'v': 145 | return nil 146 | case 'f': 147 | return false 148 | case 't': 149 | return true 150 | } 151 | SyntaxError("unknown hash syntax: " + s) 152 | panic("unreachable") 153 | }), 154 | }) 155 | return expr 156 | }() 157 | 158 | func readExpr(expr peg.Expr, port interface{}) interface{} { 159 | p, ok := port.(*InputPort) 160 | if !ok { 161 | TypeError("input-port", port) 162 | } 163 | if p.Eof() { 164 | return EOF_OBJECT 165 | } 166 | l := lexer.New() 167 | l.Regexes(nil, lex) 168 | src := peg.NewLex(p, l, func(id int) bool { 169 | return id != int(_WS) && id != int(_COMMENT) 170 | }) 171 | m, d := expr.Match(src) 172 | if m.Failed() { 173 | SyntaxError(fmt.Sprintf("failed to parse (%d)", m.Pos())) 174 | } 175 | return d 176 | } 177 | 178 | func Read(port interface{}) interface{} { 179 | return readExpr( 180 | peg.Or{ 181 | syntax, 182 | peg.Bind(peg.Eof, func(x interface{}) interface{} { return EOF_OBJECT }), 183 | }, 184 | port, 185 | ) 186 | } 187 | 188 | func ReadFile(port interface{}) interface{} { 189 | return readExpr( 190 | peg.Select(peg.And{ 191 | peg.Bind(peg.Repeat(syntax), func(x interface{}) interface{} { 192 | return vecToLs(Vector(x.([]interface{}))) 193 | }), 194 | peg.Eof, 195 | }, 0), 196 | port, 197 | ) 198 | } 199 | 200 | func ReadString(s string) interface{} { 201 | return Read(NewInput(strings.NewReader(s))) 202 | } 203 | 204 | func toWrite(def string, obj interface{}) string { 205 | if obj == nil { 206 | return "#v" 207 | } 208 | switch x := obj.(type) { 209 | case bool: 210 | if x { 211 | return "#t" 212 | } else { 213 | return "#f" 214 | } 215 | case *big.Int: 216 | return x.String() 217 | case *InputPort: 218 | return "#" 219 | case *OutputPort: 220 | return "#" 221 | } 222 | return fmt.Sprintf(def, obj) 223 | } 224 | 225 | func Write(obj, port interface{}) interface{} { 226 | p, ok := port.(io.Writer) 227 | if !ok { 228 | TypeError("output-port", port) 229 | } 230 | io.WriteString(p, toWrite("%#v", obj)) 231 | return nil 232 | } 233 | 234 | func Display(obj, port interface{}) interface{} { 235 | p, ok := port.(io.Writer) 236 | if !ok { 237 | TypeError("output-port", port) 238 | } 239 | io.WriteString(p, toWrite("%v", obj)) 240 | return nil 241 | } 242 | -------------------------------------------------------------------------------- /manual.lyx: -------------------------------------------------------------------------------- 1 | #LyX 1.6.4 created this file. For more info see http://www.lyx.org/ 2 | \lyxformat 345 3 | \begin_document 4 | \begin_header 5 | \textclass article 6 | \begin_preamble 7 | \usepackage{tikz} 8 | \end_preamble 9 | \use_default_options true 10 | \language english 11 | \inputencoding auto 12 | \font_roman default 13 | \font_sans default 14 | \font_typewriter default 15 | \font_default_family default 16 | \font_sc false 17 | \font_osf false 18 | \font_sf_scale 100 19 | \font_tt_scale 100 20 | 21 | \graphics default 22 | \paperfontsize default 23 | \spacing single 24 | \use_hyperref false 25 | \papersize a4paper 26 | \use_geometry false 27 | \use_amsmath 1 28 | \use_esint 1 29 | \cite_engine basic 30 | \use_bibtopic false 31 | \paperorientation portrait 32 | \secnumdepth 3 33 | \tocdepth 3 34 | \paragraph_separation indent 35 | \defskip medskip 36 | \quotes_language english 37 | \papercolumns 1 38 | \papersides 1 39 | \paperpagestyle default 40 | \tracking_changes false 41 | \output_changes false 42 | \author "" 43 | \author "" 44 | \end_header 45 | 46 | \begin_body 47 | 48 | \begin_layout Title 49 | Golisp 50 | \end_layout 51 | 52 | \begin_layout Standard 53 | Golisp is a dialect of Lisp written in Go 54 | \begin_inset Foot 55 | status open 56 | 57 | \begin_layout Plain Layout 58 | http://www.golang.org/ 59 | \end_layout 60 | 61 | \end_inset 62 | 63 | . 64 | It has features in common with Scheme 65 | \begin_inset Foot 66 | status open 67 | 68 | \begin_layout Plain Layout 69 | http://www.schemers.org/ 70 | \end_layout 71 | 72 | \end_inset 73 | 74 | , but is much more basic. 75 | If you squint hard enough, it's almost compliant with Scheme standards, 76 | but it doesn't have continuations. 77 | A very simple evaluation mechanism is used, where the list structure is 78 | interpreted directly. 79 | \end_layout 80 | 81 | \begin_layout Standard 82 | Go seems like a good language for implementing interpreters for other languages 83 | in. 84 | It has enough expressiveness to easily define the basics of a Lisp system. 85 | In particular, the garbage collector, the mechanism for dynamic types and 86 | built-in maps greatly eased development. 87 | Some of the built-in APIs and default behaviours are very amenable to this 88 | kind of system. 89 | They make parts of it effortless. 90 | \end_layout 91 | 92 | \begin_layout Standard 93 | \begin_inset CommandInset toc 94 | LatexCommand tableofcontents 95 | 96 | \end_inset 97 | 98 | 99 | \end_layout 100 | 101 | \begin_layout Section 102 | Programming Golisp 103 | \end_layout 104 | 105 | \begin_layout Standard 106 | Golisp is written as a library, but a driver for this exists as a command-line 107 | program, 108 | \family typewriter 109 | gli 110 | \family default 111 | . 112 | You can use this program to experiment with the language, or maybe even 113 | write programs for. 114 | \end_layout 115 | 116 | \begin_layout Subsection 117 | Hello world 118 | \end_layout 119 | 120 | \begin_layout Standard 121 | A hello world might look something like this: 122 | \end_layout 123 | 124 | \begin_layout LyX-Code 125 | (display 126 | \begin_inset Quotes eld 127 | \end_inset 128 | 129 | Hello, world! 130 | \backslash 131 | n 132 | \begin_inset Quotes erd 133 | \end_inset 134 | 135 | ) 136 | \end_layout 137 | 138 | \begin_layout Standard 139 | From this, we can see that strings have C-like syntax: they actually have 140 | the syntax of Go strings. 141 | Also, everything is surrounded by parentheses. 142 | \end_layout 143 | 144 | \begin_layout Subsection 145 | Get started 146 | \end_layout 147 | 148 | \begin_layout Standard 149 | Start the interpreter. 150 | You will be greeted with a prompt: 151 | \end_layout 152 | 153 | \begin_layout LyX-Code 154 | > 155 | \end_layout 156 | 157 | \begin_layout Standard 158 | This is asking you to type in an expression. 159 | You will then get the result of evaluating that expression back. 160 | Everything in Golisp is an expression. 161 | \end_layout 162 | 163 | \begin_layout Section 164 | Embedding Golisp 165 | \end_layout 166 | 167 | \begin_layout Section 168 | Base Language 169 | \end_layout 170 | 171 | \begin_layout Standard 172 | The core of Golisp is based heavily on Scheme. 173 | The surface syntax is based on 174 | \emph on 175 | s-expressions 176 | \emph default 177 | . 178 | There are a small number of 179 | \emph on 180 | standard forms 181 | \emph default 182 | , that everything in the language can be reduced to. 183 | This reduction step is performed by 184 | \emph on 185 | macros 186 | \emph default 187 | , that are defined in terms of 188 | \emph on 189 | functions 190 | \emph default 191 | . 192 | The process of executing a Golisp program involves 193 | \emph on 194 | evaluating 195 | \emph default 196 | a series of 197 | \emph on 198 | expressions 199 | \emph default 200 | , and typically includes 201 | \emph on 202 | function application 203 | \emph default 204 | as the main driver of control. 205 | \end_layout 206 | 207 | \begin_layout Standard 208 | All of the emphasised terms will be discussed below. 209 | \end_layout 210 | 211 | \begin_layout Subsection 212 | S-Expressions 213 | \end_layout 214 | 215 | \begin_layout LyX-Code 216 | ; a comment 217 | \end_layout 218 | 219 | \begin_layout LyX-Code 220 | 1 2.0 ; numbers (fixnum, flonum) 221 | \end_layout 222 | 223 | \begin_layout LyX-Code 224 | \begin_inset Quotes eld 225 | \end_inset 226 | 227 | hello 228 | \begin_inset Quotes erd 229 | \end_inset 230 | 231 | ; string 232 | \end_layout 233 | 234 | \begin_layout LyX-Code 235 | hello a + 2cool4u ; symbols 236 | \end_layout 237 | 238 | \begin_layout LyX-Code 239 | (a b c) [d e f] ; lists 240 | \end_layout 241 | 242 | \begin_layout LyX-Code 243 | () [] ; empty lists 244 | \end_layout 245 | 246 | \begin_layout LyX-Code 247 | (1 . 248 | 2) ; pair 249 | \end_layout 250 | 251 | \begin_layout LyX-Code 252 | (1 2 . 253 | 3) ; improper list 254 | \end_layout 255 | 256 | \begin_layout Subsection 257 | Golisp Expressions 258 | \end_layout 259 | 260 | \begin_layout Subsection 261 | Standard Forms 262 | \end_layout 263 | 264 | \begin_layout LyX-Code 265 | (quote 266 | \emph on 267 | datum 268 | \emph default 269 | ) 270 | \end_layout 271 | 272 | \begin_layout LyX-Code 273 | (if 274 | \emph on 275 | test then else 276 | \emph default 277 | ) 278 | \end_layout 279 | 280 | \begin_layout LyX-Code 281 | (lambda 282 | \emph on 283 | vars body 284 | \emph default 285 | ...) 286 | \end_layout 287 | 288 | \begin_layout LyX-Code 289 | (set! 290 | \emph on 291 | var val 292 | \emph default 293 | ) 294 | \end_layout 295 | 296 | \begin_layout LyX-Code 297 | (define 298 | \emph on 299 | var val 300 | \emph default 301 | ) 302 | \end_layout 303 | 304 | \begin_layout LyX-Code 305 | (define ( 306 | \emph on 307 | name vars 308 | \emph default 309 | ...) 310 | \emph on 311 | body 312 | \emph default 313 | ...) 314 | \end_layout 315 | 316 | \begin_layout LyX-Code 317 | (begin 318 | \emph on 319 | body 320 | \emph default 321 | ...) 322 | \end_layout 323 | 324 | \begin_layout LyX-Code 325 | (local-environment) 326 | \end_layout 327 | 328 | \begin_layout LyX-Code 329 | ( 330 | \emph on 331 | f args 332 | \emph default 333 | ...) 334 | \end_layout 335 | 336 | \begin_layout Standard 337 | The standard forms essentially define the semantics of Golisp. 338 | \end_layout 339 | 340 | \begin_layout Description 341 | quote withholds evaluation. 342 | \end_layout 343 | 344 | \begin_layout Description 345 | if conditionally evaluates. 346 | \end_layout 347 | 348 | \begin_layout Description 349 | lambda creates functions. 350 | \end_layout 351 | 352 | \begin_layout Description 353 | set! modifies variables. 354 | \end_layout 355 | 356 | \begin_layout Description 357 | define mutates the local environment. 358 | \end_layout 359 | 360 | \begin_layout Description 361 | begin groups expressions to be evaluated sequentially. 362 | \end_layout 363 | 364 | \begin_layout Description 365 | local-environment evaluates to the current environment. 366 | It's an experiment. 367 | \end_layout 368 | 369 | \begin_layout Description 370 | function 371 | \begin_inset space ~ 372 | \end_inset 373 | 374 | application calls functions. 375 | \end_layout 376 | 377 | \begin_layout Subsubsection 378 | Quote 379 | \end_layout 380 | 381 | \begin_layout LyX-Code 382 | > (quote a) 383 | \end_layout 384 | 385 | \begin_layout LyX-Code 386 | a 387 | \end_layout 388 | 389 | \begin_layout LyX-Code 390 | > 'a 391 | \end_layout 392 | 393 | \begin_layout LyX-Code 394 | a 395 | \end_layout 396 | 397 | \begin_layout LyX-Code 398 | > ''a 399 | \end_layout 400 | 401 | \begin_layout LyX-Code 402 | (quote a) 403 | \end_layout 404 | 405 | \begin_layout LyX-Code 406 | > (+ 1 2) 407 | \end_layout 408 | 409 | \begin_layout LyX-Code 410 | 3 411 | \end_layout 412 | 413 | \begin_layout LyX-Code 414 | > '(+ 1 2) 415 | \end_layout 416 | 417 | \begin_layout LyX-Code 418 | (+ 1 2) 419 | \end_layout 420 | 421 | \begin_layout LyX-Code 422 | > (eval '(+ 1 2) (root-environment)) 423 | \end_layout 424 | 425 | \begin_layout LyX-Code 426 | 3 427 | \end_layout 428 | 429 | \begin_layout Subsubsection 430 | If 431 | \end_layout 432 | 433 | \begin_layout Subsubsection 434 | Lambda 435 | \end_layout 436 | 437 | \begin_layout Subsubsection 438 | Set! 439 | \end_layout 440 | 441 | \begin_layout Subsubsection 442 | Define 443 | \end_layout 444 | 445 | \begin_layout LyX-Code 446 | > (define a 1) 447 | \end_layout 448 | 449 | \begin_layout LyX-Code 450 | > a 451 | \end_layout 452 | 453 | \begin_layout LyX-Code 454 | 1 455 | \end_layout 456 | 457 | \begin_layout LyX-Code 458 | > (begin (define a 2) a) 459 | \end_layout 460 | 461 | \begin_layout LyX-Code 462 | 2 463 | \end_layout 464 | 465 | \begin_layout LyX-Code 466 | > a 467 | \end_layout 468 | 469 | \begin_layout LyX-Code 470 | 2 471 | \end_layout 472 | 473 | \begin_layout LyX-Code 474 | > ((lambda () (define a 3) a)) 475 | \end_layout 476 | 477 | \begin_layout LyX-Code 478 | 3 479 | \end_layout 480 | 481 | \begin_layout LyX-Code 482 | > a 483 | \end_layout 484 | 485 | \begin_layout LyX-Code 486 | 2 487 | \end_layout 488 | 489 | \begin_layout LyX-Code 490 | 491 | \end_layout 492 | 493 | \begin_layout LyX-Code 494 | 495 | \end_layout 496 | 497 | \begin_layout Subsubsection 498 | Begin 499 | \end_layout 500 | 501 | \begin_layout Subsubsection 502 | Function Application 503 | \end_layout 504 | 505 | \begin_layout LyX-Code 506 | 507 | \end_layout 508 | 509 | \begin_layout Subsection 510 | Functions 511 | \end_layout 512 | 513 | \begin_layout Standard 514 | The core implementation of Golisp, variable management aside, is concerned 515 | primarily with functions and their application. 516 | Functions are first-class values and obey lexical scoping rules. 517 | Functions are properly tail recursive. 518 | That is, if the last thing a function does is call another function, the 519 | callee takes the stack frame of the caller. 520 | This is implemented with a trampoline. 521 | It only works for functions defined in Golisp; primitives do not benefit 522 | from this. 523 | \end_layout 524 | 525 | \begin_layout Subsubsection 526 | Lambda Expressions 527 | \end_layout 528 | 529 | \begin_layout LyX-Code 530 | (lambda 531 | \emph on 532 | vars body 533 | \emph default 534 | ...) 535 | \end_layout 536 | 537 | \begin_layout Subsubsection 538 | Define Statements 539 | \end_layout 540 | 541 | \begin_layout LyX-Code 542 | (define ( 543 | \emph on 544 | name args 545 | \emph default 546 | ...) 547 | \emph on 548 | body 549 | \emph default 550 | ...) 551 | \end_layout 552 | 553 | \begin_layout LyX-Code 554 | => 555 | \end_layout 556 | 557 | \begin_layout LyX-Code 558 | (define 559 | \emph on 560 | name 561 | \emph default 562 | (lambda ( 563 | \emph on 564 | args 565 | \emph default 566 | ...) 567 | \emph on 568 | body 569 | \emph default 570 | ...)) 571 | \end_layout 572 | 573 | \begin_layout Standard 574 | This can be carried on indefinitely. 575 | So, 576 | \end_layout 577 | 578 | \begin_layout LyX-Code 579 | (define (list . 580 | xs) xs) 581 | \end_layout 582 | 583 | \begin_layout LyX-Code 584 | => (define list (lambda xs xs)) 585 | \end_layout 586 | 587 | \begin_layout LyX-Code 588 | (define ((const x) . 589 | _) x) 590 | \end_layout 591 | 592 | \begin_layout LyX-Code 593 | => (define (const x) (lambda _ x)) 594 | \end_layout 595 | 596 | \begin_layout LyX-Code 597 | => (define const (lambda (x) (lambda _ x))) 598 | \end_layout 599 | 600 | \begin_layout Subsubsection 601 | Primitives 602 | \end_layout 603 | 604 | \begin_layout Standard 605 | Primitives are Golisp functions that are implemented in Go. 606 | They have the following type signature. 607 | \end_layout 608 | 609 | \begin_layout LyX-Code 610 | type Primitive func(args Any) Any 611 | \end_layout 612 | 613 | \begin_layout Standard 614 | They provide functionality that is either impossible or very costly to do 615 | in Golisp. 616 | This revolves around access to wider system resources and communication 617 | with them, but also includes things like number manipulation, manipulating 618 | collections, and so on. 619 | \end_layout 620 | 621 | \begin_layout Subsubsection 622 | Application 623 | \end_layout 624 | 625 | \begin_layout Standard 626 | The 627 | \family typewriter 628 | Function 629 | \family default 630 | interface, that all Golisp functions implement, has one method on it, 631 | \family typewriter 632 | Apply(Any) Any 633 | \family default 634 | . 635 | Calling this method will apply the function. 636 | To call a function from Golisp, place it add the head of a list, with the 637 | arguments forming the tail. 638 | \end_layout 639 | 640 | \begin_layout LyX-Code 641 | > (+ 1 2) 642 | \end_layout 643 | 644 | \begin_layout LyX-Code 645 | 3 646 | \end_layout 647 | 648 | \begin_layout LyX-Code 649 | > (+ (* 3 4) 7) 650 | \end_layout 651 | 652 | \begin_layout LyX-Code 653 | 19 654 | \end_layout 655 | 656 | \begin_layout Standard 657 | There is also a facility for passing a list directly into the arguments 658 | from Golisp. 659 | \end_layout 660 | 661 | \begin_layout LyX-Code 662 | > (apply + '(1 2 3)) 663 | \end_layout 664 | 665 | \begin_layout LyX-Code 666 | 6 667 | \end_layout 668 | 669 | \begin_layout LyX-Code 670 | > (apply + 1 '(2 3)) 671 | \end_layout 672 | 673 | \begin_layout LyX-Code 674 | 6 675 | \end_layout 676 | 677 | \begin_layout Subsection 678 | Environments 679 | \end_layout 680 | 681 | \begin_layout LyX-Code 682 | > (= (local-environment) (root-environment)) 683 | \end_layout 684 | 685 | \begin_layout LyX-Code 686 | #t 687 | \end_layout 688 | 689 | \begin_layout LyX-Code 690 | > ((lambda () (= (local-environment) (root-environment)))) 691 | \end_layout 692 | 693 | \begin_layout LyX-Code 694 | #f 695 | \end_layout 696 | 697 | \begin_layout LyX-Code 698 | > (begin (= (local-environment) (root-environment))) 699 | \end_layout 700 | 701 | \begin_layout LyX-Code 702 | #t 703 | \end_layout 704 | 705 | \begin_layout Subsection 706 | Evaluation 707 | \end_layout 708 | 709 | \begin_layout Subsection 710 | Macros 711 | \end_layout 712 | 713 | \begin_layout Section 714 | Library 715 | \end_layout 716 | 717 | \begin_layout Subsection 718 | Numbers 719 | \end_layout 720 | 721 | \begin_layout Subsection 722 | Strings 723 | \end_layout 724 | 725 | \begin_layout Standard 726 | Selecting from, concatenating, searching and converting strings. 727 | Golisp strings are Go strings underneath, and so behave in similar ways: 728 | UTF8 encoded, immutable, and so on. 729 | Converting a string into a vector or list transforms the string into a 730 | sequence of Unicode codepoints represented as fixnums. 731 | \end_layout 732 | 733 | \begin_layout LyX-Code 734 | (string-ref 735 | \emph on 736 | s idx 737 | \emph default 738 | ) 739 | \end_layout 740 | 741 | \begin_layout LyX-Code 742 | (string-length 743 | \emph on 744 | s 745 | \emph default 746 | ) 747 | \end_layout 748 | 749 | \begin_layout LyX-Code 750 | (string-append 751 | \emph on 752 | a b 753 | \emph default 754 | ) 755 | \end_layout 756 | 757 | \begin_layout LyX-Code 758 | (substring 759 | \emph on 760 | s from to 761 | \emph default 762 | ) 763 | \end_layout 764 | 765 | \begin_layout LyX-Code 766 | (string-fold 767 | \emph on 768 | f acc s 769 | \emph default 770 | ) 771 | \end_layout 772 | 773 | \begin_layout LyX-Code 774 | (string->list 775 | \emph on 776 | s 777 | \emph default 778 | ) 779 | \end_layout 780 | 781 | \begin_layout LyX-Code 782 | (string->vector 783 | \emph on 784 | s 785 | \emph default 786 | ) 787 | \end_layout 788 | 789 | \begin_layout LyX-Code 790 | (string->symbol 791 | \emph on 792 | s 793 | \emph default 794 | ) 795 | \end_layout 796 | 797 | \begin_layout LyX-Code 798 | (string->number 799 | \emph on 800 | s 801 | \emph default 802 | ) 803 | \end_layout 804 | 805 | \begin_layout Subsection 806 | Lists 807 | \end_layout 808 | 809 | \begin_layout Standard 810 | A 811 | \emph on 812 | pair 813 | \emph default 814 | is a container for two objects, the 815 | \emph on 816 | car 817 | \emph default 818 | and the 819 | \emph on 820 | cdr 821 | \emph default 822 | . 823 | A list is either the 824 | \emph on 825 | empty list 826 | \emph default 827 | , or a pair with a list as the cdr. 828 | Lists in Golisp are immutable. 829 | \end_layout 830 | 831 | \begin_layout Subsubsection 832 | Primitive Functions 833 | \end_layout 834 | 835 | \begin_layout LyX-Code 836 | (cons 837 | \emph on 838 | a d 839 | \emph default 840 | ) 841 | \end_layout 842 | 843 | \begin_layout LyX-Code 844 | (car 845 | \emph on 846 | p 847 | \emph default 848 | ) 849 | \end_layout 850 | 851 | \begin_layout LyX-Code 852 | (cdr 853 | \emph on 854 | p 855 | \emph default 856 | ) 857 | \end_layout 858 | 859 | \begin_layout Subsubsection 860 | General Manipulations 861 | \end_layout 862 | 863 | \begin_layout LyX-Code 864 | (list 865 | \emph on 866 | xs 867 | \emph default 868 | ...) 869 | \end_layout 870 | 871 | \begin_layout LyX-Code 872 | (length 873 | \emph on 874 | l 875 | \emph default 876 | ) 877 | \end_layout 878 | 879 | \begin_layout LyX-Code 880 | (reverse 881 | \emph on 882 | l 883 | \emph default 884 | ) 885 | \end_layout 886 | 887 | \begin_layout LyX-Code 888 | (append 889 | \emph on 890 | ls ... 891 | \emph default 892 | ) 893 | \end_layout 894 | 895 | \begin_layout LyX-Code 896 | (zip 897 | \emph on 898 | ls ... 899 | \emph default 900 | ) 901 | \end_layout 902 | 903 | \begin_layout Subsubsection 904 | Predicates 905 | \end_layout 906 | 907 | \begin_layout LyX-Code 908 | (pair? 909 | \emph on 910 | p 911 | \emph default 912 | ) 913 | \end_layout 914 | 915 | \begin_layout LyX-Code 916 | (null? 917 | \emph on 918 | x 919 | \emph default 920 | ) 921 | \end_layout 922 | 923 | \begin_layout LyX-Code 924 | (list? 925 | \emph on 926 | l 927 | \emph default 928 | ) 929 | \end_layout 930 | 931 | \begin_layout LyX-Code 932 | (list=? 933 | \emph on 934 | a b 935 | \emph default 936 | ) 937 | \end_layout 938 | 939 | \begin_layout LyX-Code 940 | (proper-list? 941 | \emph on 942 | l 943 | \emph default 944 | ) 945 | \end_layout 946 | 947 | \begin_layout LyX-Code 948 | (improper-list? 949 | \emph on 950 | l 951 | \emph default 952 | ) 953 | \end_layout 954 | 955 | \begin_layout LyX-Code 956 | (circular-list? 957 | \emph on 958 | l 959 | \emph default 960 | ) 961 | \end_layout 962 | 963 | \begin_layout Subsubsection 964 | Selection 965 | \end_layout 966 | 967 | \begin_layout LyX-Code 968 | (caar 969 | \emph on 970 | p 971 | \emph default 972 | ) ... 973 | (cddddr 974 | \emph on 975 | p 976 | \emph default 977 | ) 978 | \end_layout 979 | 980 | \begin_layout LyX-Code 981 | (list-ref 982 | \emph on 983 | l idx 984 | \emph default 985 | ) 986 | \end_layout 987 | 988 | \begin_layout LyX-Code 989 | (list-tail 990 | \emph on 991 | l idx 992 | \emph default 993 | ) 994 | \end_layout 995 | 996 | \begin_layout LyX-Code 997 | (list-head 998 | \emph on 999 | l idx 1000 | \emph default 1001 | ) 1002 | \end_layout 1003 | 1004 | \begin_layout LyX-Code 1005 | (filter 1006 | \emph on 1007 | f l 1008 | \emph default 1009 | ) 1010 | \end_layout 1011 | 1012 | \begin_layout Subsubsection 1013 | Traversal 1014 | \end_layout 1015 | 1016 | \begin_layout LyX-Code 1017 | (map 1018 | \emph on 1019 | f ls ... 1020 | \emph default 1021 | ) 1022 | \end_layout 1023 | 1024 | \begin_layout LyX-Code 1025 | (for-each 1026 | \emph on 1027 | f ls ... 1028 | \emph default 1029 | ) 1030 | \end_layout 1031 | 1032 | \begin_layout LyX-Code 1033 | (fold 1034 | \emph on 1035 | f acc l 1036 | \emph default 1037 | ) 1038 | \end_layout 1039 | 1040 | \begin_layout Subsubsection 1041 | Conversion 1042 | \end_layout 1043 | 1044 | \begin_layout LyX-Code 1045 | (list->vector 1046 | \emph on 1047 | l 1048 | \emph default 1049 | ) 1050 | \end_layout 1051 | 1052 | \begin_layout LyX-Code 1053 | (list->string 1054 | \emph on 1055 | l 1056 | \emph default 1057 | ) 1058 | \end_layout 1059 | 1060 | \begin_layout Subsection 1061 | Vectors 1062 | \end_layout 1063 | 1064 | \begin_layout Standard 1065 | Vectors are equivalent to Go's arrays or slices. 1066 | \end_layout 1067 | 1068 | \begin_layout LyX-Code 1069 | (vector 1070 | \emph on 1071 | xs 1072 | \emph default 1073 | ...) 1074 | \end_layout 1075 | 1076 | \begin_layout LyX-Code 1077 | (make-vector 1078 | \emph on 1079 | size fill 1080 | \emph default 1081 | ) 1082 | \end_layout 1083 | 1084 | \begin_layout LyX-Code 1085 | (vector-ref 1086 | \emph on 1087 | v idx 1088 | \emph default 1089 | ) 1090 | \end_layout 1091 | 1092 | \begin_layout LyX-Code 1093 | (vector-set! 1094 | \emph on 1095 | v idx val 1096 | \emph default 1097 | ) 1098 | \end_layout 1099 | 1100 | \begin_layout LyX-Code 1101 | (vector-slice 1102 | \emph on 1103 | v from to 1104 | \emph default 1105 | ) 1106 | \end_layout 1107 | 1108 | \begin_layout LyX-Code 1109 | (vector->list 1110 | \emph on 1111 | v 1112 | \emph default 1113 | ) 1114 | \end_layout 1115 | 1116 | \begin_layout LyX-Code 1117 | (vector->string 1118 | \emph on 1119 | v 1120 | \emph default 1121 | ) 1122 | \end_layout 1123 | 1124 | \begin_layout Subsection 1125 | Control 1126 | \end_layout 1127 | 1128 | \begin_layout Section 1129 | The Interpreter 1130 | \end_layout 1131 | 1132 | \begin_layout Standard 1133 | The Golisp interpreter is a Go type. 1134 | Many of the mechanisms for interacting with a Golisp system involve communicati 1135 | ng with this object. 1136 | \end_layout 1137 | 1138 | \begin_layout Subsection 1139 | Scopes and Environments 1140 | \end_layout 1141 | 1142 | \begin_layout LyX-Code 1143 | type Any interface{} 1144 | \end_layout 1145 | 1146 | \begin_layout LyX-Code 1147 | 1148 | \end_layout 1149 | 1150 | \begin_layout LyX-Code 1151 | type Symbol string 1152 | \end_layout 1153 | 1154 | \begin_layout LyX-Code 1155 | 1156 | \end_layout 1157 | 1158 | \begin_layout LyX-Code 1159 | type Environment map[Symbol] Any 1160 | \end_layout 1161 | 1162 | \begin_layout LyX-Code 1163 | 1164 | \end_layout 1165 | 1166 | \begin_layout LyX-Code 1167 | type Scope struct { 1168 | \end_layout 1169 | 1170 | \begin_layout LyX-Code 1171 | env Environment 1172 | \end_layout 1173 | 1174 | \begin_layout LyX-Code 1175 | parent *Scope 1176 | \end_layout 1177 | 1178 | \begin_layout LyX-Code 1179 | } 1180 | \end_layout 1181 | 1182 | \begin_layout Standard 1183 | An environment provides a mapping from Symbols to arbitrary objects. 1184 | A scope strings environments together and co-ordinates evaluation. 1185 | Therefore most of the more interesting methods are on the Scope type: 1186 | \end_layout 1187 | 1188 | \begin_layout LyX-Code 1189 | func New() *Scope 1190 | \end_layout 1191 | 1192 | \begin_layout LyX-Code 1193 | func NewScope(parent *Scope) *Scope 1194 | \end_layout 1195 | 1196 | \begin_layout LyX-Code 1197 | func (self *Scope) Eval(x Any) Any 1198 | \end_layout 1199 | 1200 | \begin_layout LyX-Code 1201 | func (self *Scope) EvalString(x string) Any 1202 | \end_layout 1203 | 1204 | \begin_layout LyX-Code 1205 | func (self *Scope) Expand(x Any) Any 1206 | \end_layout 1207 | 1208 | \begin_layout LyX-Code 1209 | func (self *Scope) Bind(env Environment) 1210 | \end_layout 1211 | 1212 | \begin_layout LyX-Code 1213 | func (self *Scope) Lookup(x string) Any 1214 | \end_layout 1215 | 1216 | \begin_layout LyX-Code 1217 | func (self *Scope) Load(path string) os.Error 1218 | \end_layout 1219 | 1220 | \begin_layout LyX-Code 1221 | func (self *Scope) Repl(in io.Reader, out io.Writer) 1222 | \end_layout 1223 | 1224 | \begin_layout Subsubsection 1225 | New, NewScope 1226 | \end_layout 1227 | 1228 | \begin_layout Standard 1229 | New creates a new interpreter. 1230 | This is seeded with a default set of primitives, as well as loading a prelude. 1231 | NewScope creates a scope that can refer to a parent scope. 1232 | You probably won't need to use this unless you're pulling some funny business. 1233 | \end_layout 1234 | 1235 | \begin_layout Subsubsection 1236 | Eval, EvalString 1237 | \end_layout 1238 | 1239 | \begin_layout Standard 1240 | Evaluate an expression in the given scope. 1241 | The expression can be either encoded as a string, or as the corresponding 1242 | internal representation. 1243 | \end_layout 1244 | 1245 | \begin_layout Subsubsection 1246 | Expand 1247 | \end_layout 1248 | 1249 | \begin_layout Standard 1250 | Take an expression, and perform macro expansion on it, returning the result 1251 | of that process. 1252 | \end_layout 1253 | 1254 | \begin_layout Subsubsection 1255 | Bind, Lookup 1256 | \end_layout 1257 | 1258 | \begin_layout Standard 1259 | Bind takes an environment and merges its contents with the scope in question. 1260 | Lookup allows for the retrieval of symbols bound in the current scope. 1261 | \end_layout 1262 | 1263 | \begin_layout Subsubsection 1264 | Load, Repl 1265 | \end_layout 1266 | 1267 | \begin_layout Standard 1268 | High-level control of the interpreter. 1269 | Load evaluates the contents of a file in the current scope. 1270 | Repl connects to a reader and writer (typically stdin and stdout respectively) 1271 | and reads lines in, evaluates them and then prints them, until EOF. 1272 | Your basic interpreter loop. 1273 | \end_layout 1274 | 1275 | \begin_layout Section 1276 | Errors 1277 | \end_layout 1278 | 1279 | \begin_layout Standard 1280 | Go raised some consternation from some quarters when it was revealed because 1281 | it lacked exceptions. 1282 | It may surprise those who made such statements that the author of this 1283 | document is somewhat embarassed to reveal that Golisp currently handles 1284 | errors in much the same way as exceptions. 1285 | This is because a much more powerful notion, one that encompasses exceptions, 1286 | breaks, continues and immediate returns, coroutines and whatever else the 1287 | clever hacker can imagine, exists in Scheme. 1288 | \end_layout 1289 | 1290 | \begin_layout Standard 1291 | Errors are objects that are treated specially by the runtime. 1292 | All of the internals of the interpreter will ferry an error object up the 1293 | call chain. 1294 | Primitives must handle error objects explicitly, in much the same way as 1295 | errors in Go are normally handled. 1296 | 1297 | \family typewriter 1298 | Failed(x) 1299 | \family default 1300 | will return true if 1301 | \family typewriter 1302 | x 1303 | \family default 1304 | is an error object. 1305 | The obvious thing to do with error objects is to return them immediately; 1306 | Golisp provides mechanisms for handling errors within the language. 1307 | This is your basic try-catch mechanism. 1308 | Full continuations may appear at some point; until then, this special case 1309 | is most pressing. 1310 | \end_layout 1311 | 1312 | \begin_layout Subsection 1313 | Emission 1314 | \end_layout 1315 | 1316 | \begin_layout LyX-Code 1317 | (throw 1318 | \emph on 1319 | kind 1320 | \emph default 1321 | 1322 | \emph on 1323 | msg 1324 | \emph default 1325 | ) 1326 | \end_layout 1327 | 1328 | \begin_layout LyX-Code 1329 | (error 1330 | \emph on 1331 | msg 1332 | \emph default 1333 | ) 1334 | \end_layout 1335 | 1336 | \begin_layout LyX-Code 1337 | (type-error 1338 | \emph on 1339 | type x 1340 | \emph default 1341 | ) 1342 | \end_layout 1343 | 1344 | \begin_layout Standard 1345 | Signal different kinds of error. 1346 | \end_layout 1347 | 1348 | \begin_layout Subsection 1349 | Reception 1350 | \end_layout 1351 | 1352 | \begin_layout LyX-Code 1353 | (catch 1354 | \emph on 1355 | thk hnd 1356 | \emph default 1357 | ) 1358 | \end_layout 1359 | 1360 | \begin_layout Standard 1361 | Call thk, and if it results in an error, call hnd with the properties of 1362 | the error. 1363 | If an error was raised, catch evaluates to the result of 1364 | \family typewriter 1365 | hnd 1366 | \family default 1367 | , otherwise it evaluates to the result of 1368 | \family typewriter 1369 | thk 1370 | \family default 1371 | . 1372 | An error may be signalled in 1373 | \family typewriter 1374 | hnd 1375 | \family default 1376 | , at which point another handler further up the chain is invoked. 1377 | The handler for 1378 | \family typewriter 1379 | load 1380 | \family default 1381 | stops and rethrows the error object; it is up to the programmer to handle 1382 | abnormal termination. 1383 | The REPL installs a handler that simply prints the error and carries on. 1384 | \end_layout 1385 | 1386 | \begin_layout LyX-Code 1387 | > (/ 1 0) 1388 | \end_layout 1389 | 1390 | \begin_layout LyX-Code 1391 | error: division by zero 1392 | \end_layout 1393 | 1394 | \begin_layout LyX-Code 1395 | > (catch (lambda () (/ 1 0)) (lambda (kind msg) msg)) 1396 | \end_layout 1397 | 1398 | \begin_layout LyX-Code 1399 | \begin_inset Quotes eld 1400 | \end_inset 1401 | 1402 | division by zero 1403 | \begin_inset Quotes erd 1404 | \end_inset 1405 | 1406 | 1407 | \end_layout 1408 | 1409 | \begin_layout LyX-Code 1410 | > (catch (lambda () (/ 1 0)) (lambda (kind msg) (throw kind msg))) 1411 | \end_layout 1412 | 1413 | \begin_layout LyX-Code 1414 | error: division by zero 1415 | \end_layout 1416 | 1417 | \begin_layout LyX-Code 1418 | > 1419 | \end_layout 1420 | 1421 | \end_body 1422 | \end_document 1423 | -------------------------------------------------------------------------------- /prelude.golisp: -------------------------------------------------------------------------------- 1 | ;; primitive type predicates 2 | (define (is? x t) (== (type-of x) t)) 3 | (define (boolean? x) (is? x 'boolean)) 4 | (define (fixnum? x) (is? x 'fixnum)) 5 | (define (bignum? x) (is? x 'bignum)) 6 | (define (flonum? x) (is? x 'flonum)) 7 | (define (number? x) (if (fixnum? x) #t (if (flonum? x) #t (bignum? x)))) 8 | (define (string? x) (is? x 'string)) 9 | (define (symbol? x) (is? x 'symbol)) 10 | (define (pair? x) (is? x 'pair)) 11 | (define (vector? x) (is? x 'vector)) 12 | (define (macro? x) (is? x 'macro)) 13 | (define (function? x) (is? x 'function)) 14 | (define (input-port? x) (is? x 'input-port)) 15 | (define (output-port? x) (is? x 'output-port)) 16 | (define (channel? x) (is? x 'channel)) 17 | 18 | ;; broader type predicates 19 | (define (atom? x) (not (sequence? x))) 20 | (define (sequence? x) (if (vector? x) #t (pair? x))) 21 | 22 | ;; basic stuff 23 | (define (id x) x) 24 | (define (object->boolean x) (if x #t #f)) 25 | (define (not x) (if x #f #t)) 26 | (define (zero? x) (if (== x 0) #t (== x 0.0))) 27 | (define (even? x) (= (remainder x 2) 0)) 28 | (define (odd? x) (not (even? x))) 29 | (define (1- x) (fixnum-sub x 1)) 30 | (define (1+ x) (fixnum-add x 1)) 31 | (define (list . xs) xs) 32 | (define (null? x) (== x ())) 33 | (define (vector . xs) (list->vector xs)) 34 | (define ((const x) . _) x) 35 | (define void (const #v)) 36 | (define ((compose f g) x) (f (g x))) 37 | (define ((curry f . first) . rest) (apply f (append first rest))) 38 | (define ((pred->guard p) x) (if (p x) x #f)) 39 | (define ((guard->pred g) x) (object->boolean (g x))) 40 | (define (error msg) (throw 'error msg)) 41 | 42 | ;; strings 43 | (define string->list (compose vector->list string->vector)) 44 | (define list->string (compose vector->string list->vector)) 45 | 46 | (define (substring s start end) 47 | (vector->string (vector-slice (string->vector s) start end))) 48 | 49 | (define (string-ref s idx) 50 | (substring s idx (1+ idx))) 51 | 52 | (define (string-append . ss) 53 | (string-join ss "")) 54 | 55 | ;; list accessors 56 | (define caar (compose car car)) 57 | (define cadr (compose car cdr)) 58 | (define cdar (compose cdr car)) 59 | (define cddr (compose cdr cdr)) 60 | (define caaar (compose car caar)) 61 | (define caadr (compose car cadr)) 62 | (define cadar (compose car cdar)) 63 | (define caddr (compose car cddr)) 64 | (define cdaar (compose cdr caar)) 65 | (define cdadr (compose cdr cadr)) 66 | (define cddar (compose cdr cdar)) 67 | (define cdddr (compose cdr cddr)) 68 | (define caaaar (compose car caaar)) 69 | (define caaadr (compose car caadr)) 70 | (define caadar (compose car cadar)) 71 | (define caaddr (compose car caddr)) 72 | (define cadaar (compose car cdaar)) 73 | (define cadadr (compose car cdadr)) 74 | (define caddar (compose car cddar)) 75 | (define cadddr (compose car cdddr)) 76 | (define cdaaar (compose cdr caaar)) 77 | (define cdaadr (compose cdr caadr)) 78 | (define cdadar (compose cdr cadar)) 79 | (define cdaddr (compose cdr caddr)) 80 | (define cddaar (compose cdr cdaar)) 81 | (define cddadr (compose cdr cdadr)) 82 | (define cdddar (compose cdr cddar)) 83 | (define cddddr (compose cdr cdddr)) 84 | 85 | ;; list traversal 86 | (define (fold f acc l) 87 | (if (null? l) 88 | acc 89 | (fold f (f (car l) acc) (cdr l)))) 90 | 91 | (define (filter p l) 92 | (define (f x acc) (if (p x) (cons x acc) acc)) 93 | (fold f () l)) 94 | 95 | (define (map f l . ls) 96 | (if (null? ls) 97 | (reverse (fold (lambda (x acc) (cons (f x) acc)) () l)) 98 | (map (lambda (xs) (apply f xs)) (apply zip (cons l ls))))) 99 | 100 | (define (length l) 101 | (fold (lambda (_ acc) (1+ acc)) 0 l)) 102 | 103 | ;; list munging 104 | (define (reverse l) 105 | (fold cons () l)) 106 | 107 | (define (zip l . ls) 108 | (define (iter acc ls) 109 | (if (null? (filter null? ls)) 110 | (iter (cons (map car ls) acc) (map cdr ls)) 111 | acc)) 112 | (reverse (iter () (cons l ls)))) 113 | 114 | (define (append . ls) 115 | (if (null? ls) 116 | () 117 | (begin 118 | (set! ls (reverse ls)) 119 | (fold (lambda (l acc) (fold cons acc (reverse l))) (car ls) (cdr ls))))) 120 | 121 | ;; backquote magic 122 | (define-macro (quasiquote tmplt) 123 | (if (pair? tmplt) 124 | (fold (lambda (cell acc) 125 | (if (pair? cell) 126 | (if (== (car cell) 'unquote) 127 | (list 'cons (cadr cell) acc) 128 | (if (== (car cell) 'unquote-splicing) 129 | (if (null? acc) 130 | (cadr cell) 131 | (list 'append (cadr cell) acc)) 132 | (list 'cons (list 'quasiquote cell) acc))) 133 | (list 'cons (list 'quote cell) acc))) 134 | () 135 | (reverse tmplt)) 136 | (list 'quote tmplt))) 137 | 138 | ;; aux macros 139 | (define-macro (define-gensyms . ss) 140 | `(begin ,@(map (lambda (s) `(define ,s (gensym))) ss))) 141 | 142 | (define-macro (when t . b) 143 | `(if ,t (begin ,@b) #v)) 144 | 145 | (define-macro (unless t . b) 146 | `(when (not ,t) ,@b)) 147 | 148 | (define-macro (define* . vs) 149 | `(begin ,@(map (lambda (v) `(define ,v #v)) vs))) 150 | 151 | (define-macro (optional args . vs) 152 | (define-gensyms tmp) 153 | `(begin ,@(map (lambda (v) 154 | `(define ,v (if (null? ,args) 155 | #f 156 | (let ([,tmp (car ,args)]) 157 | (set! ,args (cdr ,args)) 158 | ,tmp)))) 159 | vs))) 160 | 161 | ;; main macro set 162 | (define-macro (let bs . b) 163 | (define (named-let name bs b) 164 | `(letrec ([,name (lambda ,(map car bs) ,@b)]) 165 | (,name ,@(map cadr bs)))) 166 | (if (if (null? bs) #t (pair? bs)) 167 | `((lambda ,(map car bs) ,@b) ,@(map cadr bs)) 168 | (named-let bs (car b) (cdr b)))) 169 | 170 | (define-macro (let* bs . b) 171 | (fold (lambda (x acc) `(let (,x) ,acc)) 172 | `(begin ,@b) 173 | (reverse bs))) 174 | 175 | (define-macro (letrec bs . b) 176 | `((lambda () 177 | ,@(map (curry list 'define) 178 | (map car bs) 179 | (map cadr bs)) 180 | ,@b))) 181 | 182 | (define-macro (and . cs) 183 | (if (null? cs) 184 | #t 185 | (if (null? (cdr cs)) 186 | (car cs) 187 | `(if ,(car cs) 188 | (and ,@(cdr cs)) 189 | #f)))) 190 | 191 | (define-macro (or . cs) 192 | (define-gensyms val) 193 | (if (null? cs) 194 | #f 195 | `(let ([,val ,(car cs)]) 196 | (if ,val 197 | ,val 198 | (or ,@(cdr cs)))))) 199 | 200 | (define-macro (cond . cs) 201 | (unless (null? cs) 202 | (let ([c (car cs)]) 203 | (define-gensyms val) 204 | (if (== (car c) 'else) 205 | `(begin ,@(cdr c)) 206 | `(if ,(car c) 207 | (begin ,@(cdr c)) 208 | (cond ,@(cdr cs))))))) 209 | 210 | (define-macro (do vars test . cmds) 211 | (define-gensyms loop) 212 | `(let ,loop ,(zip (map car vars) (map cadr vars)) 213 | (if ,(car test) 214 | (begin 215 | ,@(cdr test)) 216 | (begin 217 | ,@cmds 218 | (,loop ,@(map (lambda (var) 219 | (if (null? (cddr var)) 220 | (car var) 221 | (caddr var))) 222 | vars)))))) 223 | 224 | ;; fix some of the primitive functions 225 | (define-macro (define-wrapped head . body) 226 | (if (pair? head) 227 | `(define-wrapped ,(car head) (lambda ,(cdr head) ,@body)) 228 | `(define ,head (let ([,head ,head]) ,@body)))) 229 | 230 | (define-wrapped (apply f . arglst) 231 | (set! arglst (reverse arglst)) 232 | (apply f (fold cons (car arglst) (cdr arglst)))) 233 | 234 | (define-wrapped (eval expr . rest) 235 | (optional rest env) 236 | (eval expr (if env env (root-environment)))) 237 | 238 | (define-wrapped (load file . rest) 239 | (optional rest env) 240 | (load file (if env env (root-environment)))) 241 | 242 | (define-wrapped (write x . rest) 243 | (optional rest pt) 244 | (write x (if pt pt (standard-output)))) 245 | 246 | (define-wrapped (display x . rest) 247 | (optional rest pt) 248 | (display x (if pt pt (standard-output)))) 249 | 250 | (define-wrapped (read x . rest) 251 | (optional rest pt) 252 | (read x (if pt pt (standard-input)))) 253 | 254 | (define (newline . pt) 255 | (apply display "\n" pt)) 256 | 257 | ;; more list stuff 258 | (define* proper-list? improper-list?) 259 | (let () 260 | (define (list-type x) 261 | (cond 262 | [(null? x) 'proper] 263 | [(pair? x) (list-type (cdr x))] 264 | [else 'improper])) 265 | (define (proper? x) 266 | (== (list-type x) 'proper)) 267 | (define (improper? x) 268 | (and (pair? x) 269 | (== (list-type x) 'improper))) 270 | (set! proper-list? proper?) 271 | (set! improper-list? improper?)) 272 | 273 | (define list? proper-list?) 274 | 275 | ;; selection 276 | (define (list-tail ls idx) 277 | (do ([cur ls (cdr cur)] 278 | [x idx (1- x)]) 279 | [(zero? x) cur])) 280 | 281 | (define (list-head ls idx) 282 | (reverse (list-tail (reverse ls) (- (length ls) idx)))) 283 | 284 | (define (list-ref ls idx) 285 | (car (list-tail ls idx))) 286 | 287 | ;; searching 288 | (define (member k ls) 289 | (do ([cur ls (cdr cur)]) 290 | [(= k (car cur)) cur])) 291 | 292 | (define (assoc k ls) 293 | (do ([cur ls (cdr cur)]) 294 | [(= k (caar cur)) (car cur)])) 295 | 296 | ;; equality 297 | (define (list=? a b) 298 | (and (list? a) 299 | (list? b) 300 | (== (length a) (length b)) 301 | (fold (lambda (a+b acc) 302 | (and acc 303 | (apply = a+b))) 304 | #t 305 | (zip a b)))) 306 | 307 | (define (vector=? a b) 308 | (define l (vector-length a)) 309 | (and (vector? a) 310 | (vector? b) 311 | (== l (vector-length b)) 312 | (let lp ([i 0]) 313 | (cond 314 | [(== i l) #t] 315 | [(not (= (vector-ref a i) (vector-ref b i))) #f] 316 | [else (lp (1+ i))])))) 317 | 318 | (define (= a b) 319 | ((cond 320 | [(list? a) list=?] 321 | [(vector? a) vector=?] 322 | [else ==]) 323 | a b)) 324 | 325 | ;; numbers 326 | (define* + - * /) 327 | (let () 328 | (define ((num-op fix flo) a b) 329 | (if (and (fixnum? a) (fixnum? b)) 330 | (fix a b) 331 | (flo (fixnum->flonum a) (fixnum->flonum b)))) 332 | (set! + (num-op fixnum-add flonum-add)) 333 | (set! - (num-op fixnum-sub flonum-sub)) 334 | (set! * (num-op fixnum-mul flonum-mul)) 335 | (set! / (num-op fixnum-div flonum-div))) 336 | 337 | ;; control 338 | (define (dynamic-wind before thk after) 339 | (define done #f) 340 | (before) 341 | (catch (lambda () (thk) (set! done #t) (after)) 342 | (lambda (k m) (unless done (after)) (throw k m)))) 343 | 344 | (define (call/ec f) 345 | (define msg (gensym)) 346 | (catch (lambda () (f (lambda (x) (throw msg x)))) 347 | (lambda (k m) (if (== k msg) m (throw k m))))) 348 | 349 | (define (<- ch . v) 350 | (cond 351 | [(null? v) (channel-receive ch)] 352 | [(null? (cdr v)) (channel-send ch (car v))] 353 | [else (error "<-: wrong number of arguments")])) 354 | 355 | --------------------------------------------------------------------------------