diff --git a/.github/workflows/go.yml b/.github/workflows/go.yml deleted file mode 100644 index 05de0e1..0000000 --- a/.github/workflows/go.yml +++ /dev/null @@ -1,31 +0,0 @@ -name: Go -on: [push] -jobs: - - build: - name: Build - runs-on: ubuntu-latest - steps: - - - name: Set up Go 1.13 - uses: actions/setup-go@v1 - with: - go-version: 1.15 - id: go - - - name: Check out code into the Go module directory - uses: actions/checkout@v1 - - - name: Get dependencies - run: | - go get -v -t -d ./... - if [ -f Gopkg.toml ]; then - curl https://raw.githubusercontent.com/golang/dep/master/install.sh | sh - dep ensure - fi - - - name: Build - run: go build -v . - - - name: Test - run: go test ./... diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml deleted file mode 100644 index 3153577..0000000 --- a/.github/workflows/release.yml +++ /dev/null @@ -1,32 +0,0 @@ -name: goreleaser - -on: - pull_request: - push: - -jobs: - goreleaser: - runs-on: ubuntu-latest - steps: - - - name: Checkout - uses: actions/checkout@v2 - - - name: Unshallow - run: git fetch --prune --unshallow - - - name: Set up Go - uses: actions/setup-go@v1 - with: - go-version: 1.13.x - - - name: Get dependencies - run: go get -v -t -d ./... - - - name: Run GoReleaser - uses: goreleaser/goreleaser-action@v1 - with: - version: latest - args: release --rm-dist - env: - GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} diff --git a/.gitignore b/.gitignore index d7ec88a..a1338d6 100644 --- a/.gitignore +++ b/.gitignore @@ -12,9 +12,3 @@ # Project-local glide cache, RE: https://github.com/Masterminds/glide/issues/736 .glide/ - -# Subproject -islisp.js.org - -iris -**/__* \ No newline at end of file diff --git a/.gitpod.yml b/.gitpod.yml deleted file mode 100644 index 0114a09..0000000 --- a/.gitpod.yml +++ /dev/null @@ -1,3 +0,0 @@ -vscode: - extensions: - - golang.Go diff --git a/.goreleaser.yml b/.goreleaser.yml deleted file mode 100644 index 3831264..0000000 --- a/.goreleaser.yml +++ /dev/null @@ -1,14 +0,0 @@ -builds: -- env: - - CGO_ENABLED=0 -archives: -- replacements: - darwin: Darwin - linux: Linux - windows: Windows - 386: i386 - amd64: x86_64 -checksum: - name_template: 'checksums.txt' -snapshot: - name_template: "{{ .Tag }}-next" diff --git a/.iris_completions b/.iris_completions deleted file mode 100644 index fdc4102..0000000 --- a/.iris_completions +++ /dev/null @@ -1,312 +0,0 @@ -&rest -*most-negative-float* -*most-positive-float* -*pi* -+ -, -,@ -- -/= -:abstractp -:accessor -:after -:around -:before -:boundp -:generic-function-class -:initarg -:initform -:metaclass -:method -:method-combination -:reader -:rest -:writer -< -<= -= -> ->= -` -#| -|# -abs -and -append -apply -aref -arithmetic-error-operands -arithmetic-error-operation -array -array-dimensions -assoc -assure -atan -atan2 -atanh -basic-array*-p -basic-array-p -basic-vector-p -block -booleans -call-next-method -car -case -case-using -catch -catch -cdr -ceiling -cerror -char-index -char/= -char< -char<= -char= -char> -char>= -character -character -characterp -class -class -class-of -close -coercion -comment -cond -condition -condition-continuable -cons -cons -consp -constant -constants -constructor -continue-condition -control -conventions -convert -cos -cosh -create -create-array -create-list -create-string -create-string-input-stream -create-string-output-stream -create-vector -declarations -defclass -defconstant -defdynamic -defgeneric -defglobal -defining-form -defmacro -defmethod -defun -div -domain-error-expected-class -domain-error-object -dynamic -dynamic -dynamic-let -dynamic-variable -elt -eq -eql -equal -error -error-output -establishing -evaluation -evaluation -execution -exp -expt -extension -extent -file-length -file-position -files -finish-output -flet -float -float -floatp -floor -for -form -format -format-arguments -format-char -format-float -format-fresh-line -format-integer -format-object -format-string -format-tab -funcall -function -function -function-name -functionp -garef -gcd -general-array*-p -general-vector-p -generic-function-name -generic-function-p -gensym -get-internal-real-time -get-internal-run-time -get-output-stream-string -get-universal-time -go -handler -handler, -identifier -identity -if -ignore-errors -initialize-object -input-stream-p -instance -instancep -integer -integerp -internal-time-units-per-second -isqrt -keyword -labels -lambda -lcm -length -let -let* -list -list -listp -log -macro -map-into -mapc -mapcan -mapcar -mapcon -mapl -maplist -max -member -metaclass -method -min -mod -next-method-p -nil -not -nreverse -null -null -number -numberp -object -object -open-input-file -open-io-file -open-output-file -open-stream-p -operands -operation -operator -operator -or -output-stream-p -parse-error-expected-class -parse-error-string -parse-number -predicates -preview-char -probe-file -progn -program -property -quasiquote -quote -quotient -read -read-byte -read-char -read-line -reciprocal -remove-property -report-condition -return-from -reverse -round -set-aref -set-car -set-cdr -set-dynamic -set-elt -set-file-position -set-garef -set-property -set-up -setf -setq -signal-condition -simple-error-format-arguments -simple-error-format-string -sin -sinh -slot -sqrt -standard-input -standard-output -stream -stream-error-stream -stream-ready-p -streamp -string -string-append -string-index -string/= -string< -string<= -string= -string> -string>= -stringp -subclass -subclassp -subseq -superclass -symbol -symbolp -t -tagbody -tagbody -tan -tanh -terminology -text -the -throw -truncate -undefined-entity-name -undefined-entity-namespace -unwind-protect -vector -vector -while -with-error-output -with-handler -with-open-input-file -with-open-io-file -with-open-output-file -with-standard-input -with-standard-output -write-byte -writer diff --git a/.tool-versions b/.tool-versions deleted file mode 100644 index 5fa6342..0000000 --- a/.tool-versions +++ /dev/null @@ -1 +0,0 @@ -golang 1.15 diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..6c6ff55 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,3 @@ +language: go +script: + - go test -v ./... \ No newline at end of file diff --git a/.vscode/test.code-snippets b/.vscode/test.code-snippets deleted file mode 100644 index ba8f388..0000000 --- a/.vscode/test.code-snippets +++ /dev/null @@ -1,34 +0,0 @@ -{ - // Place your iris workspace snippets here. Each snippet is defined under a snippet name and has a scope, prefix, body and - // description. Add comma separated ids of the languages where the snippet is applicable in the scope field. If scope - // is left empty or omitted, the snippet gets applied to all languages. The prefix is what is - // used to trigger the snippet and the body will be expanded and inserted. Possible variables are: - // $1, $2 for tab stops, $0 for the final cursor position, and ${1:label}, ${2:another} for placeholders. - // Placeholders with the same ids are connected. - // Example: - // "Print to console": { - // "scope": "javascript,typescript", - // "prefix": "log", - // "body": [ - // "console.log('$1');", - // "$2" - // ], - // "description": "Log output to console" - // } - "Test": { - "scope": "golang,go", - "prefix": "test", - "body": [ - "func Test$1(t *testing.T) {", - " execTests(t, $1, []test{", - " {", - " exp: `$0`,", - " want: ``,", - " wantErr: false,", - " },", - " })", - "}" - ], - "description": "Log output to console" - } -} \ No newline at end of file diff --git a/Makefile b/Makefile deleted file mode 100644 index ec384cb..0000000 --- a/Makefile +++ /dev/null @@ -1,4 +0,0 @@ -all: - go build . -test: - go test -cover ./... diff --git a/README.md b/README.md index 4c74975..4ebf917 100644 --- a/README.md +++ b/README.md @@ -1,20 +1,49 @@ -# ![IRIS](https://typography.deno.dev/render?text=IRIS&family=Zilla+Slab+Highlight&weight=700&size=30&color=%23000000) +# iris -IRIS is a interpreter of ISLisp implemented with golang. +Iris is a interpreter of ISLisp implemented with golang + +[![Build Status](https://travis-ci.org/ta2gch/iris.svg?branch=master)](https://travis-ci.org/ta2gch/iris) + +![logo](logo.png) + +## Introduction ISLisp is a member of LISP family and standardized by ISO in 2007. As you know, Common Lisp is standardized by ANSI in 1994. -The webpage and the online REPL are at [islisp.js.org](https://islisp.js.org). +Iris is a interpreter of ISLisp implemented with golang. -## Academic work +Iris has the webpage and the online REPL. [islisp.js.org](islisp.js.org) -We submitted a paper about this work to KSE2021 conference. -In the paper, we referenced the code in `kse2021` branch of this repository. +## Usage -## License +### Install + +You can install iris with `go get` + +```bash +$ go get github.com/ta2gch/iris +``` + +### Update + +You can update iris with `go get` +```bash +$ go get -u github.com/ta2gch/iris +``` + +## Development + +### Test + +Iris is tested on TravisCI with this command. + +``` +$ go test ./... +``` + +## License This software is licensed under the Mozilla Public License v2.0 ## Copyright - -Copyright (c) 2017-2021 islisp-dev All Rights Reserved. +Copyright (c) 2017 TANIGUCHI Masaya　All Rights Reserved. diff --git a/core/basic-array.go b/core/basic-array.go deleted file mode 100644 index f64ab37..0000000 --- a/core/basic-array.go +++ /dev/null @@ -1,83 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package core - -import ( - "fmt" -) - -// General Array * - -type GeneralArrayStar struct { - Vector []*GeneralArrayStar - Scalar Instance -} - -func NewGeneralArrayStar(vector []*GeneralArrayStar, scalar Instance) Instance { - return &GeneralArrayStar{vector, scalar} -} - -func (*GeneralArrayStar) Class() Class { - return GeneralArrayStarClass -} - -func (i *GeneralArrayStar) String() string { - var count func(i *GeneralArrayStar) int - count = func(i *GeneralArrayStar) int { - if i.Vector != nil { - return 1 + count(i.Vector[0]) - } - return 0 - } - var stringify func(i *GeneralArrayStar) string - stringify = func(i *GeneralArrayStar) string { - if i.Vector != nil { - str := "(" - for idx, elt := range i.Vector { - str += stringify(elt) - if idx != len(i.Vector)-1 { - str += " " - } - } - str += ")" - return str - } - return i.Scalar.String() - } - return fmt.Sprintf("#%vA%v", count(i), stringify(i)) -} - -// General Vector - -type GeneralVector []Instance - -func NewGeneralVector(v []Instance) Instance { - return GeneralVector(v) -} - -func (GeneralVector) Class() Class { - return GeneralVectorClass -} - -func (i GeneralVector) String() string { - str := fmt.Sprint([]Instance(i)) - return fmt.Sprintf("#(%v)", str[1:len(str)-1]) -} - -// String - -type String []rune - -func NewString(s []rune) Instance { - return String(s) -} - -func (String) Class() Class { - return StringClass -} - -func (i String) String() string { - return "\"" + string(i) + "\"" -} diff --git a/core/built-in-class.go b/core/built-in-class.go deleted file mode 100644 index e38cc4a..0000000 --- a/core/built-in-class.go +++ /dev/null @@ -1,47 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package core - -import ( - "fmt" -) - -type BuiltInClass struct { - name Instance - supers []Class - slots []Instance -} - -func NewBuiltInClass(name string, super Class, slots ...string) Class { - slotNames := []Instance{} - for _, slot := range slots { - slotNames = append(slotNames, NewSymbol(slot)) - } - return BuiltInClass{NewSymbol(name), []Class{super}, slotNames} -} - -func (p BuiltInClass) Supers() []Class { - return p.supers -} - -func (p BuiltInClass) Slots() []Instance { - return p.slots -} - -func (p BuiltInClass) Initform(arg Instance) (v Instance, ok bool) { - return nil, false -} - -func (p BuiltInClass) Initarg(arg Instance) (v Instance, ok bool) { - return arg, true -} - -func (BuiltInClass) Class() Class { - return BuiltInClassClass -} - -func (p BuiltInClass) String() string { - return fmt.Sprint(p.name) -} diff --git a/core/character.go b/core/character.go deleted file mode 100644 index 24d9065..0000000 --- a/core/character.go +++ /dev/null @@ -1,28 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package core - -// Character - -type Character rune - -func NewCharacter(r rune) Instance { - return Character(r) -} - -func (Character) Class() Class { - return CharacterClass -} - -func (i Character) String() string { - switch rune(i) { - case ' ': - return `#\SPACE` - case '\n': - return `#\NEWLINE` - default: - return `#\` + string(i) - } -} diff --git a/core/environment.go b/core/environment.go deleted file mode 100644 index 57edf1f..0000000 --- a/core/environment.go +++ /dev/null @@ -1,135 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package core - -// Environment struct is the struct for keeping functions and variables -type Environment struct { - // Lexical - BlockTag stack - TagbodyTag stack - Function stack - Variable stack - - // Global - Class stack - Macro stack - Special stack - Property map2 - Constant stack - - // Dynamic - CatchTag stack - DynamicVariable stack // deep biding - StandardInput Instance - StandardOutput Instance - ErrorOutput Instance - Handler Instance -} - -// New creates new eironment -func NewEnvironment(stdin, stdout, stderr, handler Instance) Environment { - e := new(Environment) - - // Lexical - e.BlockTag = NewStack() - e.TagbodyTag = NewStack() - e.Function = NewStack() - e.Variable = NewStack() - - // Global - e.Macro = NewStack() - e.Class = NewStack() - e.Special = NewStack() - e.Constant = NewStack() - e.Property = NewMap2() - - // Dynamic - e.CatchTag = NewStack() - e.DynamicVariable = NewStack() - e.StandardInput = stdin - e.StandardOutput = stdout - e.ErrorOutput = stderr - e.Handler = handler - return *e -} - -func (before *Environment) NewHandler(handler Instance) Environment { - e := NewEnvironment(before.StandardInput, before.StandardOutput, before.ErrorOutput, handler) - - e.BlockTag = before.BlockTag - e.TagbodyTag = before.TagbodyTag - e.Variable = before.Variable - e.Function = before.Function - - e.Macro = before.Macro - e.Class = before.Class - e.Special = before.Special - e.Constant = before.Constant - e.Property = before.Property - - e.CatchTag = before.CatchTag - - return e -} - -func (e *Environment) MergeLexical(before Environment) { - e.BlockTag = before.BlockTag.Append(e.BlockTag[1:]) - e.TagbodyTag = before.TagbodyTag.Append(e.TagbodyTag[1:]) - e.Variable = before.Variable.Append(e.Variable[1:]) - e.Function = before.Function.Append(e.Function[1:]) - - e.Macro = before.Macro.Append(e.Macro[1:]) - e.Class = before.Class.Append(e.Class[1:]) - e.Special = before.Special.Append(e.Special[1:]) - e.Constant = before.Constant.Append(e.Constant[1:]) - e.Property = before.Property - - e.CatchTag = before.CatchTag.Append(e.CatchTag[1:]) - e.DynamicVariable = before.DynamicVariable.Append(e.DynamicVariable[1:]) - e.StandardInput = before.StandardInput - e.StandardOutput = before.StandardOutput - e.ErrorOutput = before.ErrorOutput - e.Handler = before.Handler -} - -func (before *Environment) NewLexical() Environment { - e := NewEnvironment(before.StandardInput, before.StandardOutput, before.ErrorOutput, before.Handler) - - e.BlockTag = before.BlockTag.Append(e.BlockTag) - e.TagbodyTag = before.TagbodyTag.Append(e.TagbodyTag) - e.Variable = before.Variable.Append(e.Variable) - e.Function = before.Function.Append(e.Function) - - e.Macro = before.Macro.Append(e.Macro) - e.Class = before.Class.Append(e.Class) - e.Special = before.Special.Append(e.Special) - e.Constant = before.Constant.Append(e.Constant) - e.Property = before.Property - - e.CatchTag = before.CatchTag.Append(e.CatchTag) - e.DynamicVariable = before.DynamicVariable.Append(e.DynamicVariable) - - return e -} - -func (before *Environment) NewDynamic() Environment { - e := NewEnvironment(before.StandardInput, before.StandardOutput, before.ErrorOutput, before.Handler) - - e.BlockTag = stack{before.BlockTag[0]}.Append(e.BlockTag) - e.TagbodyTag = stack{before.TagbodyTag[0]}.Append(e.TagbodyTag) - e.Variable = stack{before.Variable[0]}.Append(e.Variable) - e.Function = stack{before.Function[0]}.Append(e.Function) - - e.Macro = stack{before.Macro[0]}.Append(e.Macro) - e.Class = stack{before.Class[0]}.Append(e.Class) - e.Special = stack{before.Special[0]}.Append(e.Special) - e.Constant = stack{before.Constant[0]}.Append(e.Constant) - e.Property = before.Property - - e.CatchTag = before.CatchTag.Append(e.CatchTag) - e.DynamicVariable = before.DynamicVariable.Append(e.DynamicVariable) - - return e -} diff --git a/core/error.go b/core/error.go deleted file mode 100644 index 352021d..0000000 --- a/core/error.go +++ /dev/null @@ -1,112 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package core - -var DefaultHandler = NewFunction(NewSymbol("DEFAULT-HANDLER"), func(e Environment, c Instance) (Instance, Instance) { - return nil, c -}) - -func SignalCondition(e Environment, condition, continuable Instance) (Instance, Instance) { - if !InstanceOf(SeriousConditionClass, condition) { - return SignalCondition(e, NewDomainError(e, condition, SeriousConditionClass), Nil) - } - condition.(BasicInstance).SetSlotValue(NewSymbol("IRIS.CONTINUABLE"), continuable, SeriousConditionClass) - _, c := e.Handler.(Applicable).Apply(e, condition) - if InstanceOf(ContinueClass, c) { - o, _ := c.(BasicInstance).GetSlotValue(NewSymbol("IRIS.OBJECT"), ContinueClass) - return o, nil - } - return nil, c -} - -func NewEndOfStream(e Environment) Instance { - return Create(e, EndOfStreamClass) -} - -func NewArithmeticError(e Environment, operation, operands Instance) Instance { - return Create(e, ArithmeticErrorClass, - NewSymbol("OPERATION"), operation, - NewSymbol("OPERANDS"), operands) -} - -func NewDivisionByZero(e Environment, operation, operands Instance) Instance { - return Create(e, DivisionByZeroClass, - NewSymbol("OPERATION"), operation, - NewSymbol("OPERANDS"), operands) -} - -func NewParseError(e Environment, str, expectedClass Instance) Instance { - return Create(e, ParseErrorClass, - NewSymbol("STRING"), str, - NewSymbol("EXPECTED-CLASS"), expectedClass) -} - -func NewDomainError(e Environment, object Instance, expectedClass Class) Instance { - return Create(e, DomainErrorClass, - NewSymbol("OBJECT"), object, - NewSymbol("EXPECTED-CLASS"), expectedClass) -} - -func NewUndefinedFunction(e Environment, name Instance) Instance { - l, c := -1, -1 - if s, ok := name.(Symbol); ok { - l, c = s.Location() - } - loc := NewCons(NewInteger(l), NewInteger(c)) - return Create(e, UndefinedFunctionClass, - NewSymbol("NAME"), name, - NewSymbol("NAMESPACE"), NewSymbol("FUNCTION"), - NewSymbol("IRIS.STACKTRACE"), NewCons(loc, Nil)) -} - -func NewUnboundVariable(e Environment, name Instance) Instance { - l, c := -1, -1 - if s, ok := name.(Symbol); ok { - l, c = s.Location() - } - loc := NewCons(NewInteger(l), NewInteger(c)) - return Create(e, UnboundVariableClass, - NewSymbol("NAME"), name, - NewSymbol("NAMESPACE"), NewSymbol("VARIABLE"), - NewSymbol("IRIS.STACKTRACE"), NewCons(loc, Nil)) -} - -func NewUndefinedClass(e Environment, name Instance) Instance { - l, c := -1, -1 - if s, ok := name.(Symbol); ok { - l, c = s.Location() - } - loc := NewCons(NewInteger(l), NewInteger(c)) - return Create(e, UndefinedEntityClass, - NewSymbol("NAME"), name, - NewSymbol("NAMESPACE"), NewSymbol("CLASS"), - NewSymbol("IRIS.STACKTRACE"), NewCons(loc, Nil)) -} - -func NewArityError(e Environment) Instance { - return Create(e, ProgramErrorClass) -} - -func NewIndexOutOfRange(e Environment) Instance { - return Create(e, ProgramErrorClass) -} - -func NewImmutableBinding(e Environment) Instance { - return Create(e, ProgramErrorClass) -} - -func NewSimpleError(e Environment, formatString, formatArguments Instance) Instance { - return Create(e, SimpleErrorClass, - NewSymbol("FORMAT-STRING"), formatString, - NewSymbol("FORMAT-ARGUMENTS"), formatArguments) -} - -func NewControlError(e Environment) Instance { - return Create(e, ControlErrorClass) -} - -func NewStreamError(e Environment, stream Instance) Instance { - return Create(e, StreamErrorClass, NewSymbol("STREAM"), stream) -} diff --git a/core/instance.go b/core/instance.go deleted file mode 100644 index 3aacd96..0000000 --- a/core/instance.go +++ /dev/null @@ -1,110 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package core - -import ( - "fmt" -) - -// instance - -func Create(e Environment, c Instance, i ...Instance) Instance { - p := []Instance{} - for _, q := range c.(Class).Supers() { - p = append(p, Create(e, q, i...)) - } - return InitializeObject(e, BasicInstance{c.(Class), p, NewHashMap()}, i...) -} - -func InitializeObject(e Environment, object Instance, inits ...Instance) Instance { - for _, super := range object.(BasicInstance).supers { - InitializeObject(e, super, inits...) - } - for i := 0; i < len(inits); i += 2 { - argName := inits[i] - argValue := inits[i+1] - if slotName, ok := object.Class().Initarg(argName); ok { - for _, s := range object.Class().Slots() { - if DeepEqual(slotName, s) { - object.(BasicInstance).SetSlotValue(slotName, argValue, object.Class()) - break - } - } - } - } - for _, slotName := range object.Class().Slots() { - if _, ok := object.(BasicInstance).GetSlotValue(slotName, object.Class()); !ok { - if form, ok := object.Class().Initform(slotName); ok { - value, _ := form.(Applicable).Apply(e.NewDynamic()) - object.(BasicInstance).SetSlotValue(slotName, value, object.Class()) - } - } - } - return object -} - -type BasicInstance struct { - class Class - supers []Instance - slots Map -} - -func (i BasicInstance) Class() Class { - return i.class -} - -func (i BasicInstance) GetSlotValue(key Instance, class Class) (Instance, bool) { - if DeepEqual(i.class, class) { - if v, err := i.slots.Get(key); err == nil { - return v.(Instance), true - } - for _, s := range class.Slots() { - if DeepEqual(s, key) { - return Nil, false - } - } - } - for _, s := range i.supers { - if v, ok := s.(BasicInstance).GetSlotValue(key, class); ok { - return v, true - } - } - return nil, false -} - -func (i BasicInstance) SetSlotValue(key Instance, value Instance, class Class) (ok bool) { - ok = false - if DeepEqual(i.class, class) { - i.slots.Set(key, value) - ok = true - } - for _, s := range i.supers { - ok = ok || s.(BasicInstance).SetSlotValue(key, value, class) - } - return ok -} - -func (i BasicInstance) getAllSlots() Map { - m := NewHashMap() - for _, key := range i.slots.Keys() { - val, _ := i.slots.Get(key) - m.Set(key, val) - } - for _, c := range i.supers { - if _, ok := c.(BasicInstance); ok { - slots := c.(BasicInstance).getAllSlots() - for _, key := range slots.Keys() { - val, _ := slots.Get(key) - m.Set(key, val) - } - } - } - return m -} - -func (i BasicInstance) String() string { - c := i.Class().String() - return fmt.Sprintf("#%v %v>", c[:len(c)-1], i.getAllSlots()) -} diff --git a/core/list.go b/core/list.go deleted file mode 100644 index 7bb788b..0000000 --- a/core/list.go +++ /dev/null @@ -1,120 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package core - -import ( - "fmt" -) - -type List interface { - Slice() []Instance - Nth(i int) Instance - SetNth(obj Instance, i int) - NthCdr(i int) Instance - Length() int -} - -// Cons - -type Cons struct { - Car Instance - Cdr Instance -} - -func NewCons(car, cdr Instance) Instance { - return &Cons{car, cdr} -} - -func (*Cons) Class() Class { - return ConsClass -} - -func (i *Cons) String() string { - str := "(" + fmt.Sprint(i.Car) - cdr := i.Cdr - for InstanceOf(ConsClass, cdr) { - str += fmt.Sprintf(" %v", cdr.(*Cons).Car) // Checked at the top of this loop - cdr = cdr.(*Cons).Cdr // Checked at the top of this loop - } - if InstanceOf(NullClass, cdr) { - str += ")" - } else { - str += fmt.Sprintf(" . %v)", cdr) - } - return str -} - -func (i *Cons) Slice() []Instance { - s := []Instance{} - var cdr Instance = i - for InstanceOf(ConsClass, cdr) { - s = append(s, cdr.(*Cons).Car) - cdr = cdr.(*Cons).Cdr - } - return s -} - -func (i *Cons) Length() int { - return 1 + i.Cdr.(List).Length() -} - -func (i *Cons) Nth(n int) Instance { - if n == 0 { - return i.Car - } - return i.Cdr.(List).Nth(n - 1) -} - -func (i *Cons) SetNth(obj Instance, n int) { - if n == 0 { - i.Car = obj - } - i.Cdr.(List).SetNth(obj, n-1) -} - -func (i *Cons) NthCdr(n int) Instance { - if n == 0 { - return i.Cdr - } - return i.Cdr.(List).NthCdr(n - 1) -} - -// Null - -type Null struct{} - -var Nil = NewNull() - -func NewNull() Instance { - return &Null{} -} - -func (Null) Class() Class { - return NullClass -} - -func (Null) String() string { - return "NIL" -} - -func (Null) Slice() []Instance { - return []Instance{} -} - -func (Null) Nth(n int) Instance { - return Nil -} - -func (Null) SetNth(obj Instance, n int) { - panic("NOT a cons") -} - -func (Null) NthCdr(n int) Instance { - return Nil -} - -func (Null) Length() int { - return 0 -} diff --git a/core/map.go b/core/map.go deleted file mode 100644 index abfae57..0000000 --- a/core/map.go +++ /dev/null @@ -1,86 +0,0 @@ -package core - -import ( - "errors" - "fmt" - - mapset "github.com/deckarep/golang-set" - "github.com/google/go-cmp/cmp" - hashstructure "github.com/mitchellh/hashstructure/v2" -) - -type Map interface { - Set(key, value interface{}) (err error) - Get(key interface{}) (value interface{}, err error) - Delete(key interface{}) (err error) - Keys() []interface{} - String() string -} - -type HashMap struct { - table map[uint64]interface{} - keys mapset.Set -} - -func (m *HashMap) Equal(n interface{}) bool { - c, ok := n.(*HashMap) - if !ok { - return false - } - return cmp.Equal(c.table, m.table) -} - -func NewHashMap() *HashMap { - return &HashMap{map[uint64]interface{}{}, mapset.NewSet()} -} - -func (m *HashMap) Set(key, value interface{}) error { - hash, err := hashstructure.Hash(key, hashstructure.FormatV2, nil) - if err != nil { - return err - } - m.table[hash] = value - m.keys.Add(key) - return nil -} - -func (m *HashMap) Get(key interface{}) (interface{}, error) { - hash, err := hashstructure.Hash(key, hashstructure.FormatV2, nil) - if err != nil { - return nil, err - } - value, ok := m.table[hash] - if !ok { - return nil, errors.New("not found") - } - return value, nil -} - -func (m *HashMap) Delete(key interface{}) error { - hash, err := hashstructure.Hash(key, hashstructure.FormatV2, nil) - if err != nil { - return err - } - delete(m.table, hash) - m.keys.Remove(hash) - return nil -} - -func (m *HashMap) Keys() []interface{} { - return m.keys.ToSlice() -} - -func (m *HashMap) String() (str string) { - str += "{" - keys := m.keys.ToSlice() - for idx, key := range keys { - val, _ := m.Get(key) - str += fmt.Sprintf("%v: %v", key, val) - if idx != len(keys)-1 { - str += ", " - } else { - str += "}" - } - } - return -} diff --git a/core/map2.go b/core/map2.go deleted file mode 100644 index a6cda6f..0000000 --- a/core/map2.go +++ /dev/null @@ -1,29 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package core - -type map2 map[[2]string]Instance - -func NewMap2() map2 { - return map[[2]string]Instance{} -} - -func (s map2) Get(key1, key2 Instance) (Instance, bool) { - if v, ok := s[[2]string{key1.String(), key2.String()}]; ok { - return v, true - } - return nil, false -} -func (s map2) Set(key1, key2, value Instance) { - s[[2]string{key1.String(), key2.String()}] = value -} - -func (s map2) Delete(key1, key2 Instance) (Instance, bool) { - if v, ok := s[[2]string{key1.String(), key2.String()}]; ok { - delete(s, [2]string{key1.String(), key2.String()}) - return v, true - } - return nil, false -} diff --git a/core/stack.go b/core/stack.go deleted file mode 100644 index 1ded7b8..0000000 --- a/core/stack.go +++ /dev/null @@ -1,50 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package core - -type stack []Map - -func NewStack() stack { - return []Map{NewHashMap()} -} - -func (s stack) Get(key Instance) (Instance, bool) { - for i := len(s) - 1; i >= 0; i-- { - if v, err := s[i].Get(key); err == nil { - return v.(Instance), true - } - } - return nil, false -} - -func (s stack) Set(key, value Instance) bool { - for i := len(s) - 1; i >= 0; i-- { - if _, err := s[i].Get(key); err == nil { - s[i].Set(key, value) - return true - } - } - return false -} - -func (s stack) Define(key, value Instance) bool { - if _, err := s[len(s)-1].Get(key); err != nil { - s[len(s)-1].Set(key, value) - return true - } - s[len(s)-1].Set(key, value) - return false -} - -func (s stack) Delete(key Instance) { - s[len(s) - 1].Delete(key) -} - -func (s stack) Append(t stack) stack { - u := stack{} - u = append(u, s...) - u = append(u, t...) - return u -} diff --git a/core/standard-class.go b/core/standard-class.go deleted file mode 100644 index e523b62..0000000 --- a/core/standard-class.go +++ /dev/null @@ -1,55 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package core - -import ( - "fmt" -) - -type StandardClass struct { - name Instance - supers []Class - slots []Instance - initforms Map - initargs Map - metaclass Class - abstractp Instance -} - -func NewStandardClass(name Instance, supers []Class, slots []Instance, initforms, initargs Map, metaclass Class, abstractp Instance) Class { - return StandardClass{name, supers, slots, initforms, initargs, metaclass, abstractp} -} - -func (p StandardClass) Supers() []Class { - return p.supers -} - -func (p StandardClass) Slots() []Instance { - return p.slots -} - -func (p StandardClass) Initform(arg Instance) (Instance, bool) { - val, err := p.initforms.Get(arg) - if err != nil { - return nil, false - } - return val.(Instance), true -} - -func (p StandardClass) Initarg(arg Instance) (Instance, bool) { - val, err := p.initargs.Get(arg) - if err != nil { - return nil, false - } - return val.(Instance), true -} - -func (p StandardClass) Class() Class { - return p.metaclass -} - -func (p StandardClass) String() string { - return fmt.Sprint(p.name) -} diff --git a/core/stream.go b/core/stream.go deleted file mode 100644 index 56d89ef..0000000 --- a/core/stream.go +++ /dev/null @@ -1,51 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package core - -import ( - "bufio" - "io" - "strings" - - "github.com/islisp-dev/iris/reader/tokenizer" -) - -type BufferedWriter struct { - Raw io.Writer - *bufio.Writer -} - -func NewBufferedWriter(w io.Writer) *BufferedWriter { - return &BufferedWriter{w, bufio.NewWriter(w)} -} - -type Stream struct { - Column *int - ElementClass Instance - *tokenizer.BufferedTokenReader - *BufferedWriter -} - -func NewStream(r io.Reader, w io.Writer, e Instance) Instance { - return Stream{new(int), e, tokenizer.NewBufferedTokenReader(r), NewBufferedWriter(w)} -} - -func (Stream) Class() Class { - return StreamClass -} - -func (s Stream) Write(p []byte) (n int, err error) { - i := strings.LastIndex(string(p), "\n") - if i < 0 { - *s.Column += len(p) - } else { - *s.Column = len(p[i+1:]) - } - return s.Writer.Write(p) -} - -func (Stream) String() string { - return "#" -} diff --git a/core/symbol.go b/core/symbol.go deleted file mode 100644 index 1d8b638..0000000 --- a/core/symbol.go +++ /dev/null @@ -1,47 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package core - -import hashstructure "github.com/mitchellh/hashstructure/v2" - -// Symbol - -type Symbol struct { - str string - line, column int -} - -func (x Symbol) Hash() (uint64, error) { - return hashstructure.Hash(x.str, hashstructure.FormatV2, nil) -} - -func (x Symbol) Location() (line, column int) { - return x.line, x.column -} - -func (x Symbol) Equal(y interface{}) bool { - z, ok := y.(Symbol) - if !ok { - return false - } - return x.str == z.str -} - -func NewSymbol(s string, pos ...int) Instance { - if len(pos) != 2 { - return Symbol{s, -1, -1} - } - return Symbol{s, pos[0], pos[1]} -} - -func (Symbol) Class() Class { - return SymbolClass -} - -func (i Symbol) String() string { - return i.str -} - -var T = NewSymbol("T") diff --git a/core/tag.go b/core/tag.go deleted file mode 100644 index 2371642..0000000 --- a/core/tag.go +++ /dev/null @@ -1,26 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package core - -func NewBlockTag(tag, uid, object Instance) Instance { - return Create(NewEnvironment(nil, nil, nil, DefaultHandler), - BlockTagClass, - NewSymbol("IRIS.TAG"), tag, - NewSymbol("IRIS.UID"), uid, - NewSymbol("IRIS.OBJECT"), object) -} -func NewCatchTag(tag, uid, object Instance) Instance { - return Create(NewEnvironment(nil, nil, nil, DefaultHandler), - CatchTagClass, - NewSymbol("IRIS.TAG"), tag, - NewSymbol("IRIS.UID"), uid, - NewSymbol("IRIS.OBJECT"), object) -} -func NewTagbodyTag(tag, uid Instance) Instance { - return Create(NewEnvironment(nil, nil, nil, DefaultHandler), - TagbodyTagClass, - NewSymbol("IRIS.TAG"), tag, - NewSymbol("IRIS.UID"), uid) -} diff --git a/go.mod b/go.mod deleted file mode 100644 index e003c8b..0000000 --- a/go.mod +++ /dev/null @@ -1,10 +0,0 @@ -module github.com/islisp-dev/iris - -go 1.13 - -require ( - github.com/deckarep/golang-set v1.7.1 - github.com/dlclark/regexp2 v1.4.0 - github.com/google/go-cmp v0.5.6 - github.com/mitchellh/hashstructure/v2 v2.0.2 -) diff --git a/go.sum b/go.sum deleted file mode 100644 index 5addd44..0000000 --- a/go.sum +++ /dev/null @@ -1,10 +0,0 @@ -github.com/deckarep/golang-set v1.7.1 h1:SCQV0S6gTtp6itiFrTqI+pfmJ4LN85S1YzhDf9rTHJQ= -github.com/deckarep/golang-set v1.7.1/go.mod h1:93vsz/8Wt4joVM7c2AVqh+YRMiUSc14yDtF28KmMOgQ= -github.com/dlclark/regexp2 v1.4.0 h1:F1rxgk7p4uKjwIQxBs9oAXe5CqrXlCduYEJvrF4u93E= -github.com/dlclark/regexp2 v1.4.0/go.mod h1:2pZnwuY/m+8K6iRw6wQdMtk+rH5tNGR1i55kozfMjCc= -github.com/google/go-cmp v0.5.6 h1:BKbKCqvP6I+rmFHt06ZmyQtvB8xAkWdhFyr0ZUNZcxQ= -github.com/google/go-cmp v0.5.6/go.mod h1:v8dTdLbMG2kIc/vJvl+f65V22dbkXbowE6jgT/gNBxE= -github.com/mitchellh/hashstructure/v2 v2.0.2 h1:vGKWl0YJqUNxE8d+h8f6NJLcCJrgbhC4NcD46KavDd4= -github.com/mitchellh/hashstructure/v2 v2.0.2/go.mod h1:MG3aRVU/N29oo/V/IhBX8GR/zz4kQkprJgF2EVszyDE= -golang.org/x/xerrors v0.0.0-20191204190536-9bdfabe68543 h1:E7g+9GITq07hpfrRu66IVDexMakfv52eLZ2CXBWiKr4= -golang.org/x/xerrors v0.0.0-20191204190536-9bdfabe68543/go.mod h1:I/5z698sn9Ka8TeJc9MKroUUfqBBauWjQqLJ2OPfmY0= diff --git a/lib/array.go b/lib/array.go deleted file mode 100644 index adda55a..0000000 --- a/lib/array.go +++ /dev/null @@ -1,267 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import ( - "github.com/islisp-dev/iris/core" -) - -// BasicArrayP returns t if obj is a basic-array (instance of class -// basic-array); otherwise, returns nil. obj may be any ISLISP object. -func BasicArrayP(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.BasicArrayClass, obj); err != nil { - return Nil, nil - } - return T, nil -} - -// BasicArrayStarP returns t if obj is a basic-array* (instance of class -// ); otherwise, returns nil. obj may be any ISLISP object. -func BasicArrayStarP(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.BasicArrayStarClass, obj); err != nil { - return Nil, nil - } - return T, nil -} - -// GeneralArrayStarP returns t if obj is a general-array* (instance of class -// ); otherwise, returns nil. obj may be any ISLISP object. -func GeneralArrayStarP(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.GeneralArrayStarClass, obj) { - return T, nil - } - return Nil, nil -} - -// CreateArray creates an array of the given dimensions. The dimensions argument -// is a list of non-negative integers. The result is of class general-vector if -// there is only one dimension, or of class otherwise. If -// initial-element is given, the elements of the new array are initialized with -// this object, otherwise the initialization is implementation defined. An error -// shall be signaled if the requested array cannot be allocated (error-id. -// cannot-create-array). An error shall be signaled if dimensions is not a -// proper list of non-negative integers (error-id. domain-error). -// initial-element may be any ISLISP object -func CreateArray(e core.Environment, dimensions core.Instance, initialElement ...core.Instance) (core.Instance, core.Instance) { - length, err := Length(e, dimensions) - if err != nil { - return nil, err - } - for i := 0; i < int(length.(core.Integer)); i++ { - elt, err := Elt(e, dimensions, core.NewInteger(i)) - if err != nil { - return nil, err - } - if err := ensure(e, core.IntegerClass, elt); err != nil { - return nil, err - } - } - // set the initial element - elt := Nil - if len(initialElement) > 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - if len(initialElement) == 1 { - elt = initialElement[0] - } - // general-vector - if int(length.(core.Integer)) == 1 { - return createGeneralVector(e, dimensions, elt) - } - return createGeneralArrayStar(e, dimensions, elt) -} - -func createGeneralVector(e core.Environment, dimensions core.Instance, initialElement core.Instance) (core.Instance, core.Instance) { - // N-dimensions array - dimension, err := Car(e, dimensions) - if err != nil { - return nil, err - } - array := make([]core.Instance, int(dimension.(core.Integer))) - for i := 0; i < int(dimension.(core.Integer)); i++ { - array[i] = initialElement - } - return core.NewGeneralVector(array), nil -} - -func createGeneralArrayStar(e core.Environment, dimensions core.Instance, initialElement core.Instance) (core.Instance, core.Instance) { - length, err := Length(e, dimensions) - if err != nil { - return nil, err - } - // 0-dimension array - if int(length.(core.Integer)) == 0 { - return core.NewGeneralArrayStar(nil, initialElement), nil - } - // N-dimensions array - dimension, err := Car(e, dimensions) - if err != nil { - return nil, err - } - array := make([]*core.GeneralArrayStar, int(dimension.(core.Integer))) - for i := range array { - cdr, err := Cdr(e, dimensions) - if err != nil { - return nil, err - } - arr, err := createGeneralArrayStar(e, cdr, initialElement) - if err != nil { - return nil, err - } - array[i] = arr.(*core.GeneralArrayStar) - } - return core.NewGeneralArrayStar(array, nil), nil -} - -// Aref returns the object stored in the component of the basic-array specified -// by the sequence of integers z. This sequence must have exactly as many -// elements as there are dimensions in the basic-array, and each one must -// satisfy 0 ≤ zi < di , di the ith dimension and 0 ≤ i < d, d the number of -// dimensions. Arrays are indexed 0 based, so the ith row is accessed via the -// index i − 1. An error shall be signaled if basic-array is not a basic-array -// (error-id. domain-error). An error shall be signaled if any z is not a -// non-negative integer (error-id. domain-error). -func Aref(e core.Environment, basicArray core.Instance, dimensions ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.BasicArrayClass, basicArray); err != nil { - return nil, err - } - if err := ensure(e, core.IntegerClass, dimensions...); err != nil { - return nil, err - } - switch { - case core.InstanceOf(core.StringClass, basicArray): - if len(dimensions) != 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - index := int(dimensions[0].(core.Integer)) - if len(basicArray.(core.String)) <= index { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - return core.NewCharacter(basicArray.(core.String)[index]), nil - case core.InstanceOf(core.GeneralVectorClass, basicArray): - if len(dimensions) != 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - index := int(dimensions[0].(core.Integer)) - if len(basicArray.(core.GeneralVector)) <= index { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - return basicArray.(core.GeneralVector)[index], nil - default: // General Array* - return Garef(e, basicArray, dimensions...) - } -} - -// Garef is like aref but an error shall be signaled if its first argument, -// general-array, is not an object of class general-vector or of class -// (error-id. domain-error). -func Garef(e core.Environment, generalArray core.Instance, dimensions ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.GeneralArrayStarClass, generalArray); err != nil { - return nil, err - } - if err := ensure(e, core.IntegerClass, dimensions...); err != nil { - return nil, err - } - if len(dimensions) == 0 { - if core.DeepEqual(generalArray.(*core.GeneralArrayStar).Scalar, nil) { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - return generalArray.(*core.GeneralArrayStar).Scalar, nil - } - array := generalArray.(*core.GeneralArrayStar) - index := int(dimensions[0].(core.Integer)) - if core.DeepEqual(array.Vector, nil) || len(array.Vector) <= index { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - return Garef(e, array.Vector[index], dimensions[1:]...) -} - -// SetAref replaces the object obtainable by aref or garef with obj . The -// returned value is obj. The constraints on the basic-array, the general-array, -// and the sequence of indices z is the same as for aref and garef. -func SetAref(e core.Environment, obj, basicArray core.Instance, dimensions ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.BasicArrayClass, basicArray); err != nil { - return nil, err - } - if err := ensure(e, core.IntegerClass, dimensions...); err != nil { - return nil, err - } - switch { - case core.InstanceOf(core.StringClass, basicArray): - if err := ensure(e, core.CharacterClass, obj); err != nil { - return nil, err - } - if len(dimensions) != 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - index := int(dimensions[0].(core.Integer)) - if len(basicArray.(core.String)) <= index { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - basicArray.(core.String)[index] = rune(obj.(core.Character)) - return obj, nil - case core.InstanceOf(core.GeneralVectorClass, basicArray): - if len(dimensions) != 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - index := int(dimensions[0].(core.Integer)) - if len(basicArray.(core.GeneralVector)) <= index { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - basicArray.(core.GeneralVector)[index] = obj - return obj, nil - default: // General Array* - return SetGaref(e, obj, basicArray, dimensions...) - } -} - -// SetGaref replaces the object obtainable by aref or garef with obj . The -// returned value is obj. The constraints on the basic-array, the general-array, -// and the sequence of indices z is the same as for aref and garef. -func SetGaref(e core.Environment, obj, generalArray core.Instance, dimensions ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.GeneralArrayStarClass, generalArray); err != nil { - return nil, err - } - if err := ensure(e, core.IntegerClass, dimensions...); err != nil { - return nil, err - } - if len(dimensions) == 0 { - if core.DeepEqual(generalArray.(*core.GeneralArrayStar).Scalar, nil) { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - generalArray.(*core.GeneralArrayStar).Scalar = obj - return obj, nil - } - array := generalArray.(*core.GeneralArrayStar) - index := int(dimensions[0].(core.Integer)) - if core.DeepEqual(array.Vector, nil) || len(array.Vector) <= index { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - return SetGaref(e, obj, array.Vector[index], dimensions[1:]...) -} - -// ArrayDimensions returns a list of the dimensions of a given basic-array. An -// error shall be signaled if basic-array is not a basic-array (error-id. -// domain-error). The consequences are undefined if the returned list is -// modified. -func ArrayDimensions(e core.Environment, basicArray core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.BasicArrayClass, basicArray); err != nil { - return nil, err - } - switch { - case core.InstanceOf(core.StringClass, basicArray): - return List(e, core.NewInteger(len(basicArray.(core.String)))) - case core.InstanceOf(core.GeneralVectorClass, basicArray): - return List(e, core.NewInteger(len(basicArray.(core.GeneralVector)))) - default: // General Array* - array := basicArray.(*core.GeneralArrayStar) - dimensions := []core.Instance{} - for array.Vector != nil { - dimensions = append(dimensions, core.NewInteger(len(array.Vector))) - array = array.Vector[0] - } - return List(e, dimensions...) - } -} diff --git a/lib/array_test.go b/lib/array_test.go deleted file mode 100644 index 1056e22..0000000 --- a/lib/array_test.go +++ /dev/null @@ -1,120 +0,0 @@ -package lib - -import "testing" - -func TestArrayPredicate(t *testing.T) { - execTests(t, BasicArrayP, []test{ - { - exp: ` - (mapcar (lambda (x) - (list (basic-array-p x) - (basic-array*-p x) - (general-array*-p x))) - '((a b c) - "abc" - #(a b c) - #1a(a b c) - #2a((a) (b) (c)))) - `, - want: `'((nil nil nil) (t nil nil) (t nil nil) (t nil nil) (t t t))`, - wantErr: false, - }, - }) -} - -func TestCreateArray(t *testing.T) { - execTests(t, CreateArray, []test{ - { - exp: `(create-array '(2 3) 0.0)`, - want: `#2a((0.0 0.0 0.0) (0.0 0.0 0.0))`, - wantErr: false, - }, - { - exp: `(create-array '(2) 0.0)`, - want: `#(0.0 0.0)`, - wantErr: false, - }, - }) -} - -func TestAref(t *testing.T) { - execTests(t, CreateArray, []test{ - { - exp: `(defglobal array1 (create-array '(3 3 3) 0))`, - want: `'array1`, - wantErr: false, - }, - { - exp: `array1`, - want: ` - #3a(((0 0 0) (0 0 0) (0 0 0)) - ((0 0 0) (0 0 0) (0 0 0)) - ((0 0 0) (0 0 0) (0 0 0))) - `, - wantErr: false, - }, - { - exp: `(aref array1 0 1 2)`, - want: `0`, - wantErr: false, - }, - { - exp: `(setf (aref array1 0 1 2) 3.14)`, - want: `3.14`, - wantErr: false, - }, - { - exp: `(aref array1 0 1 2)`, - want: `3.14`, - wantErr: false, - }, - { - exp: `(aref (create-array '(8 8) 6) 1 1)`, - want: `6`, - wantErr: false, - }, - { - exp: `(aref (create-array '() 19))`, - want: `19`, - wantErr: false, - }, - }) -} - -func TestSetAref(t *testing.T) { - execTests(t, CreateArray, []test{ - { - exp: `(setf (aref array1 0 1 2) 3.15)`, - want: `3.15`, - wantErr: false, - }, - { - exp: `(set-aref 51.3 array1 0 1 2)`, - want: `51.3`, - wantErr: false, - }, - }) -} - -func TestArrayDimensions(t *testing.T) { - execTests(t, CreateArray, []test{ - { - exp: ` - (array-dimensions - (create-array '(2 2) 0)) - `, - want: `'(2 2)`, - wantErr: false, - }, - { - exp: `(array-dimensions (vector 'a 'b))`, - want: `'(2)`, - wantErr: false, - }, - { - exp: `(array-dimensions "foo")`, - want: `'(3)`, - wantErr: false, - }, - }) -} diff --git a/lib/binary.go b/lib/binary.go deleted file mode 100644 index f21f9c5..0000000 --- a/lib/binary.go +++ /dev/null @@ -1,56 +0,0 @@ -package lib - -import "github.com/islisp-dev/iris/core" - -func ReadByte(e core.Environment, args ...core.Instance) (core.Instance, core.Instance) { - str := e.StandardInput - if len(args) > 0 { - str = args[0] - } - if ok, _ := InputStreamP(e, str); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, str, core.StreamClass), Nil) - } - eosErrorP := true - if len(args) > 1 { - if core.DeepEqual(args[1], Nil) { - eosErrorP = false - } - } - eosValue := Nil - if len(args) > 2 { - if core.DeepEqual(args[2], Nil) { - eosValue = args[2] - } - } - if len(args) < 1 || len(args) > 3 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - buf := make([]byte, 1) - n, err := str.(core.Stream).Reader.Read(buf) - - if n != 1 || err != nil { - if eosErrorP { - return nil, core.Create(e, core.EndOfStreamClass) - } - return eosValue, nil - } - return core.NewInteger(int(buf[0])), nil -} - -func WriteByte(e core.Environment, obj, str core.Instance) (core.Instance, core.Instance) { - s, ok := str.(core.Stream) - if !ok { - return SignalCondition(e, core.NewDomainError(e, s, core.StreamClass), Nil) - } - - n, ok := obj.(core.Integer) - if !ok { - return SignalCondition(e, core.NewDomainError(e, s, core.IntegerClass), Nil) - } - - b := byte(n) - if err := s.WriteByte(b); err != nil { - return SignalCondition(e, core.NewStreamError(e, str), Nil) - } - return core.NewInteger(int(b)), nil -} diff --git a/lib/binary_test.go b/lib/binary_test.go deleted file mode 100644 index 9b96b56..0000000 --- a/lib/binary_test.go +++ /dev/null @@ -1,67 +0,0 @@ -package lib - -import "testing" - -func TestReadByte(t *testing.T) { - execTests(t, ReadByte, []test{ - { - exp: `(defglobal byte-example (open-output-file "__binary" 8))`, - want: `'byte-example`, - wantErr: false, - }, - { - exp: `(format byte-example "hello")`, - want: `nil`, - wantErr: false, - }, - { - exp: `(close byte-example)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(progn (setq byte-example (open-input-file "__binary" 8)) nil)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(read-byte byte-example)`, - want: `104`, - wantErr: false, - }, - { - exp: `(read-byte byte-example)`, - want: `101`, - wantErr: false, - }, - { - exp: `(read-byte byte-example)`, - want: `108`, - wantErr: false, - }, - { - exp: `(read-byte byte-example)`, - want: `108`, - wantErr: false, - }, - { - exp: `(read-byte byte-example)`, - want: `111`, - wantErr: false, - }, - }) -} - -func TestWriteByte(t *testing.T) { - execTests(t, WriteByte, []test{ - { - exp: ` - (let ((out-str (open-output-file "__binary" 8))) - (write-byte #b101 out-str) - (close out-str)) - `, - want: `nil`, - wantErr: false, - }, - }) -} diff --git a/lib/boolean.go b/lib/boolean.go deleted file mode 100644 index 9455b39..0000000 --- a/lib/boolean.go +++ /dev/null @@ -1,24 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -// The values t and nil are called booleans. t denotes true, and nil is the only -// value denoting false. Predicates, also called boolean functions, are -// functions that return t when satisfied and nil otherwise. Any object other -// than nil is treated as true (not just t). When objects are treated as true or -// nil this way they are called quasi-booleans. t is an identifier naming the -// symbol t, and nil is an identifier naming the symbol nil (which is also the -// empty list). nil is the unique instance of the null class. Like boolean -// functions, the and and or special forms return truth values; however, these -// truth values are nil when the test is not satisfied and a non-nil value -// otherwise. The result of and and or are quasi-booleans. t is a named constant -// whose value is the symbol t itself. nil is a named constant whose value is -// the symbol nil itself. -var ( - Nil = core.Nil - T = core.NewSymbol("T") -) diff --git a/lib/character.go b/lib/character.go deleted file mode 100644 index 60c8003..0000000 --- a/lib/character.go +++ /dev/null @@ -1,87 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -// Characterp returns t if obj is a character (instance of class character); -// otherwise, returns nil. obj may be any ISLISP object. -func Characterp(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.CharacterClass, obj) { - return T, nil - } - return Nil, nil -} - -// CharEqual tests whether char1 is the same character as char2. -func CharEqual(e core.Environment, char1, char2 core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.CharacterClass, char1, char2); err != nil { - return nil, err - } - if core.DeepEqual(char1, char2) { - return T, nil - } - return Nil, nil -} - -// CharNotEqual if and only if they are not char=. -func CharNotEqual(e core.Environment, char1, char2 core.Instance) (core.Instance, core.Instance) { - ret, err := CharEqual(e, char1, char2) - if err != nil { - return nil, err - } - return Not(e, ret) -} - -// CharGreaterThan tests whether char1 is greater than char2. An error shall be -// signaled if either char1 or char2 is not a character (error-id. domain-error). -func CharGreaterThan(e core.Environment, char1, char2 core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.CharacterClass, char1, char2); err != nil { - return nil, err - } - if char1.(core.Character) > char2.(core.Character) { - return T, nil - } - return Nil, nil -} - -// CharGreaterThanOrEqual tests whether char1 is greater than or equal to char2. -// An error shall be signaled if either char1 or char2 is not a character -// (error-id. domain-error). -func CharGreaterThanOrEqual(e core.Environment, char1, char2 core.Instance) (core.Instance, core.Instance) { - gt, err := CharGreaterThan(e, char1, char2) - if err != nil { - return nil, err - } - eq, err := CharEqual(e, char1, char2) - if err != nil { - return nil, err - } - if core.DeepEqual(gt, Nil) && core.DeepEqual(eq, Nil) { - return Nil, nil - } - return T, nil -} - -// CharLessThan tests whether char1 is less than char2. An error shall be -// signaled if either char1 or char2 is not a character (error-id. domain-error). -func CharLessThan(e core.Environment, char1, char2 core.Instance) (core.Instance, core.Instance) { - gt, err := CharGreaterThanOrEqual(e, char1, char2) - if err != nil { - return nil, err - } - return Not(e, gt) -} - -// CharLessThanOrEqual tests whether char1 is less than or equal to char2. An -// error shall be signaled if either char1 or char2 is not a character -// (error-id. domain-error). -func CharLessThanOrEqual(e core.Environment, char1, char2 core.Instance) (core.Instance, core.Instance) { - gt, err := CharGreaterThan(e, char1, char2) - if err != nil { - return nil, err - } - return Not(e, gt) -} diff --git a/lib/character_test.go b/lib/character_test.go deleted file mode 100644 index c0689c9..0000000 --- a/lib/character_test.go +++ /dev/null @@ -1,98 +0,0 @@ -package lib - -import "testing" - -func TestCharacterp(t *testing.T) { - execTests(t, Characterp, []test{ - { - exp: `(characterp #\a)`, - want: `t`, - wantErr: false, - }, - { - exp: `(characterp "a")`, - want: `nil`, - wantErr: false, - }, - { - exp: `(characterp 'a)`, - want: `nil`, - wantErr: false, - }, - }) -} - -func TestChar(t *testing.T) { - execTests(t, CharEqual, []test{ - { - exp: `(char= #\a #\a)`, - want: `t`, - wantErr: false, - }, - { - exp: `(char= #\a #\b)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(char= #\a #\A)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(char/= #\a #\a)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(char< #\a #\a)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(char< #\a #\b)`, - want: `t`, - wantErr: false, - }, - { - exp: `(char< #\b #\a)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(char< #\a #\A)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(char< #\* #\a)`, - want: `t`, - wantErr: false, - }, - { - exp: `(char> #\b #\a)`, - want: `t`, - wantErr: false, - }, - { - exp: `(char<= #\a #\a)`, - want: `t`, - wantErr: false, - }, - { - exp: `(char<= #\a #\A)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(char>= #\b #\a)`, - want: `t`, - wantErr: false, - }, - { - exp: `(char>= #\a #\a)`, - want: `t`, - wantErr: false, - }, - }) -} diff --git a/lib/class.go b/lib/class.go deleted file mode 100644 index 58b7ac4..0000000 --- a/lib/class.go +++ /dev/null @@ -1,301 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import ( - "fmt" - - "github.com/islisp-dev/iris/core" -) - -func ClassOf(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - return obj.Class(), nil -} - -func Instancep(e core.Environment, obj core.Instance, class core.Class) (core.Instance, core.Instance) { - if core.InstanceOf(class, obj) { - return T, nil - } - return Nil, nil -} - -func Subclassp(e core.Environment, class1, class2 core.Class) (core.Instance, core.Instance) { - if core.SubclassOf(class1, class2) { - return T, nil - } - return Nil, nil -} - -func Class(e core.Environment, className core.Instance) (core.Class, core.Instance) { - if v, ok := e.Class[:1].Get(className); ok { - return v.(core.Class), nil - } - _, err := SignalCondition(e, core.NewUndefinedClass(e, className), Nil) - return nil, err -} - -func checkSuperClass(a, b core.Class) bool { - if core.DeepEqual(a, core.StandardObjectClass) || core.DeepEqual(b, core.StandardObjectClass) { - return false - } - if core.SubclassOf(a, b) || core.SubclassOf(b, a) { - return true - } - for _, c := range a.Supers() { - if checkSuperClass(c, b) { - return true - } - } - for _, c := range b.Supers() { - if checkSuperClass(a, c) { - return true - } - } - return false -} - -func Defclass(e core.Environment, className, scNames, slotSpecs core.Instance, classOpts ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.SymbolClass, className); err != nil { - return nil, err - } - if err := ensure(e, core.ListClass, scNames, slotSpecs); err != nil { - return nil, err - } - supers := []core.Class{core.StandardObjectClass} - for _, scName := range scNames.(core.List).Slice() { - super, err := Class(e, scName) - if err != nil { - return nil, err - } - for _, before := range supers { - if checkSuperClass(before, super) { - return SignalCondition(e, core.NewArityError(e), Nil) - } - } - supers = append(supers, super) - } - slots := []core.Instance{} - initforms := core.NewHashMap() - initargs := core.NewHashMap() - for _, slotSpec := range slotSpecs.(core.List).Slice() { - if core.InstanceOf(core.SymbolClass, slotSpec) { - slotName := slotSpec - slots = append(slots, slotName) - continue - } - slotName := slotSpec.(*core.Cons).Car - slots = append(slots, slotName) - slotOpts := slotSpec.(*core.Cons).Cdr.(core.List).Slice() - for i := 0; i < len(slotOpts); i += 2 { - switch { - case core.DeepEqual(slotOpts[i], core.NewSymbol(":INITFORM")): - closure, err := newNamedFunction(e, core.NewSymbol("CLOSURE"), Nil, slotOpts[i+1]) - if err != nil { - return nil, err - } - initforms.Set(slotName, closure) - case core.DeepEqual(slotOpts[i], core.NewSymbol(":INITARG")): - initargs.Set(slotOpts[i+1], slotName) - } - } - } - metaclass := core.StandardClassClass - abstractp := Nil - for _, classOpt := range classOpts { - var err core.Instance - switch { - case core.DeepEqual(classOpt.(*core.Cons).Car, core.NewSymbol(":METACLASS")): - if metaclass, err = Class(e, classOpt.(core.List).Nth(1)); err != nil { - return nil, err - } - case core.DeepEqual(classOpt.(*core.Cons).Car, core.NewSymbol(":ABSTRACTP")): - if abstractp, err = Eval(e, classOpt.(core.List).Nth(1)); err != nil { - return nil, err - } - } - } - classObject := core.NewStandardClass(className, supers, slots, initforms, initargs, metaclass, abstractp) - e.Class[:1].Define(className, classObject) - for _, slotSpec := range slotSpecs.(core.List).Slice() { - if core.InstanceOf(core.SymbolClass, slotSpec) { - continue - } - slotName := slotSpec.(*core.Cons).Car - slotOpts := slotSpec.(*core.Cons).Cdr.(core.List).Slice() - var readerFunctionName, writerFunctionName, boundpFunctionName core.Instance - for i := 0; i < len(slotOpts); i += 2 { - switch { - case core.DeepEqual(slotOpts[i], core.NewSymbol(":READER")): - readerFunctionName = slotOpts[i+1] - case core.DeepEqual(slotOpts[i], core.NewSymbol(":WRITER")): - writerFunctionName = slotOpts[i+1] - case core.DeepEqual(slotOpts[i], core.NewSymbol(":ACCESSOR")): - readerFunctionName = slotOpts[i+1] - writerFunctionName = core.NewSymbol(fmt.Sprintf("(SETF %v)", slotOpts[i+1])) - case core.DeepEqual(slotOpts[i], core.NewSymbol(":BOUNDP")): - boundpFunctionName = slotOpts[i+1] - } - } - if readerFunctionName != nil { - lambdaList, err := List(e, core.NewSymbol("INSTANCE")) - if err != nil { - return nil, err - } - if g, ok := e.Function.Get(readerFunctionName); !ok || !core.InstanceOf(core.GenericFunctionClass, g) { - Defgeneric(e, readerFunctionName, lambdaList) - } - fun, _ := e.Function.Get(readerFunctionName) - fun.(*core.GenericFunction).AddMethod(nil, lambdaList, []core.Class{classObject}, core.NewFunction(readerFunctionName, func(e core.Environment, object core.Instance) (core.Instance, core.Instance) { - slot, ok := object.(core.BasicInstance).GetSlotValue(slotName, classObject) - if ok { - return slot, nil - } - return Nil, nil // TODO: shoud throw an error. - })) - } - if writerFunctionName != nil { - lambdaList, err := List(e, core.NewSymbol("Y"), core.NewSymbol("X")) - if err != nil { - return nil, err - } - if g, ok := e.Function.Get(writerFunctionName); !ok || !core.InstanceOf(core.GenericFunctionClass, g) { - Defgeneric(e, writerFunctionName, lambdaList) - } - fun, _ := e.Function.Get(writerFunctionName) - fun.(*core.GenericFunction).AddMethod(nil, lambdaList, []core.Class{core.ObjectClass, classObject}, core.NewFunction(writerFunctionName, func(e core.Environment, obj, object core.Instance) (core.Instance, core.Instance) { - ok := object.(core.BasicInstance).SetSlotValue(obj, slotName, classObject) - if ok { - return obj, nil - } - return Nil, nil - })) - } - if boundpFunctionName != nil { - lambdaList, err := List(e, core.NewSymbol("INSTANCE")) - if err != nil { - return nil, err - } - if g, ok := e.Function.Get(boundpFunctionName); !ok || !core.InstanceOf(core.GenericFunctionClass, g) { - Defgeneric(e, boundpFunctionName, lambdaList) - } - fun, _ := e.Function.Get(boundpFunctionName) - fun.(*core.GenericFunction).AddMethod(nil, lambdaList, []core.Class{classObject}, core.NewFunction(boundpFunctionName, func(e core.Environment, object core.Instance) (core.Instance, core.Instance) { - _, ok := object.(core.BasicInstance).GetSlotValue(slotName, classObject) - if ok { - return T, nil - } - return Nil, nil - })) - } - } - return className, nil -} - -func Create(e core.Environment, c core.Instance, i ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.StandardClassClass, c); err != nil { - return nil, err - } - return core.Create(e, c, i...), nil -} - -func InitializeObject(e core.Environment, object core.Instance, inits ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.StandardObjectClass, object); err != nil { - return nil, err - } - return core.InitializeObject(e, object, inits...), nil -} - -func Defmethod(e core.Environment, arguments ...core.Instance) (core.Instance, core.Instance) { - if len(arguments) < 2 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - name := arguments[0] - var qualifier core.Instance - i := 0 - if core.DeepEqual(arguments[1], core.NewSymbol(":AROUND")) || core.DeepEqual(arguments[1], core.NewSymbol(":BEFORE")) || core.DeepEqual(arguments[1], core.NewSymbol(":AFTER")) { - qualifier = arguments[1] - i++ - } - parameterList := []core.Instance{} - for _, pp := range arguments[i+1].(core.List).Slice() { - if core.InstanceOf(core.SymbolClass, pp) { - parameterList = append(parameterList, pp) - } else { - parameterList = append(parameterList, pp.(core.List).Nth(0)) - } - } - lambdaList, err := List(e, parameterList...) - if err != nil { - return nil, err - } - classList := []core.Class{} - for _, pp := range arguments[i+1].(core.List).Slice() { - if core.DeepEqual(pp, core.NewSymbol(":REST")) && core.DeepEqual(pp, core.NewSymbol("&REST")) { - break - } - if core.InstanceOf(core.SymbolClass, pp) { - classList = append(classList, core.ObjectClass) - } else { - class, ok := e.Class[:1].Get(pp.(core.List).Nth(1)) - if !ok { - return SignalCondition(e, core.NewUndefinedClass(e, pp.(core.List).Nth(1)), Nil) - - } - classList = append(classList, class.(core.Class)) - } - } - fun, err := newNamedFunction(e, name, lambdaList, arguments[i+2:]...) - if err != nil { - return nil, err - } - gen, ok := e.Function[:1].Get(name) - if !ok { - return SignalCondition(e, core.NewUndefinedFunction(e, name), Nil) - } - if !gen.(*core.GenericFunction).AddMethod(qualifier, lambdaList, classList, fun) { - return SignalCondition(e, core.NewUndefinedFunction(e, name), Nil) - } - return name, nil -} - -func Defgeneric(e core.Environment, funcSpec, lambdaList core.Instance, optionsOrMethodDescs ...core.Instance) (core.Instance, core.Instance) { - var methodCombination core.Instance - genericFunctionClass := core.StandardGenericFunctionClass - forms := []core.Instance{} - for _, optionOrMethodDesc := range optionsOrMethodDescs { - switch { - case core.DeepEqual(optionOrMethodDesc.(core.List).Nth(0), core.NewSymbol(":METHOD-COMBINATION")): - methodCombination = optionOrMethodDesc.(core.List).Nth(1) - case core.DeepEqual(optionOrMethodDesc.(core.List).Nth(0), core.NewSymbol(":GENERIC-FUNCTION-CLASS")): - class, ok := e.Class[:1].Get(optionOrMethodDesc.(core.List).Nth(1)) - if !ok { - return SignalCondition(e, core.NewUndefinedClass(e, optionOrMethodDesc.(core.List).Nth(1)), Nil) - } - genericFunctionClass = class.(core.Class) - case core.DeepEqual(optionOrMethodDesc.(core.List).Nth(0), core.NewSymbol(":METHOD")): - forms = append(forms, core.NewCons(core.NewSymbol("DEFMETHOD"), optionOrMethodDesc.(core.List).NthCdr(1))) - } - } - e.Function[:1].Define( - core.NewSymbol( - fmt.Sprint(funcSpec), - ), - core.NewGenericFunction( - funcSpec, - lambdaList, - methodCombination, - genericFunctionClass, - ), - ) - Progn(e, forms...) - return funcSpec, nil -} - -func GenericFunctionP(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.GenericFunctionClass, obj) { - return T, nil - } - return Nil, nil -} diff --git a/lib/condition.go b/lib/condition.go deleted file mode 100644 index 04d0e4c..0000000 --- a/lib/condition.go +++ /dev/null @@ -1,97 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -func SignalCondition(e core.Environment, condition, continuable core.Instance) (core.Instance, core.Instance) { - return core.SignalCondition(e, condition, continuable) -} - -func Cerror(e core.Environment, continueString, errorString core.Instance, objs ...core.Instance) (core.Instance, core.Instance) { - arguments, err := List(e, objs...) - if err != nil { - return nil, err - } - condition := core.NewSimpleError(e, errorString, arguments) - ss, err := CreateStringOutputStream(e) - if err != nil { - return nil, err - } - if _, err := Format(e, ss, continueString, objs...); err != nil { - return nil, err - } - continuable, err := GetOutputStreamString(e, ss) - if err != nil { - return nil, err - } - return SignalCondition(e, condition, continuable) -} - -func Error(e core.Environment, errorString core.Instance, objs ...core.Instance) (core.Instance, core.Instance) { - arguments, err := List(e, objs...) - if err != nil { - return nil, err - } - condition := core.NewSimpleError(e, errorString, arguments) - return SignalCondition(e, condition, Nil) -} - -func IgnoreErrors(e core.Environment, forms ...core.Instance) (core.Instance, core.Instance) { - ret, err := Progn(e, forms...) - if err != nil && core.InstanceOf(core.ErrorClass, err) { - return Nil, nil - } - return ret, err -} - -func ReportCondition(e core.Environment, condition, stream core.Instance) (core.Instance, core.Instance) { - return Format(e, e.StandardOutput, core.NewString([]rune("~A")), condition) -} - -func ConditionContinuable(e core.Environment, condition core.Instance) (core.Instance, core.Instance) { - if continuable, ok := condition.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.CONTINUABLE"), core.SeriousConditionClass); ok { - return continuable, nil - } - return Nil, nil -} - -func ContinueCondition(e core.Environment, condition core.Instance, value ...core.Instance) (core.Instance, core.Instance) { - if b, ok := condition.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.CONTINUABLE"), core.SeriousConditionClass); !ok || b == Nil { - return nil, core.Create(e, core.ProgramErrorClass) - } - if len(value) == 1 { - return nil, core.Create(e, core.ContinueClass, core.NewSymbol("IRIS.OBJECT"), value[0]) - } - if len(value) == 0 { - return nil, core.Create(e, core.ContinueClass, core.NewSymbol("IRIS.OBJECT"), Nil) - } - return nil, core.Create(e, core.ProgramErrorClass) -} - -func WithHandler(e core.Environment, handler core.Instance, forms ...core.Instance) (core.Instance, core.Instance) { - fun, err := Eval(e, handler) - if err != nil { - return nil, err - } - f := e.NewHandler(fun) - ret, err := Progn(f, forms...) - if err != nil { - return nil, err - } - return ret, err -} - -func CreateReader(class core.Class, key string) func(e core.Environment, c core.Instance) (core.Instance, core.Instance) { - return func(e core.Environment, c core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(class, c) { - if v, ok := c.(core.BasicInstance).GetSlotValue(core.NewSymbol(key), core.ArithmeticErrorClass); ok { - return v, nil - } - return Nil, nil - } - return SignalCondition(e, core.NewDomainError(e, c, class), Nil) - } -} diff --git a/lib/conditional.go b/lib/conditional.go deleted file mode 100644 index e7f8309..0000000 --- a/lib/conditional.go +++ /dev/null @@ -1,150 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -// If is conditional expression. The test-form is evaluated. If its result is -// anything non-nil, the then-form is evaluated and its value is returned; -// otherwise (if the test-form returned nil), the else-form is evaluated and its -// value is returned. If no else-form is provided, it defaults to nil. -func If(e core.Environment, testForm, thenForm core.Instance, elseForm ...core.Instance) (core.Instance, core.Instance) { - tf, err := Eval(e, testForm) - if err != nil { - return nil, err - } - if tf != Nil { - return Eval(e, thenForm) - } - if len(elseForm) > 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - if len(elseForm) == 0 { - return Nil, nil - } - return Eval(e, elseForm[0]) -} - -// Cond the clauses (test form*) are scanned sequentially and in each case the -// test is evaluated; when a test delivers a non-nil value the scanning process -// stops and all forms associated with the corresponding clauseare sequentially -// evaluated and the value of the last one is returned. If no test is true, then -// nil is returned. If no form exists for the successful test then the value of -// this test is returned. -func Cond(e core.Environment, testFrom ...core.Instance) (core.Instance, core.Instance) { - for _, tf := range testFrom { - if err := ensure(e, core.ListClass, tf); err != nil { - return nil, err - } - s := tf.(core.List).Slice() - if len(s) == 0 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - ret, err := Eval(e, s[0]) - if err != nil { - return nil, err - } - if core.DeepEqual(ret, T) { - return Progn(e, s[1:]...) - } - } - return Nil, nil -} - -// Case special form, called case form, provide a mechanism to execute a -// matching clause from a series of clauses based on the value of a dispatching -// form keyform. The clause to be executed is identified by a set of keys. A key -// can be any object. If the keylist of the last clause is t the associated -// clause is executed if no key matches the keyform. keyform is a form to be -// computed at the beginning of execution of the case form. If the result of -// evaluating keyform is equivalent to a key, then the forms, if any, in the -// corresponding clause are evaluated sequentially and the value of the last one -// is returned as value of the whole case form. case determines match -// equivalence by using eql; the value returned by keyform and key. If no form -// exists for a matching key, the case form evaluates to nil. If the value of -// keyform is different from every key, and there is a default clause, its -// forms, if any, are evaluated sequentially, and the value of the last one is -// the result of the case form. -func Case(e core.Environment, key core.Instance, pattern ...core.Instance) (core.Instance, core.Instance) { - key, err := Eval(e, key) - if err != nil { - return nil, err - } - for idx, pat := range pattern { - if err := ensure(e, core.ListClass, pat); err != nil { - return nil, err - } - form := pat.(core.List).Slice() - if len(form) < 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - if idx == len(pattern)-1 && core.DeepEqual(form[0], T) { - return Progn(e, form[1:]...) - } - if err := ensure(e, core.ListClass, form[0]); err != nil { - return nil, err - } - for _, k := range form[0].(core.List).Slice() { - if core.DeepEqual(k, key) { - return Progn(e, form[1:]...) - } - } - } - return Nil, nil -} - -// CaseUsing special form, called case forms, provide a mechanism to execute a -// matching clause from a series of clauses based on the value of a dispatching -// form keyform. The clause to be executed is identified by a set of keys. A key -// can be any object. If the keylist of the last clause is t the associated -// clause is executed if no key matches the keyform. keyform is a form to be -// computed at the beginning of execution of the case form. If the result of -// evaluating keyform is equivalent to a key, then the forms, if any, in the -// corresponding clause are evaluated sequentially and the value of the last one -// is returned as value of the whole case form. case-using match determines -// equivalence by using the result of evaluating predform. predform must be a -// boolean or quasi-boolean function that accepts two arguments, the value -// returned by keyform and key. If no form exists for a matching key, the case -// form evaluates to nil. If the value of keyform is different from every key, -// and there is a default clause, its forms, if any, are evaluated sequentially, -// and the value of the last one is the result of the case form. -func CaseUsing(e core.Environment, pred, key core.Instance, pattern ...core.Instance) (core.Instance, core.Instance) { - key, err := Eval(e, key) - if err != nil { - return nil, err - } - pred, err = Eval(e, pred) - if err != nil { - return nil, err - } - if err := ensure(e, core.FunctionClass, pred); err != nil { - return nil, err - } - for idx, pat := range pattern { - if err := ensure(e, core.ListClass, pat); err != nil { - return nil, err - } - form := pat.(core.List).Slice() - if len(form) < 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - if idx == len(pattern)-1 && core.DeepEqual(form[0], T) { - return Progn(e, form[1:]...) - } - if err := ensure(e, core.ListClass, form[0]); err != nil { - return nil, err - } - for _, k := range form[0].(core.List).Slice() { - ret, err := pred.(core.Applicable).Apply(e.NewDynamic(), k, key) - if err != nil { - return nil, err - } - if ret != Nil { - return Progn(e, form[1:]...) - } - } - } - return Nil, nil -} diff --git a/lib/conditional_test.go b/lib/conditional_test.go deleted file mode 100644 index dd15939..0000000 --- a/lib/conditional_test.go +++ /dev/null @@ -1,137 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "testing" - -func TestIf(t *testing.T) { - execTests(t, If, []test{ - { - exp: `(if (> 3 2) 'yes 'no)`, - want: `'yes`, - wantErr: false, - }, - { - exp: `(if (> 2 3) 'yes 'no)`, - want: `'no`, - wantErr: false, - }, - { - exp: `(if (> 2 3) 'yes)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(if (> 3 2) (- 3 2) (+ 3 2))`, - want: `1`, - wantErr: false, - }, - { - exp: ` - (let ((x 7)) - (if (< x 0) x (- x))) - `, - want: `-7`, - wantErr: false, - }, - }) -} - -func TestCond(t *testing.T) { - execTests(t, Cond, []test{ - { - exp: ` - (cond ((> 3 2) 'greater) - ((< 3 2) 'less)) - `, - want: `'greater`, - wantErr: false, - }, - { - exp: ` - (cond ((> 3 3) 'greater) - ((< 3 3) 'less)) - `, - want: `nil`, - wantErr: false, - }, - { - exp: ` - (cond ((> 3 3) 'greater) - ((< 3 3) 'less) - (t 'equal)) - `, - want: `'equal`, - wantErr: false, - }, - }) -} - -func TestCase(t *testing.T) { - execTests(t, Case, []test{ - { - exp: ` - (case (* 2 3) - ((2 3 5 7) 'prime) - ((4 6 8 9) 'composite)) - `, - want: `'composite`, - wantErr: false, - }, - { - exp: ` - (case (car '(c d)) - ((a) 'a) - ((b) 'b)) - `, - want: `nil`, - wantErr: false, - }, - { - exp: ` - (case (car '(c d)) - ((a e i o u) 'vowel) - ((y) 'semivowel) - (t 'consonant)) - `, - want: `'consonant`, - wantErr: false, - }, - { - exp: ` - (let ((char #\u)) - (case char - ((#\a #\e #\o #\u #\i) 'vowels) - (t 'consonants))) - `, - want: `'vowels`, - wantErr: false, - }, - }) -} - -func TestCaseUsing(t *testing.T) { - execTests(t, CaseUsing, []test{ - { - exp: ` - (case-using #'= (+ 1.0 1.0) - ((1) 'one) - ((2) 'two) - (t 'more)) - `, - want: `'two`, - wantErr: false, - }, - { - exp: ` - (case-using #'string= "bar" - (("foo") 1) - (("bar") 2)) - `, - want: `'2`, - wantErr: false, - }, - }) -} diff --git a/lib/cons.go b/lib/cons.go deleted file mode 100644 index 839ac10..0000000 --- a/lib/cons.go +++ /dev/null @@ -1,64 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -// Consp returns t if obj is a cons (instance of class cons); otherwise, returns -// nil. obj may be any ISLISP object. -func Consp(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.ConsClass, obj) { - return T, nil - } - return Nil, nil -} - -// Cons builds a cons from two objects, with obj1 as its car (or `left') part -// and with obj2 as its cdr (or `right') part. An error shall be signaled if the -// requested cons cannot be allocated (error-id. cannot-create-cons). Both obj1 -// and obj2 may be any ISLISP object. -func Cons(e core.Environment, obj1, obj2 core.Instance) (core.Instance, core.Instance) { - return core.NewCons(obj1, obj2), nil -} - -// Car returns the left component of the cons. An error shall be signaled if -// cons is not a cons (error-id. domain-error). -func Car(e core.Environment, cons core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.ConsClass, cons); err != nil { - return nil, err - } - return cons.(*core.Cons).Car, nil // Checked at the top of this function -} - -// Cdr returns the right component of the cons. An error shall be signaled if -// cons is not a cons (error-id. domain-error). -func Cdr(e core.Environment, cons core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.ConsClass, cons); err != nil { - return nil, err - } - return cons.(*core.Cons).Cdr, nil // Checked at the top of this function -} - -// SetCar updates the left component of cons with obj. The returned value is obj -// . An error shall be signaled if cons is not a cons (error-id. domain-error). -// obj may be any ISLISP object. -func SetCar(e core.Environment, obj, cons core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.ConsClass, cons); err != nil { - return nil, err - } - cons.(*core.Cons).Car = obj - return obj, nil -} - -// SetCdr updates the right component of cons with obj. The returned value is -// obj . An error shall be signaled if cons is not a cons (error-id. -// domain-error). obj may be any ISLISP object. -func SetCdr(e core.Environment, obj, cons core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.ConsClass, cons); err != nil { - return nil, err - } - cons.(*core.Cons).Cdr = obj - return obj, nil -} diff --git a/lib/cons_test.go b/lib/cons_test.go deleted file mode 100644 index 0c92246..0000000 --- a/lib/cons_test.go +++ /dev/null @@ -1,133 +0,0 @@ -package lib - -import "testing" - -func TestConsp(t *testing.T) { - execTests(t, Consp, []test{ - { - exp: `(consp '(a . b))`, - want: `t`, - wantErr: false, - }, - { - exp: `(consp '(a b c))`, - want: `t`, - wantErr: false, - }, - { - exp: `(consp '())`, - want: `nil`, - wantErr: false, - }, - { - exp: `(consp #(a b))`, - want: `nil`, - wantErr: false, - }, - }) -} - -func TestCons(t *testing.T) { - execTests(t, Cons, []test{ - { - exp: `(cons 'a '())`, - want: `'(a)`, - wantErr: false, - }, - { - exp: `(cons '(a) '(b c d))`, - want: `'((a) b c d)`, - wantErr: false, - }, - { - exp: `(cons "a" '(b c))`, - want: `'("a" b c)`, - wantErr: false, - }, - { - exp: `(cons 'a 3)`, - want: `'(a . 3)`, - wantErr: false, - }, - { - exp: `(cons '(a b) 'c)`, - want: `'((a b) . c)`, - wantErr: false, - }, - }) -} - -func TestCar(t *testing.T) { - execTests(t, Car, []test{ - { - exp: `(car '())`, - want: `nil`, - wantErr: true, - }, - { - exp: `(car '(a b c))`, - want: `'a`, - wantErr: false, - }, - { - exp: `(car '((a) b c d))`, - want: `'(a)`, - wantErr: false, - }, - { - exp: `(car '(1 . 2))`, - want: `1`, - wantErr: false, - }, - }) -} - -func TestCdr(t *testing.T) { - execTests(t, Cdr, []test{ - { - exp: `(cdr '())`, - want: `nil`, - wantErr: true, - }, - { - exp: `(cdr '((a) b c d))`, - want: `'(b c d)`, - wantErr: false, - }, - { - exp: `(cdr '(1 . 2))`, - want: `2`, - wantErr: false, - }, - }) -} - -func TestSetCar(t *testing.T) { - execTests(t, SetCar, []test{ - { - exp: ` - (let ((x (list 'apple 'orange))) - (list x (car x) - (setf (car x) 'banana) - x (car x))) - `, - want: `'((banana orange) apple banana (banana orange) banana)`, - wantErr: false, - }, - }) -} - -func TestSetCdr(t *testing.T) { - execTests(t, SetCdr, []test{ - { - exp: ` - (let ((x (list 'apple 'orange))) - (list x (cdr x) - (setf (cdr x) 'banana) - x (cdr x))) - `, - want: `'((apple . banana) (orange) banana (apple . banana) banana)`, - wantErr: false, - }, - }) -} diff --git a/lib/constants.go b/lib/constants.go deleted file mode 100644 index 40c357f..0000000 --- a/lib/constants.go +++ /dev/null @@ -1,13 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -// Quote is used to include any object in an ISLisp text. A quoted expression -// denotes a reference to an object. -func Quote(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - return obj, nil -} diff --git a/lib/convert.go b/lib/convert.go deleted file mode 100644 index c94e288..0000000 --- a/lib/convert.go +++ /dev/null @@ -1,127 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -func Convert(e core.Environment, object, class1 core.Instance) (core.Instance, core.Instance) { - object, err := Eval(e, object) - if err != nil { - return nil, err - } - class1, err = Class(e, class1) - if err != nil { - return nil, err - } - switch object.Class().String() { - case core.CharacterClass.String(): - switch class1.(core.BuiltInClass).String() { - case core.CharacterClass.String(): - return object, nil - case core.IntegerClass.String(): - return core.NewInteger(int(rune(object.(core.Character)))), nil - case core.FloatClass.String(): - case core.SymbolClass.String(): - case core.StringClass.String(): - return core.NewString([]rune(object.String()[2:])), nil - case core.GeneralVectorClass.String(): - case core.ListClass.String(): - } - case core.IntegerClass.String(): - switch class1.String() { - case core.CharacterClass.String(): - return core.NewCharacter(rune(int(object.(core.Integer)))), nil - case core.IntegerClass.String(): - return object, nil - case core.FloatClass.String(): - return core.NewFloat(float64(int(object.(core.Integer)))), nil - case core.SymbolClass.String(): - case core.StringClass.String(): - return core.NewString([]rune(object.String())), nil - case core.GeneralVectorClass.String(): - case core.ListClass.String(): - } - case core.FloatClass.String(): - switch class1.String() { - case core.CharacterClass.String(): - case core.IntegerClass.String(): - return core.NewInteger(int(float64(object.(core.Float)))), nil - case core.FloatClass.String(): - return object, nil - case core.SymbolClass.String(): - case core.StringClass.String(): - return core.NewString([]rune(object.String())), nil - case core.GeneralVectorClass.String(): - case core.ListClass.String(): - } - case core.SymbolClass.String(): - switch class1.String() { - case core.CharacterClass.String(): - case core.IntegerClass.String(): - case core.FloatClass.String(): - case core.SymbolClass.String(): - return object, nil - case core.StringClass.String(): - return core.NewString([]rune(object.String())), nil - case core.GeneralVectorClass.String(): - case core.ListClass.String(): - } - case core.StringClass.String(): - switch class1.String() { - case core.CharacterClass.String(): - case core.IntegerClass.String(): - return ParseNumber(e, object) - case core.FloatClass.String(): - return ParseNumber(e, object) - case core.SymbolClass.String(): - case core.StringClass.String(): - return object, nil - case core.GeneralVectorClass.String(): - v := make([]core.Instance, len(object.(core.String))) - for i, c := range object.(core.String) { - v[i] = core.NewCharacter(c) - } - return core.NewGeneralVector(v), nil - case core.ListClass.String(): - l := Nil - s := object.(core.String) - for i := len(s) - 1; i >= 0; i-- { - l = core.NewCons(core.NewCharacter(s[i]), l) - } - return l, nil - } - case core.GeneralVectorClass.String(): - switch class1.String() { - case core.CharacterClass.String(): - case core.IntegerClass.String(): - case core.FloatClass.String(): - case core.SymbolClass.String(): - case core.StringClass.String(): - case core.GeneralVectorClass.String(): - return object, nil - case core.ListClass.String(): - return List(e, object.(core.GeneralVector)...) - } - case core.ListClass.String(): - switch class1.String() { - case core.CharacterClass.String(): - case core.IntegerClass.String(): - case core.FloatClass.String(): - case core.SymbolClass.String(): - case core.StringClass.String(): - case core.GeneralVectorClass.String(): - v := core.NewGeneralVector([]core.Instance{}) - car, cdr, i := object.(*core.Cons).Car, object.(*core.Cons).Cdr, 0 - for cdr != Nil { - SetElt(e, car, v, core.NewInteger(i)) - car, cdr, i = cdr.(*core.Cons).Car, cdr.(*core.Cons).Cdr, i+1 - } - return v, nil - case core.ListClass.String(): - return object, nil - } - } - return SignalCondition(e, core.NewDomainError(e, object, core.ObjectClass), Nil) -} diff --git a/lib/convert_test.go b/lib/convert_test.go deleted file mode 100644 index 47438b5..0000000 --- a/lib/convert_test.go +++ /dev/null @@ -1,17 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "testing" - -func TestConvert(t *testing.T) { - execTests(t, Convert, []test{ - { - exp: `(convert 1.0 )`, - want: `1`, - wantErr: false, - }, - }) -} diff --git a/lib/define.go b/lib/define.go deleted file mode 100644 index b44c27c..0000000 --- a/lib/define.go +++ /dev/null @@ -1,91 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -// Defconstant is used to define a named constant in the variable namespace of -// the current toplevel scope. The scope of name is the entire current toplevel -// scope except the body form. Although name is globally constant, a variable -// binding for name can be ely established by a binding form. The result of the -// evaluation of form is bound to the variable named by name. The binding and -// the object created as the result of evaluating the second argument are -// immutable. The symbol named name is returned. -func Defconstant(e core.Environment, name, form core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.SymbolClass, name); err != nil { - return nil, err - } - if _, ok := e.Constant[:1].Get(name); ok { - return SignalCondition(e, core.NewImmutableBinding(e), Nil) - } - ret, err := Eval(e, form) - if err != nil { - return nil, err - } - e.Constant[:1].Define(name, ret) - return name, nil -} - -// Defglobal is used to define an identifier in the variable namespace of the -// current toplevel scope. The scope of name is the entire current toplevel -// scope except the body form. form is evaluated to compute an initializing -// value for the variable named name. Therefore, defglobal is used only for -// defining variables and not for modifying them. The symbol named name is -// returned. A lexical variable binding for name can still be ely established by -// a binding form; in that case, the e binding lexically shadows the outer -// binding of name defined by defe. -func Defglobal(e core.Environment, name, form core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.SymbolClass, name); err != nil { - return nil, err - } - if _, ok := e.Constant[:1].Get(name); ok { - return SignalCondition(e, core.NewImmutableBinding(e), Nil) - } - ret, err := Eval(e, form) - if err != nil { - return nil, err - } - e.Variable[:1].Define(name, ret) - return name, nil -} - -// Defdynamic is used to define a dynamic variable identifier in the dynamic -// variable namespace. The scope of name is the entire current toplevel scope -// except the body form.The symbol named name is returned. -func Defdynamic(e core.Environment, name, form core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.SymbolClass, name); err != nil { - return nil, err - } - if _, ok := e.Constant[:1].Get(name); ok { - return SignalCondition(e, core.NewImmutableBinding(e), Nil) - } - ret, err := Eval(e, form) - if err != nil { - return nil, err - } - e.DynamicVariable[:1].Define(name, ret) - return name, nil -} - -// Defun defines function-name as an identifier in the function namespace; -// function-name is bound to a function object equivalent to (lambda lambda-list -// form*). The scope of function-name is the whole current toplevel scope. -// Therefore, the definition of a function admits recursion, occurrences of -// function-name within the form* refer to the function being defined. The -// binding between function-name and the function object is immutable. defun -// returns the function name which is the symbol named function-name. The free -// identifiers in the body form* (i.e., those which are not contained in the -// lambda list) follow the rules of lexical scoping. -func Defun(e core.Environment, functionName, lambdaList core.Instance, forms ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.SymbolClass, functionName); err != nil { - return nil, err - } - ret, err := newNamedFunction(e, functionName, lambdaList, forms...) - if err != nil { - return nil, err - } - e.Function[:1].Define(functionName, ret) - return functionName, nil -} diff --git a/lib/dynamic.go b/lib/dynamic.go deleted file mode 100644 index a178095..0000000 --- a/lib/dynamic.go +++ /dev/null @@ -1,88 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -// Dynamic denotes a reference to the identifier denoting a dynamic variable. -// This special form is not allowed in the scope of a definition of var which is -// not done by defdynamic or dynamic-let. During activation, the current dynamic -// binding of the variable var is returned that was established most recently -// and is still in effect. An error shall be signaled if such a binding does not -// exist (error-id. unbound-variable). -func Dynamic(e core.Environment, var1 core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.SymbolClass, var1); err != nil { - return nil, err - } - if v, ok := e.DynamicVariable.Get(var1); ok { - return v, nil - } - if v, ok := e.DynamicVariable.Get(var1); ok { - return v, nil - } - return SignalCondition(e, core.NewUnboundVariable(e, var1), Nil) -} - -// SetDynamic denotes an assignment to a dynamic variable. This form can appear -// anywhere that (dynamic var) can appear. form is evaluated and the result of -// the evaluation is used to change the dynamic binding of var. An error shall -// be signaled if var has no dynamic value (error-id. unbound-variable). setf -// of dynamic can be used only for modifying bindings, and not for establishing -// them. -func SetDynamic(e core.Environment, form, var1 core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.SymbolClass, var1); err != nil { - return nil, err - } - form, err := Eval(e, form) - if err != nil { - return nil, form - } - if e.DynamicVariable.Set(var1, form) { - return form, nil - } - if e.DynamicVariable.Set(var1, form) { - return form, nil - } - return SignalCondition(e, core.NewUnboundVariable(e, var1), Nil) -} - -// DynamicLet is used to establish dynamic variable bindings. The first subform -// (the dynamic-let variable list) is a list of pairs (var form). The scope of -// an identifier var defined by dynamic-let is the current toplevel scope. The -// extent of the bindings of each var is the extent of the body of the -// dynamic-let. The dynamic-let special form establishes dynamic variables for -// all vars. References to a dynamic variable named by var must be made through -// the dynamic special form. All the initializing forms are evaluated -// sequentially from left to right, and then the values are associated with the -// corresponding vars. Using these additional dynamic bindings and the already -// existing bindings of visible identifiers, the forms body-form* are evaluated -// in sequential order. The returned value of dynamic-let is that of the last -// body-form of the body (or nil if there is none). The bindings are undone when -// control leaves the prepared dynamic-let special form. -func DynamicLet(e core.Environment, varForm core.Instance, bodyForm ...core.Instance) (core.Instance, core.Instance) { - if !Rep(Tpl(Sym(), Any))(varForm) { - return SignalCondition(e, core.NewDomainError(e, varForm, core.ListClass), Nil) - } - vfs := map[core.Instance]core.Instance{} - for _, cadr := range varForm.(core.List).Slice() { - if err := ensure(e, core.ListClass, cadr); err != nil { - return nil, err - } - if cadr.(core.List).Length() != 2 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - f, err := Eval(e, cadr.(core.List).Nth(1)) - if err != nil { - return nil, err - } - vfs[cadr.(core.List).Nth(0)] = f - } - for v, f := range vfs { - if !e.DynamicVariable.Define(v, f) { - return SignalCondition(e, core.NewImmutableBinding(e), Nil) - } - } - return Progn(e, bodyForm...) -} diff --git a/lib/dynamic_test.go b/lib/dynamic_test.go deleted file mode 100644 index 6914f48..0000000 --- a/lib/dynamic_test.go +++ /dev/null @@ -1,33 +0,0 @@ -package lib - -import "testing" - -func TestDynamic(t *testing.T) { - execTests(t, Dynamic, []test{ - { - exp: ` - (defun foo (x) - (dynamic-let ((y x)) - (bar 1) - )) - `, - want: `'foo`, - wantErr: false, - }, - { - exp: ` - (defun bar (x) - (+ x (dynamic y))) - `, - want: `'bar`, - wantErr: false, - }, - { - exp: ` - (foo 2) - `, - want: `3`, - wantErr: false, - }, - }) -} diff --git a/lib/equality.go b/lib/equality.go deleted file mode 100644 index 7c40057..0000000 --- a/lib/equality.go +++ /dev/null @@ -1,70 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import ( - "reflect" - - "github.com/islisp-dev/iris/core" -) - -func isComparable(t reflect.Type) bool { - if t.Comparable() { - if t.Kind() == reflect.Interface { - return false - } - if t.Kind() == reflect.Struct { - for i := 0; i < t.NumField(); i++ { - if !isComparable(t.Field(i).Type) { - return false - } - } - } - return true - } - return false -} - -// Eq tests whether obj1 and obj2 are same identical object. They return t if -// the objects are the same; otherwise, they return nil. Two objects are the -// same if there is no operation that could distinguish them (without modifying -// them), and if modifying one would modify the other the same way. -func Eq(e core.Environment, obj1, obj2 core.Instance) (core.Instance, core.Instance) { - v1, v2 := reflect.ValueOf(obj1), reflect.ValueOf(obj2) - if v1 == v2 || core.InstanceOf(core.SymbolClass, obj1) && core.InstanceOf(core.SymbolClass, obj2) && core.DeepEqual(obj1, obj2) { - return T, nil - } - return Nil, nil -} - -// Eql tests whether obj1 and obj2 are same identical object. They return t if -// the objects are the same; otherwise, they return nil. Two objects are the -// same if there is no operation that could distinguish them (without modifying -// them), and if modifying one would modify the other the same way. -func Eql(e core.Environment, obj1, obj2 core.Instance) (core.Instance, core.Instance) { - t1, t2 := reflect.TypeOf(obj1), reflect.TypeOf(obj2) - if isComparable(t1) || isComparable(t2) { - if core.DeepEqual(obj1, obj2) { - return T, nil - } - return Nil, nil - } - v1, v2 := reflect.ValueOf(obj1), reflect.ValueOf(obj2) - if v1 == v2 { - return T, nil - } - return Nil, nil -} - -// Equal tests whether obj1 and obj2 are isomorphic—i.e., whether obj1 and obj2 -// denote the same structure with equivalent values. equal returns t if the test -// was satisfied, and nil if not. Specifically: If obj1 and obj2 are direct -// instances of the same class, equal returns t if they are eql. -func Equal(e core.Environment, obj1, obj2 core.Instance) (core.Instance, core.Instance) { - if core.DeepEqual(obj1, obj2) { - return T, nil - } - return Nil, nil -} diff --git a/lib/eval.go b/lib/eval.go deleted file mode 100644 index 4496004..0000000 --- a/lib/eval.go +++ /dev/null @@ -1,228 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -func evalArguments(e core.Environment, arguments core.Instance) (core.Instance, core.Instance) { - // if arguments ends here - if core.DeepEqual(arguments, Nil) { - return Nil, nil - } - if err := ensure(e, core.ConsClass, arguments); err != nil { - return nil, err - } - car := arguments.(*core.Cons).Car // Checked there - cdr := arguments.(*core.Cons).Cdr // Checked there - a, err := Eval(e, car) - if err != nil { - return nil, err - } - b, err := evalArguments(e, cdr) - if err != nil { - return nil, err - } - return core.NewCons(a, b), nil - -} - -func evalLambda(e core.Environment, car, cdr core.Instance) (core.Instance, core.Instance, bool) { - // eval if lambda form - if core.InstanceOf(core.ConsClass, car) { - caar := car.(*core.Cons).Car // Checked at the top of// This sentence - if core.DeepEqual(caar, core.NewSymbol("LAMBDA")) { - fun, err := Eval(e, car) - if err != nil { - st, ok := err.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), core.SeriousConditionClass) - if !ok { - st = Nil - } - l, c := caar.(core.Symbol).Location() - loc := core.NewCons(core.NewCons(core.NewInteger(l), core.NewInteger(c)), st) - err.(core.BasicInstance).SetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), loc, core.SeriousConditionClass) - return nil, err, true - } - - arguments, err := evalArguments(e, cdr) - if err != nil { - st, ok := err.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), core.SeriousConditionClass) - if !ok { - st = Nil - } - l, c := caar.(core.Symbol).Location() - loc := core.NewCons(core.NewCons(core.NewInteger(l), core.NewInteger(c)), st) - err.(core.BasicInstance).SetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), loc, core.SeriousConditionClass) - return nil, err, true - } - ret, err := fun.(core.Applicable).Apply(e.NewDynamic(), arguments.(core.List).Slice()...) - if err != nil { - st, ok := err.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), core.SeriousConditionClass) - if !ok { - st = Nil - } - l, c := caar.(core.Symbol).Location() - loc := core.NewCons(core.NewCons(core.NewInteger(l), core.NewInteger(c)), st) - err.(core.BasicInstance).SetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), loc, core.SeriousConditionClass) - return nil, err, true - } - return ret, nil, true - } - } - return nil, nil, false -} - -func evalSpecial(e core.Environment, car, cdr core.Instance) (core.Instance, core.Instance, bool) { - // get special instance has value of Function interface - var spl core.Instance - if s, ok := e.Special.Get(car); ok { - spl = s - } - if spl != nil { - ret, err := spl.(core.Applicable).Apply(e.NewLexical(), cdr.(core.List).Slice()...) - if err != nil { - st, ok := err.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), core.SeriousConditionClass) - if !ok { - st = Nil - } - l, c := car.(core.Symbol).Location() - loc := core.NewCons(core.NewCons(core.NewInteger(l), core.NewInteger(c)), st) - err.(core.BasicInstance).SetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), loc, core.SeriousConditionClass) - return nil, err, true - } - return ret, nil, true - } - return nil, nil, false -} - -func evalMacro(e core.Environment, car, cdr core.Instance) (core.Instance, core.Instance, bool) { - // get special instance has value of Function interface - var mac core.Instance - if m, ok := e.Macro.Get(car); ok { - mac = m - } - if mac != nil { - ret, err := mac.(core.Applicable).Apply(e.NewDynamic(), cdr.(core.List).Slice()...) - if err != nil { - st, ok := err.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), core.SeriousConditionClass) - if !ok { - st = Nil - } - l, c := car.(core.Symbol).Location() - loc := core.NewCons(core.NewCons(core.NewInteger(l), core.NewInteger(c)), st) - err.(core.BasicInstance).SetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), loc, core.SeriousConditionClass) - return nil, err, true - } - ret, err = Eval(e, ret) - if err != nil { - st, ok := err.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), core.SeriousConditionClass) - if !ok { - st = Nil - } - l, c := car.(core.Symbol).Location() - loc := core.NewCons(core.NewCons(core.NewInteger(l), core.NewInteger(c)), st) - err.(core.BasicInstance).SetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), loc, core.SeriousConditionClass) - return nil, err, true - } - return ret, nil, true - } - return nil, nil, false -} - -func evalFunction(e core.Environment, car, cdr core.Instance) (core.Instance, core.Instance, bool) { - // get special instance has value of Function interface - var fun core.Instance - if f, ok := e.Function.Get(car); ok { - fun = f - } - if fun != nil { - arguments, err := evalArguments(e, cdr) - if err != nil { - st, ok := err.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), core.SeriousConditionClass) - if !ok { - st = Nil - } - l, c := car.(core.Symbol).Location() - loc := core.NewCons(core.NewCons(core.NewInteger(l), core.NewInteger(c)), st) - err.(core.BasicInstance).SetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), loc, core.SeriousConditionClass) - return nil, err, true - } - ret, err := fun.(core.Applicable).Apply(e.NewDynamic(), arguments.(core.List).Slice()...) - if err != nil { - st, ok := err.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), core.SeriousConditionClass) - if !ok { - st = Nil - } - l, c := car.(core.Symbol).Location() - loc := core.NewCons(core.NewCons(core.NewInteger(l), core.NewInteger(c)), st) - err.(core.BasicInstance).SetSlotValue(core.NewSymbol("IRIS.STACKTRACE"), loc, core.SeriousConditionClass) - return nil, err, true - } - return ret, nil, true - } - return nil, nil, false -} - -func evalCons(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.ConsClass, obj); err != nil { - return nil, err - } - if !isProperList(obj) { - return SignalCondition(e, core.NewParseError(e, obj, core.ListClass), Nil) - } - car := obj.(*core.Cons).Car // Checked at the top of// This function - cdr := obj.(*core.Cons).Cdr // Checked at the top of// This function - - // eval if lambda form - if a, b, c := evalLambda(e, car, cdr); c { - return a, b - } - // get special instance has value of Function interface - if a, b, c := evalSpecial(e, car, cdr); c { - return a, b - } - // get macro instance has value of Function interface - if a, b, c := evalMacro(e, car, cdr); c { - return a, b - } - // get function instance has value of Function interface - if a, b, c := evalFunction(e, car, cdr); c { - return a, b - } - err := core.NewUndefinedFunction(e, car) - return SignalCondition(e, err, Nil) -} - -func evalVariable(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if val, ok := e.Variable.Get(obj); ok { - return val, nil - } - if val, ok := e.Constant.Get(obj); ok { - return val, nil - } - err := core.NewUnboundVariable(e, obj) - return SignalCondition(e, err, Nil) -} - -// Eval evaluates any classs -func Eval(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.DeepEqual(obj, Nil) { - return Nil, nil - } - if core.InstanceOf(core.SymbolClass, obj) { - ret, err := evalVariable(e, obj) - if err != nil { - return nil, err - } - return ret, nil - } - if core.InstanceOf(core.ConsClass, obj) { - ret, err := evalCons(e, obj) - if err != nil { - return nil, err - } - return ret, nil - } - return obj, nil -} diff --git a/lib/ffi.go b/lib/ffi.go deleted file mode 100644 index e8d2e6c..0000000 --- a/lib/ffi.go +++ /dev/null @@ -1,44 +0,0 @@ -package lib - -import ( - "fmt" - "plugin" - "strings" - "github.com/islisp-dev/iris/core" -) - -// (import greet :from "greet.so") -func Import(env core.Environment, args ...core.Instance) (core.Instance, core.Instance) { - if len(args) < 2 { - return SignalCondition(env, core.Create(env, core.ProgramErrorClass), Nil) - } - if !core.DeepEqual(args[len(args)-2], core.NewSymbol(":FROM")) { - return SignalCondition(env, core.Create(env, core.ProgramErrorClass), Nil) - } - if !core.InstanceOf(core.StringClass, args[len(args)-1]) { - return SignalCondition(env, core.Create(env, core.ProgramErrorClass), Nil) - } - for i := 0; i < len(args) - 2; i++ { - if !core.InstanceOf(core.SymbolClass, args[i]) { - return SignalCondition(env, core.Create(env, core.ProgramErrorClass), Nil) - } - } - path := args[len(args)-1] - syms := args[:len(args)-2] - paths := string([]rune(path.(core.String))) - p, _ := plugin.Open(paths) - for _, sym := range syms { - str := sym.(core.Symbol).String() - str = strings.ToLower(str) - str = strings.Replace(str, "-", " ", -1) - str = strings.Title(str) - str = strings.Replace(str, " ", "", -1) - f, err := p.Lookup(str) - if err != nil { - fmt.Printf("%v is not exported\n", str) - return SignalCondition(env, core.Create(env, core.ProgramErrorClass), Nil) - } - env.Function[:1].Define(sym, core.NewFunction(sym, f)) - } - return Nil, nil -} diff --git a/lib/float.go b/lib/float.go deleted file mode 100644 index 05661ec..0000000 --- a/lib/float.go +++ /dev/null @@ -1,83 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import ( - "math" - - "github.com/islisp-dev/iris/core" -) - -// The value of MostPositiveFloat is the implementation-dependent floating-point -// number closest to positive infinity. The value of MostNegativeFloat is the -// implementation-dependent floating-point number closest to negative infinity. -var ( - MostPositiveFloat = core.NewFloat(math.MaxFloat64) - MostNegativeFloat = core.NewFloat(-math.MaxFloat64) -) - -// Floatp returns t if obj is a float (instance of class float); otherwise, -// returns nil. The obj may be any ISLISP object. -func Floatp(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.FloatClass, obj) { - return T, nil - } - return Nil, nil -} - -// Float returns x itself if it is an instance of the class float and returns a -// floating-point approximation of x otherwise. An error shall be signaled if x -// is not a number (error-id. domain-error). -func Float(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - f, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - return core.NewFloat(f), nil -} - -// Floor returns the greatest integer less than or equal to x . That is, x is -// truncated towards negative infinity. An error shall be signaled if x is not a -// number (error-id. domain-error). -func Floor(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - f, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - return core.NewInteger(int(math.Floor(f))), nil -} - -// Ceiling Returns the smallest integer that is not smaller than x. That is, x -// is truncated towards positive infinity. An error shall be signaled if x is -// not a number (error-id. domain-error). -func Ceiling(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - f, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - return core.NewInteger(int(math.Ceil(f))), nil -} - -// Truncate returns the integer between 0 and x (inclusive) that is nearest to -// x. That is, x is truncated towards zero. An error shall be signaled if x is -// not a number (error-id. domain-error). -func Truncate(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - f, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - return core.NewInteger(int(math.Trunc(f))), nil -} - -// Round returns the integer nearest to x. If x is exactly halfway between two -// integers, the even one is chosen. An error shall be signaled if x is not a -// number (error-id. domain-error). -func Round(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - f, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - return core.NewInteger(int(math.Floor(f + .5))), nil -} diff --git a/lib/format.go b/lib/format.go deleted file mode 100644 index 6f92b7d..0000000 --- a/lib/format.go +++ /dev/null @@ -1,200 +0,0 @@ -package lib - -import ( - "fmt" - "regexp" - "strconv" - "strings" - - "github.com/islisp-dev/iris/core" -) - -func FormatObject(e core.Environment, stream, object, escapep core.Instance) (core.Instance, core.Instance) { - if ok, _ := OpenStreamP(e, stream); ok == Nil { - return SignalCondition(e, core.NewDomainError(e, stream, core.StreamClass), Nil) - } - if core.DeepEqual(escapep, T) { - fmt.Fprint(stream.(core.Stream), object) - return Nil, nil - } - if ok, _ := Stringp(e, object); core.DeepEqual(ok, T) { - fmt.Fprint(stream.(core.Stream), string(object.(core.String))) - return Nil, nil - } - if ok, _ := Characterp(e, object); core.DeepEqual(ok, T) { - fmt.Fprint(stream.(core.Stream), string(object.(core.Character))) - return Nil, nil - } - fmt.Fprint(stream.(core.Stream), object) - return Nil, nil -} - -func FormatChar(e core.Environment, stream, object core.Instance) (core.Instance, core.Instance) { - if ok, _ := OpenStreamP(e, stream); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, stream, core.StreamClass), Nil) - } - if ok, _ := Characterp(e, object); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, object, core.CharacterClass), Nil) - } - fmt.Fprint(stream.(core.Stream), string(object.(core.Character))) - return Nil, nil -} - -func FormatFloat(e core.Environment, stream, object core.Instance) (core.Instance, core.Instance) { - if ok, _ := OpenStreamP(e, stream); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, stream, core.StreamClass), Nil) - } - if ok, _ := Floatp(e, object); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, object, core.FloatClass), Nil) - } - fmt.Fprint(stream.(core.Stream), float64(object.(core.Float))) - return Nil, nil -} - -func FormatInteger(e core.Environment, stream, object, radix core.Instance) (core.Instance, core.Instance) { - if ok, _ := OpenStreamP(e, stream); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, stream, core.StreamClass), Nil) - } - if ok, _ := Integerp(e, object); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, object, core.IntegerClass), Nil) - } - if ok, _ := Integerp(e, radix); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, radix, core.IntegerClass), Nil) - } - i := int(object.(core.Integer)) - r := int(radix.(core.Integer)) - fmt.Fprint(stream.(core.Stream), strings.ToUpper(strconv.FormatInt(int64(i), r))) - return Nil, nil -} - -func FormatTab(e core.Environment, stream, num core.Instance) (core.Instance, core.Instance) { - n := int(num.(core.Integer)) - if *stream.(core.Stream).Column < n { - for i := *stream.(core.Stream).Column; i < n; i++ { - if _, err := FormatChar(e, stream, core.NewCharacter(' ')); err != nil { - return nil, err - } - } - return Nil, nil - } - return FormatChar(e, stream, core.NewCharacter(' ')) -} - -func FormatFreshLine(e core.Environment, stream core.Instance) (core.Instance, core.Instance) { - if *stream.(core.Stream).Column != 0 { - return FormatChar(e, stream, core.NewCharacter('\n')) - } - return Nil, nil -} - -func Format(e core.Environment, stream, formatString core.Instance, formatArguments ...core.Instance) (core.Instance, core.Instance) { - if ok, _ := Stringp(e, formatString); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, formatString, core.StringClass), Nil) - } - str := string(formatString.(core.String)) - re := regexp.MustCompile(`~(?:[0-9]+[RT]|.)`) - start, end, index := 0, 0, 0 - for loc := re.FindStringIndex(str[start:]); loc != nil; loc = re.FindStringIndex(str[start:]) { - base := start - start = base + 0 - end = base + loc[0] - if _, err := FormatObject(e, stream, core.NewString([]rune(str[start:end])), Nil); err != nil { - return nil, err - } - start = base + loc[0] - end = base + loc[1] - var err core.Instance - switch str[start:end] { - case "~A": - if index >= len(formatArguments) { - _, err = SignalCondition(e, core.NewArityError(e), Nil) - } else { - _, err = FormatObject(e, stream, formatArguments[index], Nil) - index++ - } - case "~B": - if index >= len(formatArguments) { - _, err = SignalCondition(e, core.NewArityError(e), Nil) - } else { - _, err = FormatInteger(e, stream, formatArguments[index], core.NewInteger(2)) - index++ - } - case "~C": - if index >= len(formatArguments) { - _, err = SignalCondition(e, core.NewArityError(e), Nil) - } else { - _, err = FormatChar(e, stream, formatArguments[index]) - index++ - } - case "~D": - if index >= len(formatArguments) { - _, err = SignalCondition(e, core.NewArityError(e), Nil) - } else { - _, err = FormatInteger(e, stream, formatArguments[index], core.NewInteger(10)) - index++ - } - case "~G": - if index >= len(formatArguments) { - _, err = SignalCondition(e, core.NewArityError(e), Nil) - } else { - _, err = FormatFloat(e, stream, formatArguments[index]) - index++ - } - case "~O": - if index >= len(formatArguments) { - _, err = SignalCondition(e, core.NewArityError(e), Nil) - } else { - _, err = FormatInteger(e, stream, formatArguments[index], core.NewInteger(8)) - index++ - } - case "~S": - if index >= len(formatArguments) { - _, err = SignalCondition(e, core.NewArityError(e), Nil) - } else { - _, err = FormatObject(e, stream, formatArguments[index], T) - index++ - } - case "~X": - if index >= len(formatArguments) { - _, err = SignalCondition(e, core.NewArityError(e), Nil) - } else { - _, err = FormatInteger(e, stream, formatArguments[index], core.NewInteger(16)) - index++ - } - case "~%": - _, err = FormatChar(e, stream, core.NewCharacter('\n')) - case "~&": - _, err = FormatFreshLine(e, stream) - case "~~": - _, err = FormatChar(e, stream, core.NewCharacter('~')) - default: - s := str[start:end] - if len(s) > 2 { - if s[len(s)-1] == 'R' { - if index >= len(formatArguments) { - _, err = SignalCondition(e, core.NewArityError(e), Nil) - } else { - n, _ := strconv.Atoi(s[1 : len(s)-1]) - if n < 2 || 36 < n { - _, err = SignalCondition(e, core.NewDomainError(e, core.NewInteger(n), core.IntegerClass), Nil) - } else { - _, err = FormatInteger(e, stream, formatArguments[index], core.NewInteger(n)) - index++ - } - } - } - if s[len(s)-1] == 'T' { - n, _ := strconv.Atoi(s[1 : len(s)-1]) - _, err = FormatTab(e, stream, core.NewInteger(n)) - } - } - } - if err != nil { - return nil, err - } - start = end - } - r, err := FormatObject(e, stream, core.NewString([]rune(str[start:])), Nil) - stream.(core.Stream).Flush() - return r, err -} diff --git a/lib/format_test.go b/lib/format_test.go deleted file mode 100644 index e7928c9..0000000 --- a/lib/format_test.go +++ /dev/null @@ -1,59 +0,0 @@ -package lib - -import "testing" - -func TestFormat(t *testing.T) { - execTests(t, Format, []test{ - { - exp: `(defglobal str (create-string-output-stream))`, - want: `'str`, - wantErr: false, - }, - { - exp: `(progn (format str "test") (get-output-stream-string str))`, - want: `"test"`, - wantErr: false, - }, - { - exp: `(progn (format str "The result is ~A and nothing else." "meningitis") (get-output-stream-string str))`, - want: `"The result is meningitis and nothing else."`, - wantErr: false, - }, - { - exp: `(progn (format str "The result i~C" #\s) (get-output-stream-string str))`, - want: `"The result is"`, - wantErr: false, - }, - { - exp: `(progn (format str "The results are ~S and ~S" 1 #\a) (get-output-stream-string str))`, - want: `"The results are 1 and #\a"`, - wantErr: false, - }, - { - exp: `(progn (format str "Binary code ~B" 150) (get-output-stream-string str))`, - want: `"Binary code 10010110"`, - wantErr: false, - }, - { - exp: `(progn (format str "permission ~O" 493) (get-output-stream-string str))`, - want: `"permission 755"`, - wantErr: false, - }, - { - exp: `(progn (format str "You ~X ~X" 2989 64206) (get-output-stream-string str))`, - want: `"You BAD FACE"`, - wantErr: false, - }, - { - // Implementation defined - exp: `(progn (format str "~&Name ~10Tincome ~20Ttax~%") (format str "~A ~10T~D ~20T~D" "Grummy" 23000 7500) (get-output-stream-string str))`, - want: `(progn (format str "~%Name income tax~%Grummy 23000 7500") (get-output-stream-string str))`, - wantErr: false, - }, - { - exp: `(progn (format str "This is a tilde: ~~") (get-output-stream-string str))`, - want: `"This is a tilde: ~"`, - wantErr: false, - }, - }) -} diff --git a/lib/function.go b/lib/function.go deleted file mode 100644 index 622be18..0000000 --- a/lib/function.go +++ /dev/null @@ -1,164 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -// Functionp returns t if obj is a (normal or generic) function; otherwise, -// returns nil. obj may be any ISLISP object. Function bindings are entities -// established during execution of a prepared labels or flet forms or by a -// function-defining form. A function binding is an association between an -// identifier, function-name, and a function object that is denoted by -// function-name—if in operator position—or by (function function-name) -// elsewhere. -func Functionp(e core.Environment, fun core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.FunctionClass, fun) { - return T, nil - } - return Nil, nil -} - -// Function returns the function object named by function-name. An error shall -// be signaled if no binding has been established for the identifier in the -// function namespace of current lexical eironment (error-id. -// undefined-function). The consequences are undefined if the function-name -// names a macro or special form -func Function(e core.Environment, fun core.Instance) (core.Instance, core.Instance) { - // car must be a symbol - if err := ensure(e, core.SymbolClass, fun); err != nil { - return nil, err - } - if f, ok := e.Function.Get(fun); ok { - return f, nil - } - if f, ok := e.Function.Get(fun); ok { - return f, nil - } - return SignalCondition(e, core.NewUndefinedFunction(e, fun), Nil) -} - -// Lambda special form creates a function object. The scope of the identifiers -// of the lambda-list is the sequence of forms form*, collectively referred to -// as the body. When the prepared function is activated later (even if -// transported as object to some other activation) with some arguments, the body -// of the function is evaluated as if it was at the same textual position where -// the lambda special form is located, but in a context where the lambda -// variables are bound in the variable namespace with the values of the -// corresponding arguments. A &rest or :rest variable, if any, is bound to the -// list of the values of the remaining arguments. An error shall be signaled if -// the number of arguments received is incompatible with the specified -// lambda-list (error-id. arity-error). Once the lambda variables have been -// bound, the body is executed. If the body is empty, nil is returned otherwise -// the result of the evaluation of the last form of body is returned if the body -// was not left by a non-e exit. If the function receives a &rest or :rest -// parameter R, the list L1 to which that parameter is bound has indefinite -// extent. L1 is newly allocated unless the function was called with apply and R -// corresponds to the final argument, L2 , to that call to apply (or some -// subtail of L2), in which case it is implementation defined whether L1 shares -// structure with L2 . -func Lambda(e core.Environment, lambdaList core.Instance, form ...core.Instance) (core.Instance, core.Instance) { - if err := checkLambdaList(e, lambdaList); err != nil { - return nil, err - } - return newNamedFunction(e, core.NewSymbol("ANONYMOUS-FUNCTION"), lambdaList, form...) -} - -// Labels special form allow the definition of new identifiers in the function -// namespace for function objects. In a labels special form the scope of an -// identifier function-name is the whole labels special form (excluding nested -// scopes, if any); for the flet special form, the scope of an identifier is -// only the body-form*. Within these scopes, each function-name is bound to a -// function object whose behavior is equivalent to (lambda lambda-list form*), -// where free identifier references are resolved as follows: For a labels form, -// such free references are resolved in the lexical eironment that was active -// immediately outside the labels form augmented by the function bindings for -// the given function-names (i.e., any reference to a function function-name -// refers to a binding created by the labels). For a flet form, free identifier -// references in the lambda-expression are resolved in the lexical eironment -// that was active immediately outside the flet form (i.e., any reference to a -// function function-name are not visible). During activation, the prepared -// labels or flet establishes function bindings and then evaluates each -// body-form in the body sequentially; the value of the last one (or nil if -// there is none) is the value returned by the special form activation. No -// function-name may appear more than once in the function bindings. -func Labels(e core.Environment, functions core.Instance, bodyForm ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.ListClass, functions); err != nil { - return nil, err - } - for _, function := range functions.(core.List).Slice() { - if err := ensure(e, core.ListClass, function); err != nil { - return nil, err - } - definition := function.(core.List).Slice() - if len(definition) < 2 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - functionName := definition[0] - lambdaList := definition[1] - forms := definition[2:] - fun, err := newNamedFunction(e, functionName, lambdaList, forms...) - if err != nil { - return nil, err - } - if !e.Function.Define(functionName, fun) { - return SignalCondition(e, core.NewImmutableBinding(e), Nil) - } - } - return Progn(e, bodyForm...) -} - -// Flet special form allow the definition of new identifiers in the function -// namespace for function objects (see Labels). -func Flet(e core.Environment, functions core.Instance, bodyForm ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.ListClass, functions); err != nil { - return nil, err - } - newEnv := e.NewLexical() - for _, function := range functions.(core.List).Slice() { - if err := ensure(e, core.ListClass, function); err != nil { - return nil, err - } - definition := function.(core.List).Slice() - if len(definition) < 2 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - functionName := definition[0] - lambdaList := definition[1] - forms := definition[2:] - fun, err := newNamedFunction(e, functionName, lambdaList, forms...) - if err != nil { - return nil, err - } - if !newEnv.Function.Define(functionName, fun) { - return SignalCondition(e, core.NewImmutableBinding(e), Nil) - } - } - return Progn(newEnv, bodyForm...) -} - -// Apply applies function to the arguments, obj*, followed by the elements of -// list, if any. It returns the value returned by function. An error shall be -// signaled if function is not a function (error-id. domain-error). Each obj may -// be any ISLISP object. An error shall be signaled if list is not a proper list -// (error-id. improper-argument-list). -func Apply(e core.Environment, function core.Instance, obj ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.FunctionClass, function); err != nil { - return nil, err - } - if err := ensure(e, core.ListClass, obj[len(obj)-1]); err != nil { - return nil, err - } - obj = append(obj[:len(obj)-1], obj[len(obj)-1].(core.List).Slice()...) - return function.(core.Applicable).Apply(e, obj...) -} - -// Funcall activates the specified function function and returns the value that -// the function returns. The ith argument (2 ≤ i) of funcall becomes the (i − -// 1)th argument of the function. An error shall be signaled if function is not -// a function (error-id. domain-error). Each obj may be any ISLISP object. -func Funcall(e core.Environment, function core.Instance, obj ...core.Instance) (core.Instance, core.Instance) { - obj = append(obj, Nil) - return Apply(e, function, obj...) -} diff --git a/lib/identity.go b/lib/identity.go deleted file mode 100644 index ac4f351..0000000 --- a/lib/identity.go +++ /dev/null @@ -1,10 +0,0 @@ -package lib - -import "github.com/islisp-dev/iris/core" - -func Identity(e core.Environment, xs ...core.Instance) (core.Instance, core.Instance) { - if len(xs) != 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - return xs[0], nil -} diff --git a/lib/identity_test.go b/lib/identity_test.go deleted file mode 100644 index dca3931..0000000 --- a/lib/identity_test.go +++ /dev/null @@ -1,13 +0,0 @@ -package lib - -import "testing" - -func TestIdentity(t *testing.T) { - execTests(t, Identity, []test{ - { - exp: `(identity 1)`, - want: `1`, - wantErr: false, - }, - }) -} diff --git a/lib/integer.go b/lib/integer.go deleted file mode 100644 index 14b2681..0000000 --- a/lib/integer.go +++ /dev/null @@ -1,127 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import ( - "math" - - "github.com/islisp-dev/iris/core" -) - -func convInt(e core.Environment, z core.Instance) (int, core.Instance) { - if err := ensure(e, core.IntegerClass, z); err != nil { - return 0, err - } - return int(z.(core.Integer)), nil -} - -// Integerp returns t if obj is an integer (instance of class integer); -// otherwise, returns nil. obj may be any ISLISP object. -func Integerp(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.IntegerClass, obj) { - return T, nil - } - return Nil, nil -} - -// Div returns the greatest integer less than or equal to the quotient of z1 and -// z2. An error shall be signaled if z2 is zero (error-id. division-by-zero). -func Div(e core.Environment, z1, z2 core.Instance) (core.Instance, core.Instance) { - a, err := convInt(e, z1) - if err != nil { - return nil, err - } - b, err := convInt(e, z2) - if err != nil { - return nil, err - } - if b == 0 { - operation := core.NewSymbol("DIV") - operands, err := List(e, z1, z2) - if err != nil { - return nil, err - } - return SignalCondition(e, core.NewArithmeticError(e, operation, operands), Nil) - } - if a*b < 0 { // Issue #2 - return core.NewInteger(a/b - 1), nil - } - return core.NewInteger(a / b), nil -} - -// Mod returns the remainder of the integer division of z1 by z2. The sign of -// the result is the sign of z2. The result lies between 0 (inclusive) and z2 -// (exclusive), and the difference of z1 and this result is divisible by z2 -// without remainder. An error shall be signaled if either z1 or z2 is not an -// integer (error-id. domain-error). -func Mod(e core.Environment, z1, z2 core.Instance) (core.Instance, core.Instance) { - f, err := Div(e, z1, z2) - if err != nil { - return nil, err - } - g, err := Multiply(e, f, z2) - if err != nil { - return nil, err - } - return Substruct(e, z1, g) // Issue #2 -} - -// Gcd returns the greatest common divisor of its integer arguments. The result -// is a non-negative integer. For nonzero arguments the greatest common divisor -// is the largest integer z such that z1 and z2 are integral multiples of z. An -// error shall be signaled if either z1 or z2 is not an integer (error-id. -// domain-error). -func Gcd(e core.Environment, z1, z2 core.Instance) (core.Instance, core.Instance) { - gcd := func(x, y int) int { - for y != 0 { - x, y = y, x%y - } - return x - } - a, err := convInt(e, z1) - if err != nil { - return nil, err - } - b, err := convInt(e, z2) - if err != nil { - return nil, err - } - return core.NewInteger(gcd(a, b)), nil -} - -// Lcm returns the least common multiple of its integer arguments. An error -// shall be signaled if either z1 or z2 is not an integer (error-id. -// domain-error). -func Lcm(e core.Environment, z1, z2 core.Instance) (core.Instance, core.Instance) { - gcd := func(x, y int) int { - for y != 0 { - x, y = y, x%y - } - return x - } - a, err := convInt(e, z1) - if err != nil { - return nil, err - } - b, err := convInt(e, z2) - if err != nil { - return nil, err - } - return core.NewInteger(a * b / gcd(a, b)), nil -} - -// Isqrt Returns the greatest integer less than or equal to the exact positive -// square root of z . An error shall be signaled if z is not a non-negative -// integer (error-id. domain-error). -func Isqrt(e core.Environment, z core.Instance) (core.Instance, core.Instance) { - a, err := convInt(e, z) - if err != nil { - return nil, err - } - if a < 0 { - return SignalCondition(e, core.NewDomainError(e, z, core.NumberClass), Nil) - } - return core.NewInteger(int(math.Sqrt(float64(a)))), nil -} diff --git a/lib/iteration.go b/lib/iteration.go deleted file mode 100644 index 54177d4..0000000 --- a/lib/iteration.go +++ /dev/null @@ -1,120 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -// While the test-form returns a true value. Specifically: 1. test-form is -// evaluated, producing a value Vt. 2. If Vt is nil, then the while form -// immediately returns nil. 3. Otherwise, if Vt is non-nil, the forms body-form* -// are evaluated sequentially (from left to right). 4. Upon successful -// completion of the body-forms*, the while form begins again with step 1. -func While(e core.Environment, testForm core.Instance, bodyForm ...core.Instance) (core.Instance, core.Instance) { - test, err := Eval(e, testForm) - if err != nil { - return nil, err - } - for core.DeepEqual(test, T) { - _, err := Progn(e, bodyForm...) - if err != nil { - return nil, err - } - test, err = Eval(e, testForm) - if err != nil { - return nil, err - } - } - return Nil, nil -} - -// For repeatedly executes a sequence of forms form*, called its body. It -// specifies a set of identifiers naming variables that will be e to the for -// form, their initialization, and their update for each iteration. When a -// termination condition is met, the iteration exits with a specified result -// value. The scope of an identifier var is the body, the steps, the end-test , -// and the result *. A step might be omitted, in which case the effect is the -// same as if (var init var) had been written instead of (var init). It is a -// violation if more than one iteration-spec names the same var in the same for -// form. The for special form is executed as follows: The init forms are -// evaluated sequentially from left to right. Then each value is used as the -// initial value of the variable denoted by the corresponding identifier var , -// and the iteration phase begins. Each iteration begins by evaluating end-test -// . If the result is nil, the forms in the body are evaluated sequentially (for -// side-effects). Afterwards, the step-forms are evaluated sequentially order -// from left to right. Then their values are assigned to the corresponding -// variables and the next iteration begins. If end-test returns a non-nil value, -// then the result * are evaluated sequentially and the value of the last one is -// returned as value of the whole for macro. If no result is present, then the -// value of the for macro is nil. -func For(e core.Environment, iterationSpecs, endTestAndResults core.Instance, forms ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.ListClass, iterationSpecs); err != nil { - return nil, err - } - a := e.NewLexical() - for _, is := range iterationSpecs.(core.List).Slice() { - if err := ensure(e, core.ListClass, is); err != nil { - return nil, err - } - i := is.(core.List).Slice() - switch len(i) { - case 2, 3: - var1 := i[0] - init, err := Eval(e, i[1]) - if err != nil { - return nil, err - } - if !a.Variable.Define(var1, init) { - return SignalCondition(e, core.NewImmutableBinding(e), Nil) - } - default: - return SignalCondition(e, core.NewArityError(e), Nil) - } - } - if err := ensure(e, core.ListClass, endTestAndResults); err != nil { - return nil, err - } - ends := endTestAndResults.(core.List).Slice() - if len(ends) == 0 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - endTest := ends[0] - results := ends[1:] - test, err := Eval(a, endTest) - if err != nil { - return nil, err - } - for core.DeepEqual(test, Nil) { - _, err := Progn(a, forms...) - if err != nil { - return nil, err - } - b := a.NewLexical() - for _, is := range iterationSpecs.(core.List).Slice() { - if err := ensure(e, core.ListClass, is); err != nil { - return nil, err - } - switch is.(core.List).Length() { - case 2: - case 3: - var1 := is.(core.List).Nth(0) - step, err := Eval(a, is.(core.List).Nth(2)) - if err != nil { - return nil, err - } - if !b.Variable.Define(var1, step) { - return SignalCondition(e, core.NewImmutableBinding(e), Nil) - } - default: - return SignalCondition(e, core.NewArityError(e), Nil) - } - } - test, err = Eval(b, endTest) - if err != nil { - return nil, err - } - a = b - } - return Progn(a, results...) -} diff --git a/lib/iteration_test.go b/lib/iteration_test.go deleted file mode 100644 index c2d3996..0000000 --- a/lib/iteration_test.go +++ /dev/null @@ -1,48 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "testing" - -func TestWhile(t *testing.T) { - execTests(t, While, []test{ - { - exp: ` - (let ((x '()) - (i 5)) - (while (> i 0) - (setq x (cons i x)) - (setq i (- i 1))) - x) - `, - want: `'(1 2 3 4 5)`, - wantErr: false, - }, - }) -} -func TestFor(t *testing.T) { - execTests(t, For, []test{ - { - exp: ` - (for ((vec (vector 0 0 0 0 0)) - (i 0 (+ i 1))) - ((= i 5) vec) - (setf (elt vec i) i)) - `, - want: `#(0 1 2 3 4)`, - wantErr: false, - }, - { - exp: ` - (let ((x '(1 3 5 7 9))) - (for ((x x (cdr x)) - (sum 0 (+ sum (car x)))) - ((null x) sum))) - `, - want: `25`, - wantErr: false, - }, - }) -} diff --git a/lib/list.go b/lib/list.go deleted file mode 100644 index c90f066..0000000 --- a/lib/list.go +++ /dev/null @@ -1,293 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -// Listp returns t if obj is a list (instance of class list); otherwise, returns -// nil. obj may be any ISLISP object. -func Listp(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.ListClass, obj) { - return T, nil - } - return Nil, nil -} - -// CreateList returns a list of length i. If initial-element is given, the -// elements of the new list are initialized with this object; otherwise, the -// initialization is implementation defined. An error shall be signaled if the -// requested list cannot be allocated (error-id. cannot-create-list). An error -// shall be signaled if i is not a non-negative integer (error-id. -// domain-error).initial-element may be any ISLISP object. -func CreateList(e core.Environment, i core.Instance, initialElement ...core.Instance) (core.Instance, core.Instance) { - if ok, _ := Integerp(e, i); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, i, core.IntegerClass), Nil) - } - if len(initialElement) > 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - elm := Nil - if len(initialElement) == 1 { - elm = initialElement[0] - } - cons := Nil - for j := 0; j < int(i.(core.Integer)); j++ { - cons = core.NewCons(elm, cons) - } - return cons, nil -} - -// List returns a new list whose length is the number of arguments and whose -// elements are the arguments in the same order as in the list-form. An error -// shall be signaled if the requested list cannot be allocated (error-id. -// cannot-create-list). Each obj may be any ISLISP object. -func List(e core.Environment, objs ...core.Instance) (core.Instance, core.Instance) { - cons := Nil - for i := len(objs) - 1; i >= 0; i-- { - cons = core.NewCons(objs[i], cons) - } - return cons, nil -} - -// Reverse returns a list whose elements are those of the given list, but in -// reverse order. An error shall be signaled if list is not a list (error-id. -// domain-error). For reverse, no side-effect to the given list occurs. The -// resulting list is permitted but not required to share structure with the -// input list. -func Reverse(e core.Environment, list core.Instance) (core.Instance, core.Instance) { - if ok, _ := Listp(e, list); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, list, core.ListClass), Nil) - } - cons := Nil - for _, car := range list.(core.List).Slice() { - cons = core.NewCons(car, cons) - } - return cons, nil -} - -// Nreverse returns a list whose elements are those of the given list, but in -// reverse order. An error shall be signaled if list is not a list (error-id. -// domain-error). For nreverse, the conses which make up the top level of the -// given list are permitted, but not required, to be side-effected in order to -// produce this new list. nreverse should never be called on a literal object. -func Nreverse(e core.Environment, list core.Instance) (core.Instance, core.Instance) { - // TODO: tests literal object - if ok, _ := Listp(e, list); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, list, core.ListClass), Nil) - } - cons := Nil - for _, car := range list.(core.List).Slice() { - cons = core.NewCons(car, cons) - } - return cons, nil -} - -// Append returns the result of appending all of the lists, or () if given no -// lists. An error shall be signaled if any list is not a list (error-id. -// domain-error). This function does not modify its arguments. It is -// implementation defined whether and when the result shares structure with its -// list arguments. An error shall be signaled if the list cannot be allocated -// (error-id. cannot-create-list). -func Append(e core.Environment, lists ...core.Instance) (core.Instance, core.Instance) { - // Ref: https://github.com/sbcl/sbcl/blob/fe4faef65315c6ad52b3b89b62b6c6497cb78d09/src/code/list.lisp#L364 - - result, err := List(e, Nil) - if err != nil { - return nil, err - } - cdr := result - for _, list := range lists { - if ok, _ := Listp(e, list); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, list, core.ListClass), Nil) - } - } - for _, list := range lists { - for _, elt := range list.(core.List).Slice() { - it, err := List(e, elt) - if err != nil { - return nil, err - } - cdr.(*core.Cons).Cdr = it - cdr = cdr.(*core.Cons).Cdr - } - } - return result.(*core.Cons).Cdr, nil -} - -// Member returnes the first sublist of list whose car is obj if list contains -// at least one occurrence of obj (as determined by eql). Otherwise, nil is -// returned. An error shall be signaled if list is not a list (error-id. -// domain-error). -func Member(e core.Environment, obj, list core.Instance) (core.Instance, core.Instance) { - if ok, _ := Listp(e, list); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, list, core.ListClass), Nil) - } - if !core.InstanceOf(core.ConsClass, list) || core.DeepEqual(list.(*core.Cons).Car, obj) { - return list, nil - } - if !core.InstanceOf(core.ConsClass, list.(*core.Cons).Cdr) { - return list.(*core.Cons).Cdr, nil - } - return Member(e, obj, list.(*core.Cons).Cdr) -} - -// Mapcar operates on successive elements of the lists. function is applied to -// the first element of each list, then to the second element of each list, and -// so on. The iteration terminates when the shortest list runs out, and excess -// elements in other lists are ignored. The value returned by mapcar is a list -// of the results of successive calls to function. -func Mapcar(e core.Environment, function, list1 core.Instance, lists ...core.Instance) (core.Instance, core.Instance) { - lists = append([]core.Instance{list1}, lists...) - if ok, _ := Functionp(e, function); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, function, core.FunctionClass), Nil) - } - for _, list := range lists { - if ok, _ := Listp(e, list); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, list, core.ListClass), Nil) - } - } - arguments := []core.Instance{} - rests := []core.Instance{} - for _, list := range lists { - if core.DeepEqual(list, Nil) { - return Nil, nil - } - arguments = append(arguments, list.(*core.Cons).Car) - rests = append(rests, list.(*core.Cons).Cdr) - } - car, err := function.(core.Applicable).Apply(e.NewDynamic(), arguments...) - if err != nil { - return nil, err - } - var cdr core.Instance - for _, list := range lists { - if ok, _ := Listp(e, list); core.DeepEqual(ok, Nil) { - cdr = Nil - } - } - if core.DeepEqual(cdr, nil) { - cdr, err = Mapcar(e, function, rests[0], rests[1:]...) - if err != nil { - return nil, err - } - } - return Cons(e, car, cdr) -} - -// Mapc is like mapcar except that the results of applying function are not -// accumulated; list1 is returned. -func Mapc(e core.Environment, function, list1 core.Instance, lists ...core.Instance) (core.Instance, core.Instance) { - _, err := Mapcar(e, function, list1, lists...) - if err != nil { - return nil, err - } - return list1, nil -} - -// Mapcan is like mapcar respectively, except that the results of applying -// function are combined into a list by the use of an operation that performs a -// destructive form of append rather than list. -func Mapcan(e core.Environment, function, list1 core.Instance, lists ...core.Instance) (core.Instance, core.Instance) { - list, err := Mapcar(e, function, list1, lists...) - if err != nil { - return nil, err - } - append, _ := e.Function.Get(core.NewSymbol("APPEND")) - return Apply(e, append, list) -} - -// Maplist is like mapcar except that function is applied to successive sublists -// of the lists. function is first applied to the lists themselves, and then to -// the cdr of each list, and then to the cdr of the cdr of each list, and so on. -func Maplist(e core.Environment, function, list1 core.Instance, lists ...core.Instance) (core.Instance, core.Instance) { - lists = append([]core.Instance{list1}, lists...) - if ok, _ := Functionp(e, function); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, function, core.FunctionClass), Nil) - } - for _, list := range lists { - if ok, _ := Listp(e, list); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, list, core.ListClass), Nil) - } - } - arguments := []core.Instance{} - rests := []core.Instance{} - for _, list := range lists { - if core.DeepEqual(list, Nil) { - return Nil, nil - } - arguments = append(arguments, list) - rests = append(rests, list.(*core.Cons).Cdr) - } - car, err := function.(core.Applicable).Apply(e.NewDynamic(), arguments...) - if err != nil { - return nil, err - } - var cdr core.Instance - for _, list := range lists { - if ok, _ := Listp(e, list); core.DeepEqual(ok, Nil) { - cdr = Nil - } - } - if core.DeepEqual(cdr, nil) { - cdr, err = Maplist(e, function, rests[0], rests[1:]...) - if err != nil { - return nil, err - } - } - return Cons(e, car, cdr) -} - -// Mapl is like maplist except that the results of applying function are not -// accumulated; list1 is returned. -func Mapl(e core.Environment, function, list1 core.Instance, lists ...core.Instance) (core.Instance, core.Instance) { - _, err := Maplist(e, function, list1, lists...) - if err != nil { - return nil, err - } - return list1, nil -} - -// Mapcon is like maplist respectively, except that the results of applying -// function are combined into a list by the use of an operation that performs a -// destructive form of append rather than list. -func Mapcon(e core.Environment, function, list1 core.Instance, lists ...core.Instance) (core.Instance, core.Instance) { - list, err := Maplist(e, function, list1, lists...) - if err != nil { - return nil, err - } - append, _ := e.Function.Get(core.NewSymbol("APPEND")) - return Apply(e, append, list) -} - -// Assoc returns the first cons if assocation-list contains at least one cons -// whose car is obj (as determined by eql). Otherwise, nil is returned. An error -// shall be signaled if association-list is not a list of conses (error-id. -// domain-error). -func Assoc(e core.Environment, obj, associationList core.Instance) (core.Instance, core.Instance) { - if ok, _ := Listp(e, associationList); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, associationList, core.ListClass), Nil) - } - if !core.InstanceOf(core.ConsClass, associationList) { - return Nil, nil - } - car := associationList.(*core.Cons).Car - cdr := associationList.(*core.Cons).Cdr - if ok, _ := Consp(e, car); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, car, core.ConsClass), Nil) - } - if core.DeepEqual(car.(*core.Cons).Car, obj) { // eql - return car, nil - } - return Assoc(e, obj, cdr) -} - -// Null returns t if obj is nil; otherwise, returns nil obj may be any ISLISP -// object. -func Null(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.DeepEqual(obj, Nil) { - return T, nil - } - return Nil, nil -} diff --git a/lib/list_test.go b/lib/list_test.go deleted file mode 100644 index 1d1cafb..0000000 --- a/lib/list_test.go +++ /dev/null @@ -1,256 +0,0 @@ -package lib - -import "testing" - -func TestNull(t *testing.T) { - execTests(t, Null, []test{ - { - exp: `(null '(a b c))`, - want: `nil`, - wantErr: false, - }, - { - exp: `(null '())`, - want: `t`, - wantErr: false, - }, - { - exp: `(null (list))`, - want: `t`, - wantErr: false, - }, - }) -} - -func TestListp(t *testing.T) { - execTests(t, Listp, []test{ - { - exp: `(listp '(a b c))`, - want: `t`, - wantErr: false, - }, - { - exp: `(listp '())`, - want: `t`, - wantErr: false, - }, - { - exp: `(listp '(a . b))`, - want: `t`, - wantErr: false, - }, - { - exp: ` - (let ((x (list 'a))) - (setf (cdr x) x) - (listp x)) - `, - want: `t`, - wantErr: false, - }, - { - exp: `(listp "abc")`, - want: `nil`, - wantErr: false, - }, - { - exp: `(listp #(1 2))`, - want: `nil`, - wantErr: false, - }, - { - exp: `(listp 'jerome)`, - want: `nil`, - wantErr: false, - }, - }) -} - -func TestCreateList(t *testing.T) { - execTests(t, CreateList, []test{ - { - exp: `(create-list 3 17)`, - want: `'(17 17 17)`, - wantErr: false, - }, - { - exp: `(create-list 2 #\a)`, - want: `'(#\a #\a)`, - wantErr: false, - }, - }) -} - -func TestList(t *testing.T) { - execTests(t, List, []test{ - { - exp: `(list 'a (+ 3 4) 'c)`, - want: `'(a 7 c)`, - wantErr: false, - }, - { - exp: `(list)`, - want: `nil`, - wantErr: false, - }, - }) -} - -func TestReverse(t *testing.T) { - execTests(t, Reverse, []test{ - { - exp: `(reverse '(a b c d e))`, - want: `'(e d c b a)`, - wantErr: false, - }, - { - exp: `(reverse '(a))`, - want: `'(a)`, - wantErr: false, - }, - { - exp: `(reverse '())`, - want: `'()`, - wantErr: false, - }, - { - exp: ` - (let* ((x (list 'a 'b)) - (y (nreverse x))) - (equal x y)) - `, - want: `nil`, - wantErr: false, - }, - }) -} - -func TestAppend(t *testing.T) { - execTests(t, Append, []test{ - { - exp: `(append '(a b c) '(d e f))`, - want: `'(a b c d e f)`, - wantErr: false, - }, - }) -} - -func TestMember(t *testing.T) { - execTests(t, Member, []test{ - { - exp: `(member 'c '(a b c d e f))`, - want: `'(c d e f)`, - wantErr: false, - }, - { - exp: `(member 'g '(a b c d e f))`, - want: `nil`, - wantErr: false, - }, - { - exp: `(member 'c '(a b c a b c))`, - want: `'(c a b c)`, - wantErr: false, - }, - }) -} - -func TestMap(t *testing.T) { - execTests(t, Mapcar, []test{ - { - exp: `(mapcar #'car '((1 a) (2 b) (3 c)))`, - want: `'(1 2 3)`, - wantErr: false, - }, - { - exp: `(mapcar #'abs '(3 -4 2 -5 -6))`, - want: `'(3 4 2 5 6)`, - wantErr: false, - }, - { - exp: `(mapcar #'cons '(a b c) '(1 2 3))`, - want: `'((a . 1) (b . 2) (c . 3))`, - wantErr: false, - }, - { - exp: ` - (let ((x 0)) - (mapc (lambda (v) (setq x (+ x v))) '(3 5)) - x) - `, - want: `8`, - wantErr: false, - }, - { - exp: ` - (maplist #'append - '(1 2 3 4) '(1 2) '(1 2 3)) - `, - want: `'((1 2 3 4 1 2 1 2 3) (2 3 4 2 2 3))`, - wantErr: false, - }, - { - exp: ` - (maplist (lambda (x) (cons 'foo x)) - '(a b c d)) - `, - want: `'((foo a b c d) (foo b c d) (foo c d) (foo d))`, - wantErr: false, - }, - { - exp: ` - (maplist (lambda (x) (if (member (car x) (cdr x)) 0 1)) - '(a b a c d b c)) - `, - want: `'(0 0 1 0 1 1 1)`, - wantErr: false, - }, - { - exp: ` - (let ((k 0)) - (mapl (lambda (x) - (setq k (+ k (if (member (car x) (cdr x)) 0 1)))) - '(a b a c d b c)) - k) - `, - want: `4`, - wantErr: false, - }, - { - exp: ` - (mapcan (lambda (x) (if (> x 0) (list x))) - '(-3 4 0 5 -2 7)) - `, - want: `'(4 5 7)`, - wantErr: false, - }, - { - exp: ` - (mapcon (lambda (x) (if (member (car x) (cdr x)) (list (car x)))) - '(a b a c d b c b c)) - `, - want: `'(a b c b c)`, - wantErr: false, - }, - { - exp: `(mapcon #'list '(1 2 3 4))`, - want: `'((1 2 3 4) (2 3 4) (3 4) (4))`, - wantErr: false, - }, - }) -} - -func TestAssoc(t *testing.T) { - execTests(t, Assoc, []test{ - { - exp: `(assoc 'a '((a . 1) (b . 2)))`, - want: `'(a . 1)`, - wantErr: false, - }, - { - exp: `(assoc 'c '((a . 1) (a . 2)))`, - want: `nil`, - wantErr: false, - }, - }) -} diff --git a/lib/logical_connectives.go b/lib/logical_connectives.go deleted file mode 100644 index 84670b1..0000000 --- a/lib/logical_connectives.go +++ /dev/null @@ -1,58 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -// Not is the logical “not” (or “¬”). It returns t if obj is nil and nil -// otherwise. obj may be any ISLISP object. -func Not(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.DeepEqual(obj, Nil) { - return T, nil - } - return Nil, nil -} - -// And is the sequential logical “and” (or “∧”). forms are evaluated from left -// to right until either one of them evaluates to nil or else none are left. If -// one of them evaluates to nil, then nil is returned from the and; otherwise, -// the value of the last evaluated form is returned. -func And(e core.Environment, forms ...core.Instance) (core.Instance, core.Instance) { - var ret core.Instance - for _, form := range forms { - //fmt.Printf("%v\n%#v\n", form, e.Variable) - var err core.Instance - ret, err = Eval(e, form) - if err != nil { - return nil, err - } - if core.DeepEqual(ret, Nil) { - return Nil, nil - } - } - if len(forms) == 0 { - return T, nil - } - return ret, nil -} - -// Or is the sequential logical "or" (or "∨"). forms are evaluated from left to -// right until either one of them evaluates to a non-nil value or else none are -// left. If one of them evaluates to a non-nil value, then this non-nil value is -// returned, otherwise nil is returned. -func Or(e core.Environment, forms ...core.Instance) (core.Instance, core.Instance) { - var ret core.Instance - for _, form := range forms { - var err core.Instance - ret, err = Eval(e, form) - if err != nil { - return nil, err - } - if ret != Nil { - return ret, nil - } - } - return Nil, nil -} diff --git a/lib/misc.go b/lib/misc.go deleted file mode 100644 index 891df4b..0000000 --- a/lib/misc.go +++ /dev/null @@ -1,26 +0,0 @@ -package lib - -import ( - "time" - - "github.com/islisp-dev/iris/core" -) - -func GetUniversalTime(e core.Environment) (core.Instance, core.Instance) { - s := time.Now().Unix() - return core.NewInteger(int(s)), nil -} - -func GetInternalRealTime(e core.Environment) (core.Instance, core.Instance) { - s := time.Now().UnixNano() - return core.NewInteger(int(s)), nil -} - -func GetInternalRunTime(e core.Environment) (core.Instance, core.Instance) { - s := time.Since(Time).Nanoseconds() - return core.NewInteger(int(s)), nil -} - -func InternalTimeUnitsPerSecond(e core.Environment) (core.Instance, core.Instance) { - return core.NewInteger(1000000000), nil -} diff --git a/lib/namedfunc.go b/lib/namedfunc.go deleted file mode 100644 index a8cdaf2..0000000 --- a/lib/namedfunc.go +++ /dev/null @@ -1,65 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -func checkLambdaList(e core.Environment, lambdaList core.Instance) core.Instance { - if err := ensure(e, core.ListClass, lambdaList); err != nil { - return err - } - for i, cadr := range lambdaList.(core.List).Slice() { - if core.DeepEqual(cadr, core.NewSymbol(":REST")) || core.DeepEqual(cadr, core.NewSymbol("&REST")) { - if lambdaList.(core.List).Length() != i+2 { - _, err := SignalCondition(e, core.NewArityError(e), Nil) - return err - } - } - } - return nil -} - -func newNamedFunction(e core.Environment, functionName, lambdaList core.Instance, forms ...core.Instance) (core.Instance, core.Instance) { - lexical := e - if err := ensure(e, core.SymbolClass, functionName); err != nil { - return nil, err - } - if err := checkLambdaList(e, lambdaList); err != nil { - return nil, err - } - parameters := []core.Instance{} - variadic := false - for _, cadr := range lambdaList.(core.List).Slice() { - if core.DeepEqual(cadr, core.NewSymbol(":REST")) || core.DeepEqual(cadr, core.NewSymbol("&REST")) { - variadic = true - } - parameters = append(parameters, cadr) - } - return core.NewFunction(functionName, func(e core.Environment, arguments ...core.Instance) (core.Instance, core.Instance) { - e.MergeLexical(lexical) - if (variadic && len(parameters)-2 > len(arguments)) || (!variadic && len(parameters) != len(arguments)) { - return SignalCondition(e, core.NewArityError(e), Nil) - } - for idx := range parameters { - key := parameters[idx] - if core.DeepEqual(key, core.NewSymbol(":REST")) || core.DeepEqual(key, core.NewSymbol("&REST")) { - key := parameters[idx+1] - value, err := List(e, arguments[idx:]...) - if err != nil { - return nil, err - } - if !e.Variable.Define(key, value) { - return SignalCondition(e, core.NewImmutableBinding(e), Nil) - } - break - } - value := arguments[idx] - if !e.Variable.Define(key, value) { - return SignalCondition(e, core.NewImmutableBinding(e), Nil) - } - } - return Progn(e, forms...) - }), nil -} diff --git a/lib/non-local_exits.go b/lib/non-local_exits.go deleted file mode 100644 index dd63c09..0000000 --- a/lib/non-local_exits.go +++ /dev/null @@ -1,218 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -/* -ISLISP defines three ways in which to perform non-e exits: - Destination Kind Established by Invoked by Operation Performed - block name block return-from lexical exit - tagbody tag tagbody go lexical transfer of control - catch tag atch throw dynamic exit - -A non-e exit, is an operation that forces transfer of control and possibly -data from an invoking special form to a previously established point in a program, -called the destination of the exit. - -A lexical exit is a non-e exit from a return-from form to a block form -which contains it both lexically and dynamically, forcing the block to return -an object specified in the return-from form. - -A dynamic exit is a non-e exit from a throw form to a catch form -which contains it dynamically (but not necessarily lexically), -forcing the catch to return an object specified in the throw form. - -A lexical transfer of control is a non-e exit from a go form to a tagged point -in a tagbody form which contains it both lexically and dynamically. - -When a non-e exit is initiated, any potential destination that was established -more recently than the destination to which control is being transferred -is immediately considered invalid. -*/ - -func Block(e core.Environment, tag core.Instance, body ...core.Instance) (core.Instance, core.Instance) { - uid := core.NewInteger(uniqueInt()) - if core.InstanceOf(core.NumberClass, tag) || core.InstanceOf(core.CharacterClass, tag) { - return SignalCondition(e, core.NewDomainError(e, tag, core.ObjectClass), Nil) - } - if !e.BlockTag.Define(tag, uid) { - return SignalCondition(e, core.NewImmutableBinding(e), Nil) - } - var fail core.Instance - sucess := Nil - for _, cadr := range body { - sucess, fail = Eval(e, cadr) - if fail != nil { - if core.InstanceOf(core.BlockTagClass, fail) { - tag1, _ := fail.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.TAG"), core.EscapeClass) // Checked at the head of// This condition - uid1, _ := fail.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.UID"), core.EscapeClass) - if core.DeepEqual(tag, tag1) && core.DeepEqual(uid, uid1) { - obj, _ := fail.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.OBJECT"), core.BlockTagClass) // Checked at the head of// This condition - e.BlockTag.Delete(tag) - return obj, nil - } - } - e.BlockTag.Delete(tag) - return nil, fail - } - } - e.BlockTag.Delete(tag) - return sucess, nil -} - -func ReturnFrom(e core.Environment, tag, object core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.NumberClass, tag) || core.InstanceOf(core.CharacterClass, tag) { - return SignalCondition(e, core.NewDomainError(e, tag, core.ObjectClass), Nil) - } - object, err := Eval(e, object) - if err != nil { - return nil, err - } - uid, ok := e.BlockTag.Get(tag) - if !ok { - return SignalCondition(e, core.NewControlError(e), Nil) - } - return nil, core.NewBlockTag(tag, uid, object) -} - -func Catch(e core.Environment, tag core.Instance, body ...core.Instance) (core.Instance, core.Instance) { - var err core.Instance - tag, err = Eval(e, tag) - uid := core.NewInteger(uniqueInt()) - if err != nil { - return nil, err - } - if core.InstanceOf(core.NumberClass, tag) || core.InstanceOf(core.CharacterClass, tag) { - return SignalCondition(e, core.NewDomainError(e, tag, core.ObjectClass), Nil) - } - if !e.CatchTag.Define(tag, uid) { - return SignalCondition(e, core.NewImmutableBinding(e), Nil) - } - var fail core.Instance - sucess := Nil - for _, cadr := range body { - sucess, fail = Eval(e, cadr) - if fail != nil { - if core.InstanceOf(core.CatchTagClass, fail) { - tag1, _ := fail.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.TAG"), core.EscapeClass) // Checked at the head of// This condition - uid1, _ := fail.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.UID"), core.EscapeClass) // Checked at the head of// This condition - if core.DeepEqual(tag, tag1) && core.DeepEqual(uid, uid1) { - obj, _ := fail.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.OBJECT"), core.CatchTagClass) // Checked at the head of// This condition - e.CatchTag.Delete(tag) - return obj, nil - } - } - e.CatchTag.Delete(tag) - return nil, fail - } - } - e.CatchTag.Delete(tag) - return sucess, nil -} - -func Throw(e core.Environment, tag, object core.Instance) (core.Instance, core.Instance) { - var err core.Instance - tag, err = Eval(e, tag) - if err != nil { - return nil, err - } - if core.InstanceOf(core.NumberClass, tag) || core.InstanceOf(core.CharacterClass, tag) { - return SignalCondition(e, core.NewDomainError(e, tag, core.ObjectClass), Nil) - } - object, err = Eval(e, object) - if err != nil { - return nil, err - } - uid, ok := e.CatchTag.Get(tag) - if !ok { - return SignalCondition(e, core.NewControlError(e), Nil) - - } - return nil, core.NewCatchTag(tag, uid, object) -} - -func Tagbody(e core.Environment, body ...core.Instance) (core.Instance, core.Instance) { - uid := core.NewInteger(uniqueInt()) - for _, cadr := range body { - if !core.InstanceOf(core.ConsClass, cadr) { - if !e.TagbodyTag.Define(cadr, uid) { // ref cddr - return SignalCondition(e, core.NewImmutableBinding(e), Nil) - } - } - } - for idx, cadr := range body { - if core.InstanceOf(core.ConsClass, cadr) { - _, fail := Eval(e, cadr) - if fail != nil { - TAG: - if core.InstanceOf(core.TagbodyTagClass, fail) { - tag1, _ := fail.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.TAG"), core.EscapeClass) // Checked at the top of// This loop - uid1, _ := fail.(core.BasicInstance).GetSlotValue(core.NewSymbol("IRIS.UID"), core.EscapeClass) // Checked at the top of// This loop - found := false - for _, tag := range body { - if core.DeepEqual(tag, tag1) && core.DeepEqual(uid, uid1) { - found = true - break - } - } - if found { - for _, form := range body[idx+1:] { - if core.InstanceOf(core.ConsClass, form) { - _, fail = Eval(e, form) - if fail != nil { - goto TAG - } - } - } - break - } - - } - return nil, fail - } - } - } - return Nil, nil -} - -func Go(e core.Environment, tag core.Instance) (core.Instance, core.Instance) { - uid, ok := e.TagbodyTag.Get(tag) - if !ok { - return SignalCondition(e, core.NewControlError(e), Nil) - } - return nil, core.NewTagbodyTag(tag, uid) -} - -// UnwindProtect first evaluates form. Evaluation of the cleanup-forms always -// occurs, regardless of whether the exit is normal or non-e. If the form exits -// normally yielding a value R, then if all of the cleanup-forms exit normally -// the value R is returned by the unwind-protect form. If a non-e exit from form -// occurs, then the cleanup-forms are executed as part of that exit, and then if -// all of the cleanup-forms exit normally the original non-e exit continues. The -// cleanup-forms are evaluated from left to right, discarding the resulting -// values. If execution of the cleanup-forms finishes normally, exit from the -// unwind-protect form proceeds as described above. It is permissible for a -// cleanup-form to contain a non-e exit from the unwind-protect form, subject to -// the following constraint: An error shall be signaled if during execution of -// the cleanup-forms of an unwind-protect form, a non-e exit is executed to a -// destination which has been marked as invalid due to some other non-e exit -// that is already in progress (error-id. control-error). Note: Because ISLISP -// does not specify an interactive debugger, it is unspecified whether or how -// error recovery can occur interactively if programmatic handling fails. The -// intent is that if the ISLISP processor does not terminate abnormally, normal -// mechanisms for non-e exit (return-from, throw, or go) would be used as -// necessary and would respect these cleanup-forms. -func UnwindProtect(e core.Environment, form core.Instance, cleanupForms ...core.Instance) (core.Instance, core.Instance) { - ret1, err1 := Eval(e, form) - ret2, err2 := Progn(e, cleanupForms...) - if err2 != nil { - if core.InstanceOf(core.EscapeClass, err2) { - return SignalCondition(e, core.NewControlError(e), Nil) - } - return ret2, err2 - } - return ret1, err1 -} diff --git a/lib/non-local_exits_test.go b/lib/non-local_exits_test.go deleted file mode 100644 index f1b42a0..0000000 --- a/lib/non-local_exits_test.go +++ /dev/null @@ -1,207 +0,0 @@ -package lib - -import "testing" - -func TestBlock(t *testing.T) { - tests := []test{ - { - exp: `(block x (+ 10 (return-from x 6) 22))`, - want: `6`, - wantErr: false, - }, - { - exp: ` - (defun f1 () - (block b - (let ((f (lambda () (return-from b 'exit)))) - ; big computation - (f2 f)))) - `, - want: `'f1`, - wantErr: false, - }, - { - exp: ` - (defun f2 (g) - ; big computation - (funcall g)) - `, - want: `'f2`, - wantErr: false, - }, - { - exp: `(f1)`, - want: `'exit`, - wantErr: false, - }, - { - exp: ` - (block sum-block - (for ((x '(1 a 2 3) (cdr x)) - (sum 0 (+ sum (car x)))) - ((null x) sum) - (cond ((not (numberp (car x))) (return-from sum-block 0))))) - `, - want: `0`, - wantErr: false, - }, - { - exp: ` - (defun bar (x y) - (let ((foo #'car)) - (let ((result (block bl - (setq foo (lambda () (return-from bl 'first-exit))) - (if x (return-from bl 'second-exit) 'third-exit)))) - (if y (funcall foo) nil) - result))) - `, - want: `'bar`, - wantErr: false, - }, - { - exp: `(bar t nil)`, - want: `'second-exit`, - wantErr: false, - }, - { - exp: `(bar nil t)`, - want: `nil`, - wantErr: true, - }, - { - exp: `(bar nil nil)`, - want: `'third-exit`, - wantErr: false, - }, - { - exp: `(bar t t)`, - want: `nil`, - wantErr: true, - }, - } - execTests(t, Block, tests) -} - -func TestCatch(t *testing.T) { - tests := []test{ - { - exp: ` - (defun foo (x) - (catch 'block-sum (bar x))) - `, - want: `'foo`, - wantErr: false, - }, - { - exp: ` - (defun bar (x) - (for ((l x (cdr l)) - (sum 0 (+ sum (car l)))) - ((null l) sum) - (cond ((not (numberp (car l))) (throw 'block-sum 0))))) - `, - want: `'bar`, - wantErr: false, - }, - { - exp: `(foo '(1 2 3 4))`, - want: `10`, - wantErr: false, - }, - { - exp: `(foo '(1 2 a 4))`, - want: `0`, - wantErr: false, - }, - } - execTests(t, Catch, tests) -} - -func TestUnwindProtect(t *testing.T) { - tests := []test{ - { - exp: ` - (defun foo (x) - (catch 'duplicates - (unwind-protect (bar x) - (for ((l x (cdr l))) - ((null l) 'unused) - (remove-property (car l) 'label))))) - `, - want: `'foo`, - wantErr: false, - }, - { - exp: ` - (defun bar (l) - (cond ((and (symbolp l) (property l 'label)) - (throw 'duplicates 'found)) - ((symbolp l) (setf (property l 'label) t)) - ((bar (car l)) (bar (cdr l))) - (t nil))) - `, - want: `'bar`, - wantErr: false, - }, - { - exp: `(foo '(a b c))`, - want: `t`, - wantErr: false, - }, - { - exp: `(property 'a 'label)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(foo '(a b a c))`, - want: `'found`, - wantErr: false, - }, - { - exp: `(property 'a 'label)`, - want: `nil`, - wantErr: false, - }, - { - exp: ` - (defun test () - (catch 'outer (test2))) - `, - want: `'test`, - wantErr: false, - }, - { - exp: ` - (defun test2 () - (block inner - (test3 (lambda () - (return-from inner 7))))) - `, - want: `'test2`, - wantErr: false, - }, - { - exp: ` - (defun test3 (fun) - (unwind-protect (test4) (funcall fun))) - `, - want: `'test3`, - wantErr: false, - }, - { - exp: ` - (defun test4 () - (throw 'outer 6)) - `, - want: `'test4`, - wantErr: false, - }, - { - exp: `(test)`, - want: `nil`, - wantErr: true, - }, - } - execTests(t, UnwindProtect, tests) -} diff --git a/lib/number.go b/lib/number.go deleted file mode 100644 index 685dcbe..0000000 --- a/lib/number.go +++ /dev/null @@ -1,474 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import ( - "math" - - "github.com/islisp-dev/iris/reader/parser" - "github.com/islisp-dev/iris/reader/tokenizer" - "github.com/islisp-dev/iris/core" -) - -// Numberp returns t if obj is a number (instance of class number); otherwise, -// returns nil. The obj may be any ISLISP object. -func Numberp(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.NumberClass, obj) { - return T, nil - } - return Nil, nil -} - -// ParseNumber scans (as if by read) and if the resulting lexeme is the textual -// representation of a number, the number it represents is returned. An error -// shall be signaled if string is not a string (error-id. domain-error). An -// error shall be signaled if string is not the textual representation of a -// number (error-id. cannot-parse-number). -func ParseNumber(e core.Environment, str core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.StringClass, str); err != nil { - return nil, err - } - ret, err := parser.ParseAtom(e, tokenizer.NewToken(string(str.(core.String)), -1, -1)) - if err != nil || !core.InstanceOf(core.NumberClass, ret) { - return SignalCondition(e, core.NewParseError(e, str, core.NumberClass), Nil) - } - return ret, err -} - -// NumberEqual returns t if x1 has the same mathematical value as x2 ; -// otherwise, returns nil. An error shall be signaled if either x1 or x2 is not -// a number (error-id. domain-error). Note: = differs from eql because = -// compares only the mathematical values of its arguments, whereas eql also -// compares the representations -func NumberEqual(e core.Environment, x1, x2 core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.NumberClass, x1, x2); err != nil { - return nil, err - } - ret := false - switch { - case core.InstanceOf(core.IntegerClass, x1) && core.InstanceOf(core.IntegerClass, x2): - ret = core.DeepEqual(x1, x2) - case core.InstanceOf(core.IntegerClass, x1) && core.InstanceOf(core.FloatClass, x2): - ret = core.DeepEqual(float64(x1.(core.Integer)), float64(x2.(core.Float))) - case core.InstanceOf(core.FloatClass, x1) && core.InstanceOf(core.IntegerClass, x2): - ret = float64(x1.(core.Float)) == float64(x2.(core.Integer)) - case core.InstanceOf(core.FloatClass, x1) && core.InstanceOf(core.FloatClass, x2): - ret = core.DeepEqual(x1, x2) - } - if ret { - return T, nil - } - return Nil, nil -} - -// NumberNotEqual returns t if x1 and x2 have mathematically distinct values; -// otherwise, returns nil. An error shall be signaled if either x1 or x2 is not -// a number (error-id. domain-error). -func NumberNotEqual(e core.Environment, x1, x2 core.Instance) (core.Instance, core.Instance) { - ret, err := NumberEqual(e, x1, x2) - if err != nil { - return ret, err - } - return Not(e, ret) -} - -// NumberGreaterThan returns t if x1 is greater than x2 -func NumberGreaterThan(e core.Environment, x1, x2 core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.NumberClass, x1, x2); err != nil { - return nil, err - } - ret := false - switch { - case core.InstanceOf(core.IntegerClass, x1) && core.InstanceOf(core.IntegerClass, x2): - ret = float64(x1.(core.Integer)) > float64(x2.(core.Integer)) - case core.InstanceOf(core.IntegerClass, x1) && core.InstanceOf(core.FloatClass, x2): - ret = float64(x1.(core.Integer)) > float64(x2.(core.Float)) - case core.InstanceOf(core.FloatClass, x1) && core.InstanceOf(core.IntegerClass, x2): - ret = float64(x1.(core.Float)) > float64(x2.(core.Integer)) - case core.InstanceOf(core.FloatClass, x1) && core.InstanceOf(core.FloatClass, x2): - ret = float64(x1.(core.Float)) > float64(x2.(core.Float)) - } - if ret { - return T, nil - } - return Nil, nil -} - -// NumberGreaterThanOrEqual returns t if x1 is greater than or = x2 -func NumberGreaterThanOrEqual(e core.Environment, x1, x2 core.Instance) (core.Instance, core.Instance) { - gt, err := NumberGreaterThan(e, x1, x2) - if err != nil { - return nil, err - } - eq, err := NumberEqual(e, x1, x2) - if err != nil { - return nil, err - } - if core.DeepEqual(gt, Nil) && core.DeepEqual(eq, Nil) { - return Nil, nil - } - return T, nil -} - -// NumberLessThan returns t if x1 is less than x2 -func NumberLessThan(e core.Environment, x1, x2 core.Instance) (core.Instance, core.Instance) { - ge, err := NumberGreaterThanOrEqual(e, x1, x2) - if err != nil { - return nil, err - } - return Not(e, ge) -} - -// NumberLessThanOrEqual returns t if x1 is less than or = x2 -func NumberLessThanOrEqual(e core.Environment, x1, x2 core.Instance) (core.Instance, core.Instance) { - gt, err := NumberGreaterThan(e, x1, x2) - if err != nil { - return nil, err - } - return Not(e, gt) -} - -// Add returns the sum, respectively, of their arguments. If all arguments are -// integers, the result is an integer. If any argument is a float, the result is -// a float. When given no arguments, + returns 0. An error shall be signaled if -// any x is not a number (error-id. domain-error). -func Add(e core.Environment, x ...core.Instance) (core.Instance, core.Instance) { - flt := false - sum := 0.0 - for _, a := range x { - f, b, err := convFloat64(e, a) - if err != nil { - return nil, err - } - flt = flt || b - sum += f - } - if flt { - return core.NewFloat(sum), nil - } - return core.NewInteger(int(sum)), nil -} - -// Multiply returns the product, respectively, of their arguments. If all -// arguments are integers, the result is an integer. If any argument is a float, -// the result is a float. When given no arguments, Multiply returns 1. An error -// shall be signaled if any x is not a number (error-id. domain-error). -func Multiply(e core.Environment, x ...core.Instance) (core.Instance, core.Instance) { - flt := false - pdt := 1.0 - for _, a := range x { - f, b, err := convFloat64(e, a) - if err != nil { - return nil, err - } - pdt *= f - flt = flt || b - } - if flt { - return core.NewFloat(pdt), nil - } - return core.NewInteger(int(pdt)), nil -} - -// Substruct returns its additive inverse. An error shall be signaled if x is -// not a number (error-id. domain-error). If an implementation supports a -0.0 -// that is distinct from 0.0, then (- 0.0) returns -0.0; in implementations -// where -0.0 and 0.0 are not distinct, (- 0.0) returns 0.0. Given more than one -// argument, x1 … xn , - returns their successive differences, x1 −x2 − … −xn. -// An error shall be signaled if any x is not a number (error-id. domain-error). -func Substruct(e core.Environment, x core.Instance, xs ...core.Instance) (core.Instance, core.Instance) { - if len(xs) == 0 { - ret, err := Substruct(e, core.NewInteger(0), x) - return ret, err - } - sub, flt, err := convFloat64(e, x) - if err != nil { - return nil, err - } - for _, a := range xs { - f, b, err := convFloat64(e, a) - if err != nil { - return nil, err - } - sub -= f - flt = flt || b - } - if flt { - return core.NewFloat(sub), nil - } - return core.NewInteger(int(sub)), nil -} - -// Quotient returns the quotient of those numbers. The result is an integer if -// dividend and divisor are integers and divisor evenly divides dividend , -// otherwise it will be a float. Given more than two arguments, quotient operates -// iteratively on each of the divisor1 … divisorn as in dividend /divisor1 / … -// /divisorn. The type of the result follows from the two-argument case because -// the three-or-more-argument quotient can be defined as follows: An error shall -// be signaled if dividend is not a number (error-id. domain-error). An error -// shall be signaled if any divisor is not a number (error-id. domain-error). An -// error shall be signaled if any divisor is zero (error-id. division-by-zero). -func Quotient(e core.Environment, dividend, divisor1 core.Instance, divisor ...core.Instance) (core.Instance, core.Instance) { - divisor = append([]core.Instance{divisor1}, divisor...) - quotient, flt, err := convFloat64(e, dividend) - if err != nil { - return nil, err - } - for _, a := range divisor { - f, b, err := convFloat64(e, a) - if err != nil { - return nil, err - } - if f == 0.0 { - arguments := Nil - for i := len(divisor) - 1; i >= 0; i-- { - arguments = core.NewCons(divisor[i], arguments) - } - return SignalCondition(e, core.NewArithmeticError(e, core.NewSymbol("QUOTIENT"), arguments), Nil) - } - if !flt && !b && int(quotient)%int(f) != 0 { - flt = true - } - quotient /= f - } - if flt { - return core.NewFloat(quotient), nil - } - return core.NewInteger(int(quotient)), nil -} - -// Reciprocal returns the reciprocal of its argument x ; that is, 1/x . An error -// shall be signaled if x is zero (error-id. division-by-zero). -func Reciprocal(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - return Quotient(e, core.NewInteger(1), x) -} - -// Max returns the greatest (closest to positive infinity) of its arguments. The -// comparison is done by >. An error shall be signaled if any x is not a number -// (error-id. domain-error). -func Max(e core.Environment, x core.Instance, xs ...core.Instance) (core.Instance, core.Instance) { - max := x - for _, y := range xs { - ret, err := NumberGreaterThan(e, y, max) - if err != nil { - return nil, err - } - if core.DeepEqual(ret, T) { - max = y - } - } - return max, nil -} - -// Min returns the least (closest to negative infinity) of its arguments. The -// comparison is done by <. An error shall be signaled if any x is not a number -// (error-id. domain-error). -func Min(e core.Environment, x core.Instance, xs ...core.Instance) (core.Instance, core.Instance) { - min := x - for _, y := range xs { - ret, err := NumberLessThan(e, y, min) - if err != nil { - return nil, err - } - if core.DeepEqual(ret, T) { - min = y - } - } - return min, nil -} - -// Abs returns the absolute value of its argument. An error shall be signaled if -// x is not a number (error-id. domain-error). -func Abs(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - ret, err := NumberLessThan(e, x, core.NewInteger(0)) - if err != nil { - return nil, err - } - if core.DeepEqual(ret, T) { - return Substruct(e, x) - } - return x, nil -} - -// Exp returns e raised to the power x , where e is the base of the natural -// logarithm. An error shall be signaled if x is not a number (error-id. -// domain-error). -func Exp(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - f, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - return core.NewFloat(math.Exp(f)), nil -} - -// Log returns the natural logarithm of x. An error shall be signaled if x is -// not a positive number (error-id. domain-error). -func Log(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - f, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - if f <= 0.0 { - return SignalCondition(e, core.NewDomainError(e, x, core.NumberClass), Nil) - } - return core.NewFloat(math.Log(f)), nil -} - -// Expt returns x1 raised to the power x2. The result will be an integer if x1 -// is an integer and x2 is a non-negative integer. An error shall be signaled if -// x1 is zero and x2 is negative, or if x1 is zero and x2 is a zero float, or if -// x1 is negative and x2 is not an integer. -func Expt(e core.Environment, x1, x2 core.Instance) (core.Instance, core.Instance) { - a, af, err := convFloat64(e, x1) - if err != nil { - return nil, err - } - b, bf, err := convFloat64(e, x2) - if err != nil { - return nil, err - } - if !af && !bf && b >= 0 { - return core.NewInteger(int(math.Pow(a, b))), nil - } - if (a == 0 && b < 0) || (a == 0 && bf && b == 0) || (a < 0 && bf) { - operation := core.NewSymbol("EXPT") - operands, err := List(e, x1, x2) - if err != nil { - return nil, err - } - return SignalCondition(e, core.NewArithmeticError(e, operation, operands), Nil) - } - return core.NewFloat(math.Pow(a, b)), nil -} - -// Sqrt returns the non-negative square root of x. An error shall be signaled if -// x is not a non-negative number (error-id. domain-error). -func Sqrt(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - a, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - if a < 0.0 { - return SignalCondition(e, core.NewDomainError(e, x, core.NumberClass), Nil) - } - if math.Ceil(math.Sqrt(a)) == math.Sqrt(a) { - return core.NewInteger(int(math.Sqrt(a))), nil - } - return core.NewFloat(math.Sqrt(a)), nil -} - -// Pi is an approximation of π. -var Pi = core.NewFloat(3.141592653589793) - -// Sin returns the sine of x . x must be given in radians. An error shall be -// signaled if x is not a number (error-id. domain-error). -func Sin(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - a, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - return core.NewFloat(math.Sin(a)), nil -} - -// Cos returns the cosine of x . x must be given in radians. An error shall be -// signaled if x is not a number (error-id. domain-error). -func Cos(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - a, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - return core.NewFloat(math.Cos(a)), nil -} - -// Tan returns the tangent of x . x must be given in radians. An error shall be -// signaled if x is not a number (error-id. domain-error). -func Tan(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - a, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - return core.NewFloat(math.Tan(a)), nil -} - -// Atan returns the arc tangent of x. The result is a (real) number that lies -// between −π/2 and π/2 (both exclusive). An error shall be signaled if x is not -// a number (error-id. domain-error). -func Atan(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - a, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - return core.NewFloat(math.Atan(a)), nil -} - -// Atan2 returns the phase of its representation in polar coordinates. If x1 is -// zero and x2 is negative, the result is positive. If x1 and x2 are both zero, -// the result is implementation defined. An error shall be signaled if x is not -// a number (error-id. domain-error). The value of atan2 is always between −π -// (exclusive) and π (inclusive) when minus zero is not supported; when minus -// zero is supported, the range includes −π. The signs of x1 (indicated as y) -// and x2 (indicated as x) are used to derive quadrant information. -func Atan2(e core.Environment, x1, x2 core.Instance) (core.Instance, core.Instance) { - a, _, err := convFloat64(e, x1) - if err != nil { - return nil, err - } - b, _, err := convFloat64(e, x2) - if err != nil { - return nil, err - } - if a == 0 && b == 0 { - operation := core.NewSymbol("ATAN2") - operands, err := List(e, x1, x2) - if err != nil { - return nil, err - } - return SignalCondition(e, core.NewArithmeticError(e, operation, operands), Nil) - } - return core.NewFloat(math.Atan2(a, b)), nil -} - -// Sinh returns the hyperbolic sine of x . x must be given in radians. An error -// shall be signaled if x is not a number (error-id. domain-error). -func Sinh(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - a, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - return core.NewFloat(math.Sinh(a)), nil -} - -// Cosh returns the hyperbolic cosine of x . x must be given in radians. An -// error shall be signaled if x is not a number (error-id. domain-error). -func Cosh(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - a, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - return core.NewFloat(math.Cosh(a)), nil -} - -// Tanh returns the hyperbolic tangent of x . x must be given in radians. An -// error shall be signaled if x is not a number (error-id. domain-error). -func Tanh(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - a, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - return core.NewFloat(math.Tanh(a)), nil -} - -// Atanh returns the hyperbolic arc tangent of x. An error shall be signaled if -// x is not a number with absolute value less than 1 (error-id. domain-error). -func Atanh(e core.Environment, x core.Instance) (core.Instance, core.Instance) { - a, _, err := convFloat64(e, x) - if err != nil { - return nil, err - } - if math.Abs(a) >= 1 { - return SignalCondition(e, core.NewDomainError(e, x, core.NumberClass), Nil) - } - return core.NewFloat(math.Atanh(a)), nil -} diff --git a/lib/runtime.go b/lib/runtime.go deleted file mode 100644 index e3fe713..0000000 --- a/lib/runtime.go +++ /dev/null @@ -1,330 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import ( - "math" - "os" - "time" - - "github.com/islisp-dev/iris/core" -) - -var Time time.Time - -var TopLevel = core.NewEnvironment( - core.NewStream(os.Stdin, nil, core.CharacterClass), - core.NewStream(nil, os.Stdout, core.CharacterClass), - core.NewStream(nil, os.Stderr, core.CharacterClass), - core.DefaultHandler, -) - -func defclass(name string, class core.Class) { - symbol := core.NewSymbol(name) - TopLevel.Class.Define(symbol, class) -} - -func defspecial(name string, function interface{}) { - symbol := core.NewSymbol(name) - TopLevel.Special.Define(symbol, core.NewFunction(func2symbol(function), function)) -} - -func defun(name string, function interface{}) { - symbol := core.NewSymbol(name) - TopLevel.Function.Define(symbol, core.NewFunction(symbol, function)) -} - -func defgeneric(name string, function interface{}) { - symbol := core.NewSymbol(name) - lambdaList, _ := List(TopLevel, core.NewSymbol("FIRST"), core.NewSymbol("&REST"), core.NewSymbol("REST")) - generic := core.NewGenericFunction(symbol, lambdaList, T, core.GenericFunctionClass) - generic.(*core.GenericFunction).AddMethod(nil, lambdaList, []core.Class{core.StandardClassClass}, core.NewFunction(symbol, function)) - TopLevel.Function.Define(symbol, generic) -} - -func defglobal(name string, value core.Instance) { - symbol := core.NewSymbol(name) - TopLevel.Variable.Define(symbol, value) -} - -func init() { - defun("EVAL", Eval) // This function is for verificaiton. DO NOT USE. - defglobal("*PI*", core.Float(math.Pi)) - defglobal("*MOST-POSITIVE-FLOAT*", MostPositiveFloat) - defglobal("*MOST-NEGATIVE-FLOAT*", MostNegativeFloat) - defun("-", Substruct) - defun("+", Add) - defun("*", Multiply) - defun("<", NumberLessThan) - defun("<=", NumberLessThanOrEqual) - defun("=", NumberEqual) - defun("/=", NumberNotEqual) - defun(">", NumberGreaterThan) - defun(">=", NumberGreaterThanOrEqual) - defspecial("QUASIQUOTE", Quasiquote) - defun("ABS", Abs) - defspecial("AND", And) - defun("APPEND", Append) - defun("APPLY", Apply) - defun("ARRAY-DIMENSIONS", ArrayDimensions) - defun("AREF", Aref) - defun("ASSOC", Assoc) - // TODO: defspecial2("ASSURE", Assure) - defun("ATAN", Atan) - defun("ATAN2", Atan2) - defun("ATANH", Atanh) - defun("BASIC-ARRAY*-P", BasicArrayStarP) - defun("BASIC-ARRAY-P", BasicArrayP) - defun("BASIC-VECTOR-P", BasicVectorP) - defspecial("BLOCK", Block) - defun("CAR", Car) - defspecial("CASE", Case) - defspecial("CASE-USING", CaseUsing) - defspecial("CATCH", Catch) - defun("CDR", Cdr) - defun("CEILING", Ceiling) - defun("CERROR", Cerror) - defun("CHAR-INDEX", CharIndex) - defun("CHAR/=", CharNotEqual) - defun("CHAR<", CharLessThan) - defun("CHAR<=", CharLessThanOrEqual) - defun("CHAR=", CharEqual) - defun("CHAR>", CharGreaterThan) - defun("CHAR>=", CharGreaterThanOrEqual) - defun("CHARACTERP", Characterp) - defspecial("CLASS", Class) - defun("CLASS-OF", ClassOf) - defun("CLOSE", Close) - // SKIP defun2("COERCION", Coercion) - defspecial("COND", Cond) - defun("CONDITION-CONTINUABLE", ConditionContinuable) - defun("CONS", Cons) - defun("CONSP", Consp) - defun("CONTINUE-CONDITION", ContinueCondition) - defspecial("CONVERT", Convert) - defun("COS", Cos) - defun("COSH", Cosh) - defgeneric("CREATE", Create) //TODO Change to generic function - defun("CREATE-ARRAY", CreateArray) - defun("CREATE-LIST", CreateList) - defun("CREATE-STRING", CreateString) - defun("CREATE-STRING-INPUT-STREAM", CreateStringInputStream) - defun("CREATE-STRING-OUTPUT-STREAM", CreateStringOutputStream) - defun("CREATE-VECTOR", CreateVector) - defspecial("DEFCLASS", Defclass) - defspecial("DEFCONSTANT", Defconstant) - defspecial("DEFDYNAMIC", Defdynamic) - defspecial("DEFGENERIC", Defgeneric) - defspecial("DEFMETHOD", Defmethod) - defspecial("DEFGLOBAL", Defglobal) - defspecial("DEFMACRO", Defmacro) - defspecial("DEFUN", Defun) - defun("DIV", Div) - defspecial("DYNAMIC", Dynamic) - defspecial("DYNAMIC-LET", DynamicLet) - defun("ELT", Elt) - defun("EQ", Eq) - defun("EQL", Eql) - defun("EQUAL", Equal) - defun("ERROR", Error) - defun("ERROR-OUTPUT", ErrorOutput) - defun("EXP", Exp) - defun("EXPT", Expt) - // TODO defun2("FILE-LENGTH", FileLength) - // TODO defun2("FILE-POSITION", FilePosition) - defun("FINISH-OUTPUT", FinishOutput) - defspecial("FLET", Flet) - defun("FLOAT", Float) - defun("FLOATP", Floatp) - defun("FLOOR", Floor) - defspecial("FOR", For) - defun("FORMAT", Format) - defun("FORMAT-CHAR", FormatChar) - defun("FORMAT-FLOAT", FormatFloat) - defun("FORMAT-FRESH-LINE", FormatFreshLine) - defun("FORMAT-INTEGER", FormatInteger) - defun("FORMAT-OBJECT", FormatObject) - defun("FORMAT-TAB", FormatTab) - defun("FUNCALL", Funcall) - defspecial("FUNCTION", Function) - defun("FUNCTIONP", Functionp) - defun("GAREF", Garef) - defun("GCD", Gcd) - defun("GENERAL-ARRAY*-P", GeneralArrayStarP) - defun("GENERAL-VECTOR-P", GeneralVectorP) - defun("GENERIC-FUNCTION-P", GenericFunctionP) - defun("GENSYM", Gensym) - defun("GET-INTERNAL-REAL-TIME", GetInternalRealTime) - defun("GET-INTERNAL-RUN-TIME", GetInternalRunTime) - defun("GET-OUTPUT-STREAM-STRING", GetOutputStreamString) - defun("GET-UNIVERSAL-TIME", GetUniversalTime) - defspecial("GO", Go) - defun("IDENTITY", Identity) - defspecial("IF", If) - defspecial("IGNORE-ERRORS", IgnoreErrors) - defgeneric("INITIALIZE-OBJECT", InitializeObject) // TODO change generic function - defun("INPUT-STREAM-P", InputStreamP) - defun("INSTANCEP", Instancep) - defun("INTEGERP", Integerp) - defun("INTERNAL-TIME-UNITS-PER-SECOND", InternalTimeUnitsPerSecond) - defun("ISQRT", Isqrt) - defspecial("LABELS", Labels) - defspecial("LAMBDA", Lambda) - defun("LCM", Lcm) - defun("LENGTH", Length) - defspecial("LET", Let) - defspecial("LET*", LetStar) - defun("LIST", List) - defun("LISTP", Listp) - defun("LOG", Log) - defun("MAP-INTO", MapInto) - defun("MAPC", Mapc) - defun("MAPCAN", Mapcan) - defun("MAPCAR", Mapcar) - defun("MAPCON", Mapcon) - defun("MAPL", Mapl) - defun("MAPLIST", Maplist) - defun("MAX", Max) - defun("MEMBER", Member) - defun("MIN", Min) - defun("MOD", Mod) - defglobal("NI-L", Nil) - defun("NOT", Not) - defun("NREVERSE", Nreverse) - defun("NULL", Null) - defun("NUMBERP", Numberp) - defun("OPEN-INPUT-FILE", OpenInputFile) - defun("OPEN-IO-FILE", OpenIoFile) - defun("OPEN-OUTPUT-FILE", OpenOutputFile) - defun("OPEN-STREAM-P", OpenStreamP) - defspecial("OR", Or) - // defun("FLUSH-OUTPUT", FlushOutput) - defun("OUTPUT-STREAM-P", OutputStreamP) - defun("PARSE-NUMBER", ParseNumber) - defun("PREVIEW-CHAR", PreviewChar) - defun("PROBE-FILE", ProbeFile) - defspecial("PROGN", Progn) - defun("PROPERTY", Property) - defspecial("QUASIQUOTE", Quasiquote) - defspecial("QUOTE", Quote) - defun("QUOTIENT", Quotient) - defun("READ", Read) - defun("READ-BYTE", ReadByte) - defun("READ-CHAR", ReadChar) - defun("READ-LINE", ReadLine) - defun("REMOVE-PROPERTY", RemoveProperty) - defun("REPORT-CONDITION", ReportCondition) - defspecial("RETURN-FROM", ReturnFrom) - defun("REVERSE", Reverse) - defun("ROUND", Round) - defun("SET-AREF", SetAref) - defun("(SETF AREF)", SetAref) - defun("SET-CAR", SetCar) - defun("(SETF CAR)", SetCar) - defun("SET-CDR", SetCdr) - defun("(SETF CDR)", SetCdr) - defun("SET-DYNAMIC", SetDynamic) - defun("(SETF DYNAMIC)", SetDynamic) - defun("SET-ELT", SetElt) - defun("(SETF ELT)", SetElt) - // TODO defun2("SET-FILE-POSITION", SetFilePosition) - defun("SET-GAREF", SetGaref) - defun("(SETF GAREF)", SetGaref) - defun("SET-PROPERTY", SetProperty) - defun("(SETF PROPERTY)", SetProperty) - defspecial("SETF", Setf) - defspecial("SETQ", Setq) - defun("SIGNAL-CONDITION", SignalCondition) - defun("SIN", Sin) - defun("SINH", Sinh) - defun("SQRT", Sqrt) - defun("STANDARD-INPUT", StandardInput) - defun("STANDARD-OUTPUT", StandardOutput) - defun("STREAM-READY-P", StreamReadyP) - defun("STREAMP", Streamp) - defun("STRING-APPEND", StringAppend) - defun("STRING-INDEX", StringIndex) - defun("STRING/=", StringNotEqual) - defun("STRING>", StringGreaterThan) - defun("STRING>=", StringGreaterThanOrEqual) - defun("STRING=", StringEqual) - defun("STRING<", StringLessThan) - defun("STRING<=", StringLessThanOrEqual) - defun("STRINGP", Stringp) - defun("SUBCLASSP", Subclassp) - defun("SUBSEQ", Subseq) - defun("SYMBOLP", Symbolp) - defglobal("T", T) - defspecial("TAGBODY", Tagbody) - defspecial("TAN", Tan) - defspecial("TANH", Tanh) - // TODO defspecial2("THE", The) - defspecial("THROW", Throw) - defun("TRUNCATE", Truncate) - defspecial("UNWIND-PROTECT", UnwindProtect) - defun("VECTOR", Vector) - defspecial("WHILE", While) - defspecial("WITH-ERROR-OUTPUT", WithErrorOutput) - defspecial("WITH-HANDLER", WithHandler) - defspecial("WITH-OPEN-INPUT-FILE", WithOpenInputFile) - defspecial("WITH-OPEN-OUTPUT-FILE", WithOpenOutputFile) - defspecial("WITH-STANDARD-INPUT", WithStandardInput) - defspecial("WITH-STANDARD-OUTPUT", WithStandardOutput) - defun("WRITE-BYTE", WriteByte) - defclass("", core.ObjectClass) - defclass("", core.BuiltInClassClass) - defclass("", core.StandardClassClass) - defclass("", core.BasicArrayClass) - defclass("", core.BasicArrayStarClass) - defclass("", core.GeneralArrayStarClass) - defclass("", core.BasicVectorClass) - defclass("", core.GeneralVectorClass) - defclass("", core.StringClass) - defclass("", core.CharacterClass) - defclass("", core.FunctionClass) - defclass("", core.GenericFunctionClass) - defclass("", core.StandardGenericFunctionClass) - defclass("", core.ListClass) - defclass("", core.ConsClass) - defclass("", core.NullClass) - defclass("", core.SymbolClass) - defclass("", core.NumberClass) - defclass("", core.IntegerClass) - defclass("", core.FloatClass) - defclass("", core.SeriousConditionClass) - defclass("", core.ErrorClass) - defclass("", core.ArithmeticErrorClass) - defclass("", core.DivisionByZeroClass) - defclass("", core.FloatingPointOnderflowClass) - defclass("", core.FloatingPointUnderflowClass) - defclass("", core.ControlErrorClass) - defclass("", core.ParseErrorClass) - defclass("", core.ProgramErrorClass) - defclass("", core.DomainErrorClass) - defclass("", core.UndefinedEntityClass) - defclass("", core.UnboundVariableClass) - defclass("", core.UndefinedFunctionClass) - defclass("", core.SimpleErrorClass) - defclass("", core.StreamErrorClass) - defclass("", core.EndOfStreamClass) - defclass("", core.StorageExhaustedClass) - defclass("", core.StandardObjectClass) - defclass("", core.StreamClass) - - defun("ARITHMETIC-ERROR-OPERATION", CreateReader(core.ArithmeticErrorClass, "OPERATION")) - defun("ARITHMETIC-ERROR-OPERANDS", CreateReader(core.ArithmeticErrorClass, "OPERANDS")) - defun("DOMAIN-ERROR-OBJECT", CreateReader(core.DomainErrorClass, "OPERANDS")) - defun("DOMAIN-ERROR-EXPECTED-CLASS", CreateReader(core.DomainErrorClass, "EXPECTED-CLASS")) - defun("PARSE-ERROR-STRING", CreateReader(core.ParseErrorClass, "STRING")) - defun("PARSE-ERROR-EXPECTED-CLASS", CreateReader(core.ParseErrorClass, "EXPECTED-CLASS")) - defun("SIMPLE-ERROR-FORMAT-STRING", CreateReader(core.SimpleErrorClass, "FORMAT-STRING")) - defun("SIMPLE-ERROR-FORMAT-ARGUMENTS", CreateReader(core.SimpleErrorClass, "FORMAT-ARGUMENTS")) - defun("STREAM-ERROR-STREAM", CreateReader(core.StreamErrorClass, "STREAM")) - defun("UNDEFINED-ENTITY-NAME", CreateReader(core.SimpleErrorClass, "NAME")) - defun("UNDEFINED-ENTITY-NAMESPACE", CreateReader(core.StreamErrorClass, "NAMESPACE")) - - defspecial("IMPORT", Import) - Time = time.Now() -} diff --git a/lib/sequence.go b/lib/sequence.go deleted file mode 100644 index 8992009..0000000 --- a/lib/sequence.go +++ /dev/null @@ -1,202 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -// Length returns the length of sequence as an integer greater than or equal to -// 0. When sequence is a basic-vector, length returns its dimension. When -// sequence is a list, the result is the number of elements in the list; if an -// element is itself a list, the elements within this sublist are not counted. -// In the case of dotted lists, length returns the number of conses at the -// uppermost level of the list. For example, (length ' (a b . c)) ⇒ 2, since '(a -// b . c) ≡ (cons 'a (cons 'b 'c)). An error shall be signaled if sequence is -// not a basic-vector or a list (error-id. domain-error). -func Length(e core.Environment, sequence core.Instance) (core.Instance, core.Instance) { - switch { - case core.InstanceOf(core.StringClass, sequence): - return core.NewInteger(len(sequence.(core.String))), nil - case core.InstanceOf(core.GeneralVectorClass, sequence): - return core.NewInteger(len(sequence.(core.GeneralVector))), nil - case core.InstanceOf(core.ListClass, sequence): - return core.NewInteger(sequence.(core.List).Length()), nil - } - // TODO: core.SeqClass - return SignalCondition(e, core.NewDomainError(e, sequence, core.ObjectClass), Nil) -} - -// Elt returns the element of sequence that has index z. Indexing is 0-based; -// i.e., z = 0 designates the first element, Given a sequence and an integer z -// satisfying 0 ≤ z < (length sequence). An error shall be signaled if z is an -// integer outside of the mentioned range (error-id. index-out-of-range). An -// error shall be signaled if sequence is not a basic-vector or a list or if z -// is not an integer (error-id. domain-error). -func Elt(e core.Environment, sequence, z core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.IntegerClass, z); err != nil { - return nil, err - } - switch { - case core.InstanceOf(core.StringClass, sequence): - seq := sequence.(core.String) - idx := int(z.(core.Integer)) - if idx > 0 && len(seq) <= idx { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - return core.NewCharacter(seq[idx]), nil - case core.InstanceOf(core.GeneralVectorClass, sequence): - seq := sequence.(core.GeneralVector) - idx := int(z.(core.Integer)) - if idx > 0 && len(seq) <= idx { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - return seq[idx], nil - case core.InstanceOf(core.ListClass, sequence): - seq := sequence.(core.List).Slice() - idx := int(z.(core.Integer)) - if idx > 0 && len(seq) <= idx { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - return seq[idx], nil - } - return SignalCondition(e, core.NewDomainError(e, sequence, core.ObjectClass), Nil) - -} - -// SetElt is that these replace the object obtainable by elt with obj. The -// returned value is obj. An error shall be signaled if z is an integer outside -// of the valid range of indices (error-id. index-out-of-range). An error shall -// be signaled if sequence is not a basic-vector or a list or if z is not an -// integer (error-id. domain-error). obj may be any ISLISP object. -func SetElt(e core.Environment, obj, sequence, z core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.IntegerClass, z); err != nil { - return nil, err - } - switch { - case core.InstanceOf(core.StringClass, sequence): - seq := sequence.(core.String) - idx := int(z.(core.Integer)) - if idx > 0 && len(seq) <= idx { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - if err := ensure(e, core.CharacterClass, obj); err != nil { - return nil, err - } - seq[idx] = rune(obj.(core.Character)) - return obj, nil - case core.InstanceOf(core.GeneralVectorClass, sequence): - seq := sequence.(core.GeneralVector) - idx := int(z.(core.Integer)) - if idx > 0 && len(seq) <= idx { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - seq[idx] = obj - return obj, nil - case core.InstanceOf(core.ListClass, sequence): - seq := sequence.(core.List).Slice() - idx := int(z.(core.Integer)) - if idx > 0 && len(seq) <= idx { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - for idx != 0 && core.InstanceOf(core.ConsClass, sequence) { - idx-- - sequence = sequence.(*core.Cons).Cdr - } - sequence.(*core.Cons).Car = obj - return obj, nil - } - return SignalCondition(e, core.NewDomainError(e, sequence, core.ObjectClass), Nil) -} - -// Subseq returns the subsequence of length z2 − z1, containing the elements -// with indices from z1 (inclusive) to z2 (exclusive). The subsequence is newly -// allocated, and has the same class as sequence, Given a sequence sequence and -// two integers z1 and z2 satisfying 0 ≤ z1 ≤ z2 ≤ (length sequence) An error -// shall be signaled if the requested subsequence cannot be allocated (error-id. -// cannot-create-sequence). An error shall be signaled if z1 or z2 are outside -// of the bounds mentioned (error-id. index-out-of-range). An error shall be -// signaled if sequence is not a basic-vector or a list, or if z1 is not an -// integer, or if z2 is not an integer (error-id. domain-error). -func Subseq(e core.Environment, sequence, z1, z2 core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.IntegerClass, z1, z2); err != nil { - return nil, err - } - start := int(z1.(core.Integer)) - end := int(z2.(core.Integer)) - switch { - case core.InstanceOf(core.StringClass, sequence): - seq := sequence.(core.String) - if !(0 <= start && start < len(seq) && 0 <= end && end < len(seq) && start <= end) { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - return seq[start:end], nil - case core.InstanceOf(core.GeneralVectorClass, sequence): - seq := sequence.(core.GeneralVector) - if !(0 <= start && start < len(seq) && 0 <= end && end < len(seq) && start <= end) { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - return seq[start:end], nil - case core.InstanceOf(core.ListClass, sequence): - seq := sequence.(core.List).Slice() - if !(0 < start && start < len(seq) && 0 < end && end < len(seq) && start <= end) { - return SignalCondition(e, core.NewIndexOutOfRange(e), Nil) - } - return List(e, seq[start:end]...) - } - return SignalCondition(e, core.NewDomainError(e, sequence, core.ObjectClass), Nil) -} - -// Destructively modifies destination to contain the results of applying -// function to successive elements in the sequences. The destination is -// returned. If destination and each element of sequences are not all the same -// length, the iteration terminates when the shortest sequence (of any of the -// sequences or the destination) is exhausted. The calls to function proceed -// from left to right, so that if function has side-effects, it can rely upon -// being called first on all of the elements with index 0, then on all of those -// numbered 1, and so on. An error shall be signaled if destination is not a -// basic-vector or a list (error-id. domain-error). An error shall be signaled -// if any sequence is not a basic-vector or a list (error-id. domain-error). -func MapInto(e core.Environment, destination, function core.Instance, sequences ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.ListClass, append(sequences, destination)...); err != nil { - if err := ensure(e, core.BasicVectorClass, append(sequences, destination)...); err != nil { - return nil, err - } - } - if err := ensure(e, core.FunctionClass, function); err != nil { - return nil, err - } - min, err := Length(e, destination) - if err != nil { - return nil, err - } - for _, seq := range sequences { - len, err := Length(e, seq) - if err != nil { - return nil, err - } - min, err = Min(e, min, len) - if err != nil { - return nil, err - } - } - for i := 0; i < int(min.(core.Integer)); i++ { - arguments := make([]core.Instance, len(sequences)) - for j, seq := range sequences { - var err core.Instance - arguments[j], err = Elt(e, seq, core.NewInteger(i)) - if err != nil { - return nil, err - } - } - ret, err := function.(core.Applicable).Apply(e.NewDynamic(), arguments...) - if err != nil { - return nil, err - } - _, err = SetElt(e, ret, destination, core.NewInteger(i)) - if err != nil { - return nil, err - } - } - return destination, nil -} diff --git a/lib/sequence_test.go b/lib/sequence_test.go deleted file mode 100644 index cd886b6..0000000 --- a/lib/sequence_test.go +++ /dev/null @@ -1,168 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. -package lib - -import "testing" - -func TestLength(t *testing.T) { - execTests(t, Length, []test{ - { - exp: `(length '(a b c))`, - want: `3`, - wantErr: false, - }, - { - exp: `(length '(a (b) (c d e)))`, - want: `3`, - wantErr: false, - }, - { - exp: `(length '())`, - want: `0`, - wantErr: false, - }, - { - exp: `(length (vector 'a 'b 'c))`, - want: `3`, - wantErr: false, - }, - }) -} - -func TestElt(t *testing.T) { - execTests(t, Elt, []test{ - { - exp: `(elt '(a b c) 2)`, - want: `'c`, - wantErr: false, - }, - { - exp: `(elt (vector 'a 'b 'c) 1)`, - want: `'b`, - wantErr: false, - }, - { - exp: `(elt "abc" 0)`, - want: `#\a`, - wantErr: false, - }, - }) -} - -func TestSetElt(t *testing.T) { - execTests(t, SetElt, []test{ - { - exp: ` - (let ((string (create-string 5 #\x))) - (setf (elt string 2) #\O) - string) - `, - want: `"xxOxx"`, - wantErr: false, - }, - { - exp: ` - (let ((string (create-list 5 'x))) - (setf (elt string 2) 'O) - string) - `, - want: `'(x x O x x)`, - wantErr: false, - }, - }) -} - -func TestSubseq(t *testing.T) { - execTests(t, Subseq, []test{ - { - exp: `(subseq "abcdef" 1 4)`, - want: `"bcd"`, - wantErr: false, - }, - { - exp: `(subseq '(a b c d e f) 1 4)`, - want: `'(b c d)`, - wantErr: false, - }, - { - exp: `(subseq (vector 'a 'b 'c 'd 'e 'f) 1 4)`, - want: `#(b c d)`, - wantErr: false, - }, - }) -} - -func TestMapInto(t *testing.T) { - execTests(t, MapInto, []test{ - { - exp: `(defglobal a nil)`, - want: `'a`, - wantErr: false, - }, - { - exp: `(defglobal b nil)`, - want: `'b`, - wantErr: false, - }, - { - exp: `(defglobal k nil)`, - want: `'k`, - wantErr: false, - }, - { - exp: `(setq a (list 1 2 3 4))`, - want: `'(1 2 3 4)`, - wantErr: false, - }, - { - exp: `(setq a (list 1 2 3 4))`, - want: `'(1 2 3 4)`, - wantErr: false, - }, - { - exp: `(setq b (list 10 10 10 10))`, - want: `'(10 10 10 10)`, - wantErr: false, - }, - { - exp: `(map-into a #'+ a b)`, - want: `'(11 12 13 14)`, - wantErr: false, - }, - { - exp: `a`, - want: `'(11 12 13 14)`, - wantErr: false, - }, - { - exp: `b`, - want: `'(10 10 10 10)`, - wantErr: false, - }, - { - exp: `(setq k '(one two three))`, - want: `'(one two three)`, - wantErr: false, - }, - { - exp: `(map-into a #'cons k a)`, - want: `'((one . 11) (two . 12) (three . 13) 14)`, - wantErr: false, - }, - { - exp: ` - (let ((x 0)) - (map-into a - (lambda () (setq x (+ x 2))))) - `, - want: `'(2 4 6 8)`, - wantErr: false, - }, - { - exp: `a`, - want: `'(2 4 6 8)`, - wantErr: false, - }, - }) -} diff --git a/lib/sequencing_form.go b/lib/sequencing_form.go deleted file mode 100644 index 677f896..0000000 --- a/lib/sequencing_form.go +++ /dev/null @@ -1,24 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -// Progn allows a series of forms to be evaluated, where normally only one could -// be used. The result of evaluation of the last form of form* is returned. All -// the forms are evaluated from left to right. The values of all the forms but -// the last are discarded, so they are executed only for their side-effects. -// progn without forms returns nil. -func Progn(e core.Environment, forms ...core.Instance) (core.Instance, core.Instance) { - var err core.Instance - ret := Nil - for _, form := range forms { - ret, err = Eval(e, form) - if err != nil { - return nil, err - } - } - return ret, nil -} diff --git a/lib/sequencing_form_test.go b/lib/sequencing_form_test.go deleted file mode 100644 index 2e01564..0000000 --- a/lib/sequencing_form_test.go +++ /dev/null @@ -1,18 +0,0 @@ -package lib - -import "testing" - -func TestProgn(t *testing.T) { - execTests(t, Progn, []test{ - { - exp: `(progn)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(progn 1 2)`, - want: `2`, - wantErr: false, - }, - }) -} diff --git a/lib/stream.go b/lib/stream.go deleted file mode 100644 index e123d90..0000000 --- a/lib/stream.go +++ /dev/null @@ -1,432 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import ( - "bytes" - "os" - "strings" - - "github.com/islisp-dev/iris/reader/parser" - "github.com/islisp-dev/iris/core" -) - -func Streamp(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.StreamClass, obj) { - return T, nil - } - return Nil, nil -} - -func OpenStreamP(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - return T, nil -} - -func InputStreamP(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if s, ok := obj.(core.Stream); ok && s.BufferedTokenReader.Raw != nil { - return T, nil - } - return Nil, nil -} - -func OutputStreamP(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if s, ok := obj.(core.Stream); ok && s.BufferedWriter.Raw != nil { - return T, nil - } - return Nil, nil -} - -func StandardInput(e core.Environment) (core.Instance, core.Instance) { - return e.StandardInput, nil -} - -func StandardOutput(e core.Environment) (core.Instance, core.Instance) { - return e.StandardOutput, nil -} - -func ErrorOutput(e core.Environment) (core.Instance, core.Instance) { - return e.ErrorOutput, nil -} - -func WithStandardInput(e core.Environment, streamForm core.Instance, forms ...core.Instance) (core.Instance, core.Instance) { - var err core.Instance - e.StandardInput, err = Eval(e, streamForm) - if err != nil { - return nil, err - } - if ok, _ := InputStreamP(e, e.StandardInput); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, e.StandardInput, core.StreamClass), Nil) - } - return Progn(e, forms...) -} - -func WithStandardOutput(e core.Environment, streamForm core.Instance, forms ...core.Instance) (core.Instance, core.Instance) { - var err core.Instance - e.StandardOutput, err = Eval(e, streamForm) - if err != nil { - return nil, err - } - if ok, _ := OutputStreamP(e, e.StandardOutput); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, e.StandardOutput, core.StreamClass), Nil) - } - return Progn(e, forms...) -} - -func WithErrorOutput(e core.Environment, streamForm core.Instance, forms ...core.Instance) (core.Instance, core.Instance) { - var err core.Instance - e.ErrorOutput, err = Eval(e, streamForm) - if err != nil { - return nil, err - } - if ok, _ := OutputStreamP(e, e.ErrorOutput); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, e.ErrorOutput, core.StreamClass), Nil) - } - return Progn(e, forms...) -} - -func OpenInputFile(e core.Environment, filename core.Instance, elementClass ...core.Instance) (core.Instance, core.Instance) { - if ok, _ := Stringp(e, filename); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, filename, core.StringClass), Nil) - } - file, err := os.Open(string(filename.(core.String))) - if err != nil { - return SignalCondition(e, core.NewStreamError(e, Nil), Nil) - } - var ec core.Instance - if len(elementClass) == 0 { - ec = core.CharacterClass - } - if len(elementClass) == 1 { - ec = elementClass[0] - } - return core.NewStream(file, nil, ec), nil -} - -func OpenOutputFile(e core.Environment, filename core.Instance, elementClass ...core.Instance) (core.Instance, core.Instance) { - if ok, _ := Stringp(e, filename); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, filename, core.StringClass), Nil) - } - rawFilename := string(filename.(core.String)) - file, err := os.Create(rawFilename) - if err != nil { - return SignalCondition(e, core.NewStreamError(e, Nil), Nil) - } - var ec core.Instance - if len(elementClass) == 0 { - ec = core.CharacterClass - } - if len(elementClass) == 1 { - ec = elementClass[0] - } - return core.NewStream(nil, file, ec), nil -} - -func OpenIoFile(e core.Environment, filename core.Instance, elementClass ...core.Instance) (core.Instance, core.Instance) { - if ok, _ := Stringp(e, filename); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, filename, core.StringClass), Nil) - } - file, err := os.Open(string(filename.(core.String))) - if err != nil { - return SignalCondition(e, core.NewStreamError(e, Nil), Nil) - } - var ec core.Instance - if len(elementClass) == 0 { - ec = core.CharacterClass - } - if len(elementClass) == 1 { - ec = elementClass[0] - } - return core.NewStream(file, file, ec), nil -} - -func WithOpenInputFile(e core.Environment, fileSpec core.Instance, forms ...core.Instance) (core.Instance, core.Instance) { - if !core.InstanceOf(core.ListClass, fileSpec) { - return SignalCondition(e, core.NewDomainError(e, fileSpec, core.ListClass), Nil) - } - car, err := Car(e, fileSpec) - if err != nil { - return nil, err - } - cdr, err := Cdr(e, fileSpec) - if err != nil { - return nil, err - } - cadr, err := Car(e, cdr) - if err != nil { - return nil, err - } - p, err := Eval(e, cadr) - if err != nil { - return nil, err - } - s, err := OpenInputFile(e, p) - if err != nil { - return nil, err - } - e.Variable.Define(car, s) - r, err := Progn(e, forms...) - e.Variable.Delete(car) - if _, err := Close(e, s); err != nil { - return nil, err - } - return r, err -} - -func WithOpenOutputFile(e core.Environment, fileSpec core.Instance, forms ...core.Instance) (core.Instance, core.Instance) { - if !core.InstanceOf(core.ListClass, fileSpec) { - return SignalCondition(e, core.NewDomainError(e, fileSpec, core.ListClass), Nil) - } - car, err := Car(e, fileSpec) - if err != nil { - return nil, err - } - cdr, err := Cdr(e, fileSpec) - if err != nil { - return nil, err - } - cadr, err := Car(e, cdr) - if err != nil { - return nil, err - } - p, err := Eval(e, cadr) - if err != nil { - return nil, err - } - s, err := OpenOutputFile(e, p) - if err != nil { - return nil, err - } - e.Variable.Define(car, s) - r, err := Progn(e, forms...) - e.Variable.Delete(car) - if _, err := Close(e, s); err != nil { - return nil, err - } - return r, err -} - -func WithOpenIoFile(e core.Environment, fileSpec core.Instance, forms ...core.Instance) (core.Instance, core.Instance) { - if !core.InstanceOf(core.ListClass, fileSpec) { - return SignalCondition(e, core.NewDomainError(e, fileSpec, core.ListClass), Nil) - } - car, err := Car(e, fileSpec) - if err != nil { - return nil, err - } - cdr, err := Cdr(e, fileSpec) - if err != nil { - return nil, err - } - cadr, err := Car(e, cdr) - if err != nil { - return nil, err - } - p, err := Eval(e, cadr) - if err != nil { - return nil, err - } - s, err := OpenOutputFile(e, p) - if err != nil { - return nil, err - } - e.Variable.Define(car, cadr) - r, err := Progn(e, forms...) - e.Variable.Delete(car) - if _, err := Close(e, s); err != nil { - return nil, err - } - return r, err -} - -func Close(e core.Environment, stream core.Instance) (core.Instance, core.Instance) { - // It works on file or std stream. - if ok, _ := Streamp(e, stream); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, stream, core.StreamClass), Nil) - } - if stream.(core.Stream).BufferedTokenReader.Raw != nil { - file, ok := stream.(core.Stream).BufferedTokenReader.Raw.(*os.File) - if ok { - file.Close() - } else { - // Close is only for file pointer - return SignalCondition(e, core.NewStreamError(e, stream), Nil) - } - } - if stream.(core.Stream).BufferedWriter.Raw != nil { - file, ok := stream.(core.Stream).BufferedWriter.Raw.(*os.File) - if ok { - stream.(core.Stream).Flush() - file.Close() - } else { - // Close is only for file pointer - return SignalCondition(e, core.NewStreamError(e, stream), Nil) - } - } - return Nil, nil -} - -func FinishOutput(e core.Environment, stream core.Instance) (core.Instance, core.Instance) { - // It works on file or std stream. - if ok, _ := Streamp(e, stream); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, stream, core.StreamClass), Nil) - } - if stream.(core.Stream).Writer != nil { - stream.(core.Stream).Writer.Flush() - } - return Nil, nil -} - -func CreateStringInputStream(e core.Environment, str core.Instance) (core.Instance, core.Instance) { - return core.NewStream(strings.NewReader(string(str.(core.String))), nil, core.CharacterClass), nil -} - -func CreateStringOutputStream(e core.Environment) (core.Instance, core.Instance) { - return core.NewStream(nil, new(bytes.Buffer), core.CharacterClass), nil -} - -func GetOutputStreamString(e core.Environment, stream core.Instance) (core.Instance, core.Instance) { - if ok, _ := OutputStreamP(e, stream); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, stream, core.StreamClass), Nil) - } - stream.(core.Stream).Flush() - out := core.NewString([]rune(stream.(core.Stream).BufferedWriter.Raw.(*bytes.Buffer).String())) - stream.(core.Stream).BufferedWriter.Raw.(*bytes.Buffer).Reset() - return out, nil -} - -func Read(e core.Environment, options ...core.Instance) (core.Instance, core.Instance) { - s := e.StandardInput - if len(options) > 0 { - s = options[0] - } - if b, _ := InputStreamP(e, s); core.DeepEqual(b, Nil) { - return SignalCondition(e, core.NewDomainError(e, s, core.StreamClass), Nil) - } - env := e - eosErrorP := true - if len(options) > 1 { - if core.DeepEqual(options[1], Nil) { - env = env.NewHandler(core.DefaultHandler) - eosErrorP = false - } - } - eosValue := Nil - if len(options) > 2 { - eosValue = options[2] - } - v, err := parser.Parse(env, s.(core.Stream).BufferedTokenReader) - if err != nil && core.InstanceOf(core.EndOfStreamClass, err) { - if eosErrorP { - return nil, err - } - return eosValue, nil - } - return v, nil -} - -func ReadChar(e core.Environment, options ...core.Instance) (core.Instance, core.Instance) { - s := e.StandardInput - if len(options) > 0 { - s = options[0] - } - if ok, _ := InputStreamP(e, s); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, s, core.StreamClass), Nil) - } - eosErrorP := true - if len(options) > 1 { - if core.DeepEqual(options[1], Nil) { - eosErrorP = false - } - } - eosValue := Nil - if len(options) > 2 { - eosValue = options[2] - } - //v, _, err := bufio.NewReader(s.(core.Stream).Reader).ReadRune() - v, _, err := s.(core.Stream).ReadRune() - if err != nil { - if eosErrorP { - return SignalCondition(e, core.NewEndOfStream(e), Nil) - } - return eosValue, nil - } - return core.NewCharacter(v), nil -} - -func ProbeFile(e core.Environment, fs ...core.Instance) (core.Instance, core.Instance) { - if len(fs) != 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - if t, err := Stringp(e, fs[0]); err != nil || core.DeepEqual(t, Nil) { - return SignalCondition(e, core.NewDomainError(e, fs[0], core.StringClass), Nil) - } - if _, err := os.Stat(string(fs[0].(core.String))); os.IsNotExist(err) { - return Nil, nil - } else { - return T, nil - } -} - -func PreviewChar(e core.Environment, options ...core.Instance) (core.Instance, core.Instance) { - s := e.StandardInput - if len(options) > 0 { - s = options[0] - } - if ok, _ := InputStreamP(e, s); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, s, core.StreamClass), Nil) - } - eosErrorP := true - if len(options) > 1 { - if core.DeepEqual(options[1], Nil) { - eosErrorP = false - } - } - eosValue := Nil - if len(options) > 2 { - eosValue = options[2] - } - //v, _, err := bufio.NewReader(s.(core.Stream).Reader).ReadRune() - bytes, err := s.(core.Stream).Peek(1) - if err != nil { - if eosErrorP { - return SignalCondition(e, core.NewEndOfStream(e), Nil) - } - return eosValue, nil - } - return core.NewCharacter(rune(bytes[0])), nil -} - -func ReadLine(e core.Environment, options ...core.Instance) (core.Instance, core.Instance) { - s := e.StandardInput - if len(options) > 0 { - s = options[0] - } - if ok, _ := InputStreamP(e, s); core.DeepEqual(ok, Nil) { - return SignalCondition(e, core.NewDomainError(e, s, core.StreamClass), Nil) - } - eosErrorP := true - if len(options) > 1 { - if core.DeepEqual(options[1], Nil) { - eosErrorP = false - } - } - eosValue := Nil - if len(options) > 2 { - eosValue = options[2] - } - v, _, err := s.(core.Stream).ReadLine() - if err != nil { - if eosErrorP { - return SignalCondition(e, core.NewEndOfStream(e), Nil) - } - return eosValue, nil - } - return core.NewString([]rune(string(v))), nil -} - -func StreamReadyP(e core.Environment, inputStream core.Instance) (core.Instance, core.Instance) { - // TODO: stream-ready-p - return T, nil -} diff --git a/lib/stream_test.go b/lib/stream_test.go deleted file mode 100644 index c7d4a94..0000000 --- a/lib/stream_test.go +++ /dev/null @@ -1,240 +0,0 @@ -package lib - -import "testing" - -func TestStreamp(t *testing.T) { - execTests(t, Streamp, []test{ - { - exp: `(streamp (standard-input))`, - want: `t`, - wantErr: false, - }, - { - exp: `(streamp '())`, - want: `nil`, - wantErr: false, - }, - }) -} - -func TestInputStreamP(t *testing.T) { - execTests(t, InputStreamP, []test{ - { - exp: `(input-stream-p (standard-input))`, - want: `t`, - wantErr: false, - }, - { - exp: `(input-stream-p (standard-output))`, - want: `nil`, - wantErr: false, - }, - { - exp: `(streamp '(a b c))`, - want: `nil`, - wantErr: false, - }, - }) -} - -func TestOutputStreamP(t *testing.T) { - execTests(t, OutputStreamP, []test{ - { - exp: `(output-stream-p (standard-input))`, - want: `nil`, - wantErr: false, - }, - { - exp: `(output-stream-p (standard-output))`, - want: `t`, - wantErr: false, - }, - { - exp: `(streamp "hello")`, - want: `nil`, - wantErr: false, - }, - }) -} - -func TestWithStandardInput(t *testing.T) { - execTests(t, WithStandardInput, []test{ - { - exp: ` - (with-standard-input (create-string-input-stream "this is a string") - (list (read) (read))) - `, - want: `'(this is)`, - wantErr: false, - }, - }) -} - -func TestWithOpenIoFile(t *testing.T) { - execTests(t, WithOpenIoFile, []test{ - { - exp: ` - (with-open-output-file (outstream "__example.dat") - (format outstream "hello")) - `, - want: `nil`, - wantErr: false, - }, - { - exp: ` - (with-open-input-file (instream "__example.dat") - (read instream)) - `, - want: `'hello`, - wantErr: false, - }, - }) -} - -func TestCreateStringInputStream(t *testing.T) { - execTests(t, CreateStringInputStream, []test{ - { - exp: ` - (let ((str (create-string-input-stream "this is a string"))) - (list (read str) (read str) (read str))) - `, - want: `'(this is a)`, - wantErr: false, - }, - }) -} - -func TestCreateStringOutputStream(t *testing.T) { - execTests(t, CreateStringOutputStream, []test{ - { - exp: ` - (let ((str (create-string-output-stream))) - (format str "hello") - (format str "world") - (get-output-stream-string str)) - `, - want: `"helloworld"`, - wantErr: false, - }, - }) -} - -func TestGetOutputStreamString(t *testing.T) { - execTests(t, GetOutputStreamString, []test{ - { - exp: ` - (let ((out-str (create-string-output-stream))) - (format out-str "This is a string") - (let ((part1 (get-output-stream-string out-str))) - (format out-str "right!") - (list part1 (get-output-stream-string out-str)))) - `, - want: `'("This is a string" "right!")`, - wantErr: false, - }, - }) -} - -func TestRead(t *testing.T) { - execTests(t, Read, []test{ - { - exp: `(defglobal str (create-string-input-stream "hello #(1 2 3) 123 #\\A"))`, - want: `'str`, - wantErr: false, - }, - { - exp: `(read str)`, - want: `'hello`, - wantErr: false, - }, - { - exp: `(read str)`, - want: `#(1 2 3)`, - wantErr: false, - }, - { - exp: `(read str)`, - want: `123`, - wantErr: false, - }, - { - exp: `(read str)`, - want: `#\A`, - wantErr: false, - }, - }) -} - -func TestReadChar(t *testing.T) { - execTests(t, ReadChar, []test{ - { - exp: `(defglobal str (create-string-input-stream "hi"))`, - want: `'str`, - wantErr: false, - }, - { - exp: `(read-char str)`, - want: `#\h`, - wantErr: false, - }, - { - exp: `(read-char str)`, - want: `#\i`, - wantErr: false, - }, - { - exp: `(read str)`, - want: `nil`, - wantErr: true, - }, - }) -} - -func TestPreviewChar(t *testing.T) { - execTests(t, PreviewChar, []test{ - { - exp: ` - (let ((s (create-string-input-stream "foo"))) - (list (preview-char s) (read-char s) (read-char s))) - `, - want: `'(#\f #\f #\o)`, - wantErr: false, - }, - }) -} - -func TestReadLine(t *testing.T) { - execTests(t, ReadLine, []test{ - { - exp: ` - (with-open-output-file (out "__newfile") - (format out "This is an example") - (format out "~%") - (format out "look at the output file")) - `, - want: `nil`, - wantErr: false, - }, - { - exp: ` - (defglobal str (open-input-file "__newfile")) - `, - want: `'str`, - wantErr: false, - }, - { - exp: ` - (read-line str) - `, - want: `"This is an example"`, - wantErr: false, - }, - { - exp: ` - (read-line str) - `, - want: `"look at the output file"`, - wantErr: false, - }, - }) -} diff --git a/lib/string.go b/lib/string.go deleted file mode 100644 index 8989d5b..0000000 --- a/lib/string.go +++ /dev/null @@ -1,198 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import ( - "strings" - - "github.com/islisp-dev/iris/core" -) - -// Stringp returns t if obj is a string (instance of class string); otherwise, -// returns nil. obj may be any ISLISP object. -func Stringp(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.StringClass, obj) { - return T, nil - } - return Nil, nil -} - -// CreateString returns a string of length i. If initial-character is given, -// then the characters of the new string are initialized with this character, -// otherwise the initialization is implementation defined. An error shall be -// signaled if the requested string cannot be allocated (error-id. -// cannot-create-string). An error shall be signaled if i is not a non-negative -// integer or if initial-character is not a character (error-id. domain-error). -func CreateString(e core.Environment, i core.Instance, initialElement ...core.Instance) (core.Instance, core.Instance) { - if !core.InstanceOf(core.IntegerClass, i) || int(i.(core.Integer)) < 0 { - return SignalCondition(e, core.NewDomainError(e, i, core.ObjectClass), Nil) - } - if len(initialElement) > 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - n := int(i.(core.Integer)) - v := make([]rune, n) - for i := 0; i < n; i++ { - if len(initialElement) == 0 { - v[i] = 0 - } else { - if err := ensure(e, core.CharacterClass, initialElement[0]); err != nil { - return nil, err - } - v[i] = rune(initialElement[0].(core.Character)) - } - } - return core.NewString(v), nil -} - -// StringEqual tests whether string1 is the same string as string2. -func StringEqual(e core.Environment, string1, string2 core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.StringClass, string1, string2); err != nil { - return nil, err - } - if string(string1.(core.String)) == string(string2.(core.String)) { - return T, nil - } - return Nil, nil -} - -// StringNotEqual tests whether string1 not is the same string as string2. -func StringNotEqual(e core.Environment, string1, string2 core.Instance) (core.Instance, core.Instance) { - ret, err := StringEqual(e, string1, string2) - if err != nil { - return nil, err - } - return Not(e, ret) -} - -// StringGreaterThan tests whether string1 is greater than string2. -func StringGreaterThan(e core.Environment, string1, string2 core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.StringClass, string1, string2); err != nil { - return nil, err - } - if string(string1.(core.String)) > string(string2.(core.String)) { - return T, nil - } - return Nil, nil -} - -// StringGreaterThanOrEqual tests whether string1 is greater than or equal to -// string2. -func StringGreaterThanOrEqual(e core.Environment, string1, string2 core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.StringClass, string1, string2); err != nil { - return nil, err - } - if string(string1.(core.String)) >= string(string2.(core.String)) { - return T, nil - } - return Nil, nil -} - -// StringLessThan tests whether string1 is less than string2. -func StringLessThan(e core.Environment, string1, string2 core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.StringClass, string1, string2); err != nil { - return nil, err - } - if string(string1.(core.String)) < string(string2.(core.String)) { - return T, nil - } - return Nil, nil -} - -// StringLessThanOrEqual tests whether string1 is less than or equal to string2. -func StringLessThanOrEqual(e core.Environment, string1, string2 core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.StringClass, string1, string2); err != nil { - return nil, err - } - if string(string1.(core.String)) <= string(string2.(core.String)) { - return T, nil - } - return Nil, nil -} - -// CharIndex returns the position of char in string, The search starts from the -// position indicated by start-position (which is 0-based and defaults to 0). -// The value returned if the search succeeds is an offset from the beginning of -// the string, not from the starting point. If the char does not occur in the -// string, nil is returned. The function char= is used for the comparisons. An -// error shall be signaled if char is not a character or if string is not a -// string (error-id. domain-error). -func CharIndex(e core.Environment, char, str core.Instance, startPosition ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.CharacterClass, char); err != nil { - return nil, err - } - if err := ensure(e, core.StringClass, str); err != nil { - return nil, err - } - if len(startPosition) > 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - n := 0 - if len(startPosition) == 1 { - if err := ensure(e, core.IntegerClass, startPosition[0]); err != nil { - return nil, err - } - n = int(startPosition[0].(core.Integer)) - } - s := string(str.(core.String)[n:]) - c := rune(char.(core.Character)) - i := strings.IndexRune(s, c) - if i < 0 { - return Nil, nil - } - return core.NewInteger(i + n), nil -} - -// StringIndex returns the position of the given substring within string. The -// search starts from the position indicated by start-position (which is 0-based -// and defaults to 0). The value returned if the search succeeds is an offset -// from the beginning of the string, not from the starting point. If that -// substring does not occur in the string, nil is returned. Presence of the -// substring is done by sequential use of char= on corresponding elements of the -// two strings. An error shall be signaled if either substring or string is not -// a string (error-id. domain-error). -func StringIndex(e core.Environment, sub, str core.Instance, startPosition ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.StringClass, sub); err != nil { - return nil, err - } - if err := ensure(e, core.StringClass, str); err != nil { - return nil, err - } - if len(startPosition) > 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - n := 0 - if len(startPosition) == 1 { - if err := ensure(e, core.IntegerClass, startPosition[0]); err != nil { - return nil, err - } - n = int(startPosition[0].(core.Integer)) - } - s := string(str.(core.String)[n:]) - c := string(sub.(core.String)) - i := strings.Index(s, c) - if i < 0 { - return Nil, nil - } - return core.NewInteger(i + n), nil -} - -// StringAppend returns a single string containing a sequence of characters that -// results from appending the sequences of characters of each of the strings, or -// "" if given no strings. An error shall be signaled if any string is not a -// string (error-id. domain-error). This function does not modify its arguments. -// It is implementation defined whether and when the result shares structure -// with its string arguments. An error shall be signaled if the string cannot be -// allocated (error-id. cannot-create-string). -func StringAppend(e core.Environment, str ...core.Instance) (core.Instance, core.Instance) { - ret := "" - for _, s := range str { - if err := ensure(e, core.StringClass, s); err != nil { - return nil, err - } - ret += string(s.(core.String)) - } - return core.NewString([]rune(ret)), nil -} diff --git a/lib/string_test.go b/lib/string_test.go deleted file mode 100644 index 840612f..0000000 --- a/lib/string_test.go +++ /dev/null @@ -1,213 +0,0 @@ -package lib - -import "testing" - -func TestStringp(t *testing.T) { - execTests(t, Stringp, []test{ - { - exp: `(stringp "abc")`, - want: `t`, - wantErr: false, - }, - { - exp: `(stringp 'abc)`, - want: `nil`, - wantErr: false, - }, - }) -} - -func TestCreateString(t *testing.T) { - execTests(t, CreateString, []test{ - { - exp: `(create-string 3 #\a)`, - want: `"aaa"`, - wantErr: false, - }, - { - exp: `(create-string 0 #\a)`, - want: `""`, - wantErr: false, - }, - }) -} - -func TestStringEqual(t *testing.T) { - execTests(t, StringEqual, []test{ - { - exp: `(if (string= "abcd" "abcd") t nil)`, - want: `t`, - wantErr: false, - }, - { - exp: `(if (string= "abcd" "wxyz") t nil)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(if (string= "abcd" "abcde") t nil)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(if (string= "abcde" "abcd") t nil)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(if (string/= "abcde" "abcd") t nil)`, - want: `t`, - wantErr: false, - }, - { - exp: `(if (string< "abcd" "abcd") t nil)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(if (string< "abcd" "wxyz") t nil)`, - want: `t`, - wantErr: false, - }, - { - exp: `(if (string< "abcd" "abcde") t nil)`, - want: `t`, - wantErr: false, - }, - { - exp: `(if (string< "abcde" "abcd") t nil)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(if (string<= "abcd" "abcd") t nil)`, - want: `t`, - wantErr: false, - }, - { - exp: `(if (string<= "abcd" "wxyz") t nil)`, - want: `t`, - wantErr: false, - }, - { - exp: `(if (string<= "abcd" "abcde") t nil)`, - want: `t`, - wantErr: false, - }, - { - exp: `(if (string<= "abcde" "abcd") t nil)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(if (string> "abcd" "wxyz") t nil)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(if (string>= "abcd" "abcd") t nil)`, - want: `t`, - wantErr: false, - }, - }) -} - -func TestCharIndex(t *testing.T) { - execTests(t, CharIndex, []test{ - { - exp: `(char-index #\b "abcab")`, - want: `1`, - wantErr: false, - }, - { - exp: `(char-index #\B "abcab")`, - want: `nil`, - wantErr: false, - }, - { - exp: `(char-index #\b "abcab" 2)`, - want: `4`, - wantErr: false, - }, - { - exp: `(char-index #\d "abcab")`, - want: `nil`, - wantErr: false, - }, - { - exp: `(char-index #\a "abcab" 4)`, - want: `nil`, - wantErr: false, - }, - }) -} - -func TestStringIndex(t *testing.T) { - execTests(t, StringIndex, []test{ - { - exp: `(string-index "foo" "foobar")`, - want: `0`, - wantErr: false, - }, - { - exp: `(string-index "bar" "foobar")`, - want: `3`, - wantErr: false, - }, - { - exp: `(string-index "FOO" "foobar")`, - want: `nil`, - wantErr: false, - }, - { - exp: `(string-index "foo" "foobar" 1)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(string-index "bar" "foobar" 1)`, - want: `3`, - wantErr: false, - }, - { - exp: `(string-index "foo" "")`, - want: `nil`, - wantErr: false, - }, - { - exp: `(string-index "" "foo")`, - want: `0`, - wantErr: false, - }, - }) -} - -func TestStringAppend(t *testing.T) { - execTests(t, StringAppend, []test{ - { - exp: `(string-append "abc" "def")`, - want: `"abcdef"`, - wantErr: false, - }, - { - exp: `(string-append "abc" "abc")`, - want: `"abcabc"`, - wantErr: false, - }, - { - exp: `(string-append "abc" "")`, - want: `"abc"`, - wantErr: false, - }, - { - exp: `(string-append "" "abc")`, - want: `"abc"`, - wantErr: false, - }, - { - exp: `(string-append "abc" "" "def")`, - want: `"abcdef"`, - wantErr: false, - }, - }) -} diff --git a/lib/symbol.go b/lib/symbol.go deleted file mode 100644 index 5d68eba..0000000 --- a/lib/symbol.go +++ /dev/null @@ -1,78 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import ( - "fmt" - - "github.com/islisp-dev/iris/core" -) - -// Symbolp returns t if obj is a symbol (instance of class symbol); otherwise, -// returns nil. The obj may be any ISLISP object. -func Symbolp(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.SymbolClass, obj) { - return T, nil - } - return Nil, nil -} - -// Property returns the value of the property named property-name associated -// with the symbol symbol . If symbol has no property named property-name, obj -// (which defaults to nil) is returned. An error shall be signaled if either -// symbol or property-name is not a symbol (error-id. domain-error). obj may be -// any ISLISP object -func Property(e core.Environment, symbol, propertyName core.Instance, obj ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.SymbolClass, symbol); err != nil { - return nil, err - } - if len(obj) > 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - ret, ok := e.Property.Get(symbol, propertyName) - if ok { - return ret, nil - } - if len(obj) == 0 { - return Nil, nil - } - return obj[0], nil -} - -// SetProperty causes obj to be the new value of the property named -// property-name asssociated with the symbol symbol . If the property named -// property-name already exists, its corresponding property value is replaced; -// otherwise, a new property is created. obj is returned. An error shall be -// signaled if either symbol or property-name is not a symbol (error-id. -// domain-error). obj may be any ISLISP object -func SetProperty(e core.Environment, obj, symbol, propertyName core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.SymbolClass, symbol); err != nil { - return nil, err - } - e.Property.Set(symbol, propertyName, obj) - return obj, nil -} - -// RemoveProperty removes the property property-name associated with symbol and -// returns the property value of the removed property if there is such a -// property. If there is no such property, nil is returned. An error shall be -// signaled if either symbol or property-name is not a symbol (error-id. -// domain-error). -func RemoveProperty(e core.Environment, symbol, propertyName core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.SymbolClass, symbol); err != nil { - return nil, err - } - if v, ok := e.Property.Delete(symbol, propertyName); ok { - return v, nil - } - return Nil, nil -} - -// Gensym returns an unnamed symbol. gensym is useful for writing macros. It is -// impossible for an identifier to name an unnamed symbol. -func Gensym(e core.Environment) (core.Instance, core.Instance) { - symbol := core.NewSymbol(fmt.Sprintf("#:%v", uniqueInt())) - return symbol, nil -} diff --git a/lib/symbol_test.go b/lib/symbol_test.go deleted file mode 100644 index d16a07f..0000000 --- a/lib/symbol_test.go +++ /dev/null @@ -1,58 +0,0 @@ -package lib - -import "testing" - -func TestSymbol(t *testing.T) { - execTests(t, Symbolp, []test{ - { - exp: `(symbolp 'foo)`, - want: `t`, - wantErr: false, - }, - { - exp: `(symbolp 1)`, - want: `nil`, - wantErr: false, - }, - }) -} - -func TestProperty(t *testing.T) { - execTests(t, Property, []test{ - { - exp: `(property 'x 'one)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(property 'x 'one 1)`, - want: `1`, - wantErr: false, - }, - { - exp: `(setf (property 'x 'one) 1)`, - want: `1`, - wantErr: false, - }, - { - exp: `(property 'x 'one)`, - want: `1`, - wantErr: false, - }, - { - exp: `(remove-property 'x 'one)`, - want: `1`, - wantErr: false, - }, - { - exp: `(remove-property 'x 'one)`, - want: `nil`, - wantErr: false, - }, - { - exp: `(property 'x 'one)`, - want: `nil`, - wantErr: false, - }, - }) -} diff --git a/lib/test.go b/lib/test.go deleted file mode 100644 index e46b005..0000000 --- a/lib/test.go +++ /dev/null @@ -1,49 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import ( - "fmt" - "reflect" - "regexp" - "runtime" - "testing" - - "github.com/islisp-dev/iris/core" -) - -type test struct { - exp string - want string - wantErr bool -} - -func execTests(t *testing.T, function interface{}, tests []test) { - name := runtime.FuncForPC(reflect.ValueOf(function).Pointer()).Name() - re := regexp.MustCompile(`\s+`) - for _, tt := range tests { - t.Run(re.ReplaceAllString(tt.exp, " "), func(t *testing.T) { - obj, err1 := readFromString(tt.exp) - if err1 != nil { - t.Errorf("ParseError %v, want %v", err1, tt.exp) - return - } - got, err := Eval(TopLevel, obj) - wantObj, err1 := readFromString(tt.want) - if err1 != nil { - t.Errorf("ParseError %v, want %v", err1, tt.want) - return - } - want, _ := Eval(TopLevel, wantObj) - if !tt.wantErr && !core.DeepEqual(got, want) { - t.Errorf("%v() got = %v, want %v", name, got, want) - } - if (err != nil) != tt.wantErr { - fmt.Println(got, want) - t.Errorf("%v() err = %v, wantErr %v", name, err, tt.wantErr) - } - }) - } -} diff --git a/lib/util.go b/lib/util.go deleted file mode 100644 index da26f01..0000000 --- a/lib/util.go +++ /dev/null @@ -1,173 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import ( - "reflect" - "regexp" - "runtime" - "strings" - - "github.com/islisp-dev/iris/reader/parser" - "github.com/islisp-dev/iris/reader/tokenizer" - "github.com/islisp-dev/iris/core" -) - -func isProperList(i core.Instance) bool { - if core.InstanceOf(core.ConsClass, i) { - return isProperList(i.(*core.Cons).Cdr) // Checked at the top of this statements - } - if core.DeepEqual(i, Nil) { - return true - } - return false -} - -func createList(es ...core.Instance) core.Instance { - if len(es) == 0 { - return Nil - } - return core.NewCons(es[0], createList(es[1:]...)) -} - -func convFloat64(e core.Environment, x core.Instance) (float64, bool, core.Instance) { - switch { - case core.InstanceOf(core.IntegerClass, x): - return float64(x.(core.Integer)), false, nil - case core.InstanceOf(core.FloatClass, x): - return float64(x.(core.Float)), true, nil - default: - _, err := SignalCondition(e, core.NewDomainError(e, x, core.NumberClass), Nil) - return 0.0, false, err - } -} - -func readFromString(s string) (core.Instance, core.Instance) { - e := core.NewEnvironment(nil, nil, nil, core.DefaultHandler) - return parser.Parse(e, tokenizer.NewBufferedTokenReader(strings.NewReader(s))) -} - -func ensure(e core.Environment, c core.Class, i ...core.Instance) core.Instance { - for _, o := range i { - if !core.InstanceOf(c, o) { - _, err := SignalCondition(e, core.NewDomainError(e, o, c), Nil) - return err - } - } - return nil -} - -var unique = 0 - -func uniqueInt() int { - i := unique - unique++ - return i -} - -func func2symbol(function interface{}) core.Instance { - name := runtime.FuncForPC(reflect.ValueOf(function).Pointer()).Name() - name = regexp.MustCompile(`.*\.`).ReplaceAllString(name, "") - name = regexp.MustCompile(`(.)([A-Z])`).ReplaceAllString(name, "$1-$2") - name = strings.ToUpper(name) - return core.NewSymbol(name) -} - -type Pattern func(core.Instance) bool - -func Sym(ss ...string) Pattern { - return func(instance core.Instance) bool { - if len(ss) == 0 { - return core.InstanceOf(core.SymbolClass, instance) - } - for _, s := range ss { - if core.DeepEqual(s, instance) { - return true - } - } - return false - } -} - -func Any(_ core.Instance) bool { - return true -} - -func Tpl(tests ...Pattern) Pattern { - return func(instance core.Instance) bool { - if !isProperList(instance) { - return false - } - list := instance.(core.List).Slice() - if len(list) != len(tests) { - return false - } - for i := 0; i < len(list); i++ { - if !tests[i](list[i]) { - return false - } - } - return true - } -} - -func Disj(tests ...Pattern) Pattern { - return func(instance core.Instance) bool { - for _, test := range tests { - if test(instance) { - return true - } - } - return false - } -} - -func Conj(tests ...Pattern) Pattern { - return func(instance core.Instance) bool { - for _, test := range tests { - if !test(instance) { - return false - } - } - return true - } -} - -func Neg(test Pattern) Pattern { - return func(instance core.Instance) bool { - return !test(instance) - } -} - -func Apd(test Pattern, tests ...Pattern) Pattern { - return func(instance core.Instance) bool { - if !isProperList(instance) { - return false - } - list := instance.(core.List).Slice() - for i, instance := range list { - if test(instance) { - if len(tests) > 1 && Apd(tests[0], tests...)(createList(list[i:]...)) { - return true - } - } - } - return len(tests) == 0 - } -} - -func Rep(test Pattern) Pattern { - return func(instance core.Instance) bool { - if !isProperList(instance) { - return false - } - for _, instance := range instance.(core.List).Slice() { - if !test(instance) { - return false - } - } - return true - } -} diff --git a/lib/variable.go b/lib/variable.go deleted file mode 100644 index 26cba4d..0000000 --- a/lib/variable.go +++ /dev/null @@ -1,120 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import ( - "fmt" - - "github.com/islisp-dev/iris/core" -) - -// Setq represents an assignment to the variable denoted by the identifier. In -// consequence, the identifier may designate a different object than before, the -// value of form. The result of the evaluation of form is returned. This result -// is used to modify the variable binding denoted by the identifier var (if it -// is mutable). setq can be used only for modifying bindings, and not for -// establishing a variable. The setq special form must be contained in the scope -// of var , established by defglobal, let, let*, for, or a lambda expression. -func Setq(e core.Environment, var1, form core.Instance) (core.Instance, core.Instance) { - ret, err := Eval(e, form) - if err != nil { - return nil, err - } - if e.Variable.Set(var1, ret) { - return ret, nil - } - return SignalCondition(e, core.NewUnboundVariable(e, var1), Nil) -} - -func Setf(e core.Environment, var1, form core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.SymbolClass, var1) { - return Setq(e, var1, form) - } - if !core.InstanceOf(core.ListClass, var1) { - return SignalCondition(e, core.NewParseError(e, var1, core.ListClass), Nil) - } - funcSpec := core.NewSymbol(fmt.Sprintf("(SETF %v)", var1.(core.List).Nth(0))) - fun, ok := e.Function.Get(funcSpec) - if !ok { - return SignalCondition(e, core.NewUndefinedFunction(e, funcSpec), Nil) - } - arguments, err := evalArguments(e, core.NewCons(form, var1.(*core.Cons).Cdr)) - if err != nil { - return nil, err - } - return fun.(core.Applicable).Apply(e, arguments.(core.List).Slice()...) -} - -// Let is used to define a scope for a group of identifiers for a sequence of -// forms body-form* (collectively referred to as the body). The list of pairs -// (var form)* is called the let variable list. The scope of the identifier var -// is the body. The forms are evaluated sequentially from left to right; then -// each variable denoted by the identifier var is initialized to the -// corresponding value. Using these bindings along with the already existing -// bindings of visible identifiers the body-forms are evaluated. The returned -// value of let is the result of the evaluation of the last body-form of its -// body (or nil if there is none). No var may appear more than once in let -// variable list. - -func Let(e core.Environment, varForm core.Instance, bodyForm ...core.Instance) (core.Instance, core.Instance) { - if !Rep(Tpl(Sym(), Any))(varForm) { - return SignalCondition(e, core.NewDomainError(e, varForm, core.ListClass), Nil) - } - vfs := map[core.Instance]core.Instance{} - for _, cadr := range varForm.(core.List).Slice() { - if err := ensure(e, core.ListClass, cadr); err != nil { - return nil, err - } - if cadr.(core.List).Length() != 2 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - f, err := Eval(e, cadr.(core.List).Nth(1)) - if err != nil { - return nil, err - } - vfs[cadr.(core.List).Nth(0)] = f - } - for v, f := range vfs { - if !e.Variable.Define(v, f) { - return SignalCondition(e, core.NewImmutableBinding(e), Nil) - } - } - return Progn(e, bodyForm...) -} - -// LetStar form is used to define a scope for a group of identifiers for a -// sequence of forms body-form* (collectively referred to as the body). The -// first subform (the let* variable list) is a list of pairs (var form). The -// scope of an identifier var is the body along with all form forms following -// the pair (var form) in the let* variable list. For each pair (var form) the -// following is done: form is evaluated in the context of the bindings in effect -// at that point in the evaluation. The result of the evaluation is bound to its -// associated variable named by the identifier var . These variable bindings -// enlarge the set of current valid identifiers perhaps shadowing previous -// variable bindings (in case some var was defined outside), and in this -// enlarged or modified eironment the body-forms are executed. The returned -// value of let* is the result of the evaluation of the last form of its body -// (or nil if there is none). -func LetStar(e core.Environment, varForm core.Instance, bodyForm ...core.Instance) (core.Instance, core.Instance) { - if !Rep(Tpl(Sym(), Any))(varForm) { - return SignalCondition(e, core.NewDomainError(e, varForm, core.ListClass), Nil) - } - for _, cadr := range varForm.(core.List).Slice() { - if err := ensure(e, core.ListClass, cadr); err != nil { - return nil, err - } - if cadr.(core.List).Length() != 2 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - f, err := Eval(e, cadr.(core.List).Nth(1)) - if err != nil { - return nil, err - } - if !e.Variable.Define(cadr.(core.List).Nth(0), f) { - return SignalCondition(e, core.NewImmutableBinding(e), Nil) - } - } - return Progn(e, bodyForm...) -} diff --git a/lib/vector.go b/lib/vector.go deleted file mode 100644 index 15220dc..0000000 --- a/lib/vector.go +++ /dev/null @@ -1,59 +0,0 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. - -package lib - -import "github.com/islisp-dev/iris/core" - -// BasicVectorP returns t if obj is a basic-vector (instance of class -// basic-vector); otherwise, returns nil. obj may be any ISLISP object. -func BasicVectorP(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.BasicVectorClass, obj) { - return T, nil - } - return Nil, nil -} - -// GeneralVectorP returns t if obj is a general-vector (instance of class -// general-vector); otherwise, returns nil. obj may be any ISLISP object. -func GeneralVectorP(e core.Environment, obj core.Instance) (core.Instance, core.Instance) { - if core.InstanceOf(core.GeneralVectorClass, obj) { - return T, nil - } - return Nil, nil -} - -// CreateVector returns a general-vector of length i. If initial-element is -// given, the elements of the new vector are initialized with this object, -// otherwise the initialization is implementation defined. An error shall be -// signaled if the requested vector cannot be allocated (error-id. -// cannot-create-vector). An error shall be signaled if i is not a non-negative -// integer (error-id. domain-error). initial-element may be any ISLISP object. -func CreateVector(e core.Environment, i core.Instance, initialElement ...core.Instance) (core.Instance, core.Instance) { - if !core.InstanceOf(core.IntegerClass, i) || int(i.(core.Integer)) < 0 { - return SignalCondition(e, core.NewDomainError(e, i, core.IntegerClass), Nil) - } - if len(initialElement) > 1 { - return SignalCondition(e, core.NewArityError(e), Nil) - } - n := int(i.(core.Integer)) - v := make([]core.Instance, n) - for i := 0; i < n; i++ { - if len(initialElement) == 0 { - v[i] = Nil - } else { - v[i] = initialElement[0] - } - } - return core.GeneralVector(v), nil -} - -// Vector returns a new general-vector whose elements are its obj arguments. The -// length of the newly created vector is, therefore, the number of objs passed -// as arguments. The vector is indexed by integers ranging from 0 to -// dimension−1. An error shall be signaled if the requested vector cannot be -// allocated (error-id. cannot-create-vector). Each obj may be any ISLISP object. -func Vector(e core.Environment, obj ...core.Instance) (core.Instance, core.Instance) { - return core.GeneralVector(obj), nil -} diff --git a/lib/vector_test.go b/lib/vector_test.go deleted file mode 100644 index 22cca56..0000000 --- a/lib/vector_test.go +++ /dev/null @@ -1,52 +0,0 @@ -package lib - -import "testing" - -func TestBasicVectorP(t *testing.T) { - execTests(t, BasicVectorP, []test{ - { - exp: ` - (mapcar (lambda (x) - (list (basic-vector-p x) - (general-vector-p x))) - '((a b c) - "abc" - #(a b c) - #1a(a b c) - #2a((a) (b) (c)))) - `, - want: `'((nil nil) (t nil) (t t) (t t) (nil nil))`, - wantErr: false, - }, - }) -} - -func TestCreateVector(t *testing.T) { - execTests(t, CreateVector, []test{ - { - exp: `(create-vector 3 17)`, - want: `#(17 17 17)`, - wantErr: false, - }, - { - exp: `(create-vector 2 #\a)`, - want: `#(#\a #\a)`, - wantErr: false, - }, - }) -} - -func TestVector(t *testing.T) { - execTests(t, Vector, []test{ - { - exp: `(vector 'a 'b 'c)`, - want: `#(a b c)`, - wantErr: false, - }, - { - exp: `(vector)`, - want: `#()`, - wantErr: false, - }, - }) -} diff --git a/logo.png b/logo.png new file mode 100644 index 0000000..4014416 Binary files /dev/null and b/logo.png differ diff --git a/main.go b/main.go index 9098ae9..af31857 100644 --- a/main.go +++ b/main.go @@ -1,85 +1,23 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. package main import ( - "flag" "fmt" - "os" - golang "runtime" - "github.com/islisp-dev/iris/core" - "github.com/islisp-dev/iris/lib" + "github.com/ta2gch/iris/runtime" ) -var commit string - -func repl(quiet bool) { - if !quiet { - if commit == "" { - commit = "HEAD" - } - fmt.Printf("Iris ISLisp Interpreter Commit %v on %v\n", commit, golang.Version()) - fmt.Printf("Copyright 2017 islisp-dev All Rights Reserved.\n") - fmt.Print(">>> ") - } - lib.TopLevel.StandardInput = core.NewStream(os.Stdin, nil, core.CharacterClass) - lib.TopLevel.StandardOutput = core.NewStream(nil, os.Stdout, core.CharacterClass) - lib.TopLevel.ErrorOutput = core.NewStream(nil, os.Stderr, core.CharacterClass) - for exp, err := lib.Read(lib.TopLevel); err == nil; exp, err = lib.Read(lib.TopLevel) { - ret, err := lib.Eval(lib.TopLevel, exp) - if err != nil { - fmt.Println(err) - } else { - fmt.Println(ret) - } - if !quiet { - fmt.Print(">>> ") - } - } -} - -func script(path string) { - file, err := os.Open(path) - if err != nil { - return - } - defer file.Close() - lib.TopLevel.StandardInput = core.NewStream(file, nil, core.CharacterClass) - lib.TopLevel.StandardOutput = core.NewStream(nil, os.Stdout, core.CharacterClass) - lib.TopLevel.ErrorOutput = core.NewStream(nil, os.Stderr, core.CharacterClass) - for { - exp, err := lib.Read(lib.TopLevel) - if err != nil { - if fmt.Sprint(err) != "#" { - fmt.Println(err) - } - return - } - _, err = lib.Eval(lib.TopLevel, exp) +func main() { + fmt.Print("> ") + for exp, err := runtime.Read(runtime.TopLevel); err == nil; exp, err = runtime.Read(runtime.TopLevel) { + ret, err := runtime.Eval(runtime.TopLevel, exp) if err != nil { fmt.Println(err) - return } + fmt.Println(ret) + fmt.Print("> ") } } - -func main() { - flag.Parse() - if flag.NArg() > 0 { - script(flag.Arg(0)) - return - } - info, err := os.Stdin.Stat() - if err != nil { - panic(err) - } - if (info.Mode() & os.ModeNamedPipe) == 0 { - repl(false) - return - } - repl(true) - return -} diff --git a/reader/parser/array.go b/reader/parser/array.go index a0747ff..d706392 100644 --- a/reader/parser/array.go +++ b/reader/parser/array.go @@ -1,27 +1,30 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. package parser -import "github.com/islisp-dev/iris/core" +import ( + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/instance" +) -func list2array(dim int, list core.Instance) (core.Instance, core.Instance) { +func list2array(dim int, list ilos.Instance) (ilos.Instance, ilos.Instance) { if dim == 0 { - return core.NewGeneralArrayStar(nil, list), nil + return instance.NewGeneralArrayStar(nil, list), nil } - car, cdr, arrays := core.Nil, list, []*core.GeneralArrayStar{} - for core.InstanceOf(core.ConsClass, cdr) { - car, cdr = cdr.(*core.Cons).Car, cdr.(*core.Cons).Cdr - array, err := list2array(dim-1, car) + elements := list.(instance.List).Slice() + arrays := make([]instance.GeneralArrayStar, len(elements)) + for idx, elt := range elements { + array, err := list2array(dim-1, elt) if err != nil { return nil, err } - arrays = append(arrays, array.(*core.GeneralArrayStar)) + arrays[idx] = array.(instance.GeneralArrayStar) } - return core.NewGeneralArrayStar(arrays, nil), nil + return instance.NewGeneralArrayStar(arrays, nil), nil } -func list2vector(list core.Instance) (core.Instance, core.Instance) { - return core.NewGeneralVector(list.(core.List).Slice()), nil +func list2vector(list ilos.Instance) (ilos.Instance, ilos.Instance) { + return instance.NewGeneralVector(list.(instance.List).Slice()), nil } diff --git a/reader/parser/parser.go b/reader/parser/parser.go index ace616b..38ba374 100644 --- a/reader/parser/parser.go +++ b/reader/parser/parser.go @@ -1,6 +1,6 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. package parser @@ -10,125 +10,105 @@ import ( "strconv" "strings" - "github.com/islisp-dev/iris/reader/tokenizer" - "github.com/islisp-dev/iris/core" + "github.com/ta2gch/iris/reader/tokenizer" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" ) -var eop = core.NewSymbol("End Of Parentheses") -var bod = core.NewSymbol("Begin Of Dot") +var eop = instance.NewSymbol("End Of Parentheses") +var bod = instance.NewSymbol("Begin Of Dot") -func ParseAtom(e core.Environment, tok *tokenizer.Token) (core.Instance, core.Instance) { - str := tok.Str +func ParseAtom(tok string) (ilos.Instance, ilos.Instance) { // // integer // - if m, _ := regexp.MatchString("^[-+]?[[:digit:]]+$", str); m { - n, _ := strconv.ParseInt(str, 10, 64) - return core.NewInteger(int(n)), nil + if m, _ := regexp.MatchString("^[-+]?[[:digit:]]+$", tok); m { + n, _ := strconv.ParseInt(tok, 10, 64) + return instance.NewInteger(int(n)), nil } - if r := regexp.MustCompile("^#[bB]([-+]?[01]+)$").FindStringSubmatch(str); len(r) >= 2 { + if r := regexp.MustCompile("^#[bB]([-+]?[01]+)$").FindStringSubmatch(tok); len(r) >= 2 { n, _ := strconv.ParseInt(r[1], 2, 64) - return core.NewInteger(int(n)), nil + return instance.NewInteger(int(n)), nil } - if r := regexp.MustCompile("^#[oO]([-+]?[0-7]+)$").FindStringSubmatch(str); len(r) >= 2 { + if r := regexp.MustCompile("^#[oO]([-+]?[0-7]+)$").FindStringSubmatch(tok); len(r) >= 2 { n, _ := strconv.ParseInt(r[1], 8, 64) - return core.NewInteger(int(n)), nil + return instance.NewInteger(int(n)), nil } - if r := regexp.MustCompile("^#[xX]([-+]?[[:xdigit:]]+)$").FindStringSubmatch(str); len(r) >= 2 { + if r := regexp.MustCompile("^#[xX]([-+]?[[:xdigit:]]+)$").FindStringSubmatch(tok); len(r) >= 2 { n, _ := strconv.ParseInt(r[1], 16, 64) - return core.NewInteger(int(n)), nil + return instance.NewInteger(int(n)), nil } // // float // - if m, _ := regexp.MatchString(`^[-+]?[[:digit:]]+\.[[:digit:]]+$`, str); m { - n, _ := strconv.ParseFloat(str, 64) - return core.NewFloat(n), nil + if m, _ := regexp.MatchString(`^[-+]?[[:digit:]]+\.[[:digit:]]+$`, tok); m { + n, _ := strconv.ParseFloat(tok, 64) + return instance.NewFloat(n), nil } - if r := regexp.MustCompile(`^([-+]?[[:digit:]]+(?:\.[[:digit:]]+)?)[eE]([-+]?[[:digit:]]+)$`).FindStringSubmatch(str); len(r) >= 3 { + if r := regexp.MustCompile(`^([-+]?[[:digit:]]+(?:\.[[:digit:]]+)?)[eE]([-+]?[[:digit:]]+)$`).FindStringSubmatch(tok); len(r) >= 3 { n, _ := strconv.ParseFloat(r[1], 64) e, _ := strconv.ParseInt(r[2], 10, 64) - return core.NewFloat(n * math.Pow10(int(e))), nil + return instance.NewFloat(n * math.Pow10(int(e))), nil } // // character // - if m, _ := regexp.MatchString(`^#\\newline$`, strings.ToLower(str)); m { - return core.NewCharacter('\n'), nil + if m, _ := regexp.MatchString(`^#\\newline$`, strings.ToLower(tok)); m { + return instance.NewCharacter('\n'), nil } - if m, _ := regexp.MatchString(`^#\\space$`, strings.ToLower(str)); m { - return core.NewCharacter(' '), nil + if m, _ := regexp.MatchString(`^#\\space$`, strings.ToLower(tok)); m { + return instance.NewCharacter(' '), nil } - if r := regexp.MustCompile(`^#\\([[:graph:]])$`).FindStringSubmatch(str); len(r) >= 2 { - return core.NewCharacter(rune(r[1][0])), nil + if r := regexp.MustCompile(`^#\\([[:graph:]])$`).FindStringSubmatch(tok); len(r) >= 2 { + return instance.NewCharacter(rune(r[1][0])), nil } // // string // - if r := regexp.MustCompile(`^"(.*)"$`).FindStringSubmatch(str); len(r) >= 2 { - s := strings.Replace(r[1], "\\\\", "\\", -1) - return core.NewString([]rune(s)), nil + if r := regexp.MustCompile(`^"(.*)"$`).FindStringSubmatch(tok); len(r) >= 2 { + return instance.NewString(r[1]), nil } // // symbol // - if str == "nil" || str == "NIL" { - return core.Nil, nil - } - re := `^(` - re += `[:&](?:[a-zA-Z]|-)+|` - re += `\|.*\||` - re += `\+|-|1\+|1-|` - re += `[a-zA-Z<>/*=?_!$%[\]^{}~][-a-zA-Z0-9+<>/*=?_!$%[\]^{}~]*|` - re += `)$` - if m, _ := regexp.MatchString(re, str); m { - return core.NewSymbol(strings.ToUpper(str), tok.Line, tok.Column), nil - } - return core.SignalCondition( - e, - core.NewParseError( - e, - core.NewString([]rune(str)), - core.ObjectClass, - ), - core.Nil, - ) + if "nil" == tok { + return instance.Nil, nil + } + str := `^(` + str += `[:&][a-zA-Z]+|` + str += `\|.*\||` + str += `\+|-|1\+|1-|` + str += `[a-zA-Z<>/*=?_!$%[\]^{}~][-a-zA-Z0-9+<>/*=?_!$%[\]^{}~]*|` + str += `)$` + if m, _ := regexp.MatchString(str, tok); m { + return instance.NewSymbol(strings.ToUpper(tok)), nil + } + return nil, instance.NewParseError(instance.NewString(tok), class.Object) } -func parseMacro(e core.Environment, tok *tokenizer.Token, t *tokenizer.BufferedTokenReader) (core.Instance, core.Instance) { - str := tok.Str - cdr, err := Parse(e, t) +func parseMacro(tok string, t *tokenizer.Tokenizer) (ilos.Instance, ilos.Instance) { + cdr, err := Parse(t) if err != nil { return nil, err } - n := str - if m, _ := regexp.MatchString("#[[:digit:]]+[aA]", str); m { - i := strings.IndexRune(strings.ToLower(str), 'a') + n := tok + if m, _ := regexp.MatchString("#[[:digit:]]+[aA]", tok); m { + i := strings.IndexRune(strings.ToLower(tok), 'a') var v int64 = 1 if i != 1 { var err error - v, err = strconv.ParseInt(str[1:i], 10, 64) + v, err = strconv.ParseInt(tok[1:i], 10, 64) if err != nil { - return core.SignalCondition( - e, - core.NewParseError( - e, - core.NewString([]rune(str)), - core.IntegerClass, - ), - core.Nil, - ) + return nil, instance.NewParseError(instance.NewString(tok), class.Integer) } } - if int(v) == 1 { - return list2vector(cdr) - } return list2array(int(v), cdr) } - if str == "#" { + if tok == "#" { return list2vector(cdr) } - switch str { + switch tok { case "#'": n = "FUNCTION" case ",@": @@ -140,20 +120,20 @@ func parseMacro(e core.Environment, tok *tokenizer.Token, t *tokenizer.BufferedT case "`": n = "QUASIQUOTE" } - m := core.NewSymbol(n, tok.Line, tok.Line) - return core.NewCons(m, core.NewCons(cdr, core.Nil)), nil + m := instance.NewSymbol(n) + return instance.NewCons(m, instance.NewCons(cdr, instance.Nil)), nil } -func parseCons(e core.Environment, t *tokenizer.BufferedTokenReader) (core.Instance, core.Instance) { - car, err := Parse(e, t) +func parseCons(t *tokenizer.Tokenizer) (ilos.Instance, ilos.Instance) { + car, err := Parse(t) if err == eop { - return core.Nil, nil + return instance.Nil, nil } if err == bod { - cdr, err := Parse(e, t) + cdr, err := Parse(t) if err != nil { return nil, err } - if _, err := Parse(e, t); err != eop { + if _, err := Parse(t); err != eop { return nil, err } return cdr, nil @@ -161,50 +141,50 @@ func parseCons(e core.Environment, t *tokenizer.BufferedTokenReader) (core.Insta if err != nil { return nil, err } - cdr, err := parseCons(e, t) + cdr, err := parseCons(t) if err != nil { return nil, err } - return core.NewCons(car, cdr), nil + return instance.NewCons(car, cdr), nil } // Parse builds a internal expression from tokens -func Parse(e core.Environment, t *tokenizer.BufferedTokenReader) (core.Instance, core.Instance) { - tok, err := t.ReadToken() +func Parse(t *tokenizer.Tokenizer) (ilos.Instance, ilos.Instance) { + tok, err := t.Next() if err != nil { - return core.SignalCondition(e, core.NewEndOfStream(e), core.Nil) + return nil, err } - str := tok.Str - for (len(str) > 2 && str[:2] == "#|") || str[:1] == ";" { - tok, err = t.ReadToken() - if err != nil { - return core.SignalCondition(e, core.NewEndOfStream(e), core.Nil) + /* + for tok[:2] != "#|" || tok[:1] != ";" { + tok, err = t.Next() + if err != nil { + return nil, err + } } - str = tok.Str - } - if str == "(" { - cons, err := parseCons(e, t) + */ + if tok == "(" { + cons, err := parseCons(t) if err != nil { return nil, err } return cons, err } - if str == ")" { + if tok == ")" { return nil, eop } - if str == "." { + if tok == "." { return nil, bod } - if mat, _ := regexp.MatchString("^(?:#'|,@?|'|`|#[[:digit:]]*[aA]|#)$", str); mat { - m, err := parseMacro(e, tok, t) + if mat, _ := regexp.MatchString("^(?:#'|,@?|'|`|#[[:digit:]]*[aA]|#)$", tok); mat { + m, err := parseMacro(tok, t) if err != nil { return nil, err } return m, nil } - atom, err1 := ParseAtom(e, tok) - if err1 != nil { - return nil, err1 + atom, err := ParseAtom(tok) + if err != nil { + return nil, err } return atom, nil } diff --git a/reader/parser/parser_test.go b/reader/parser/parser_test.go index da7afa4..1713454 100644 --- a/reader/parser/parser_test.go +++ b/reader/parser/parser_test.go @@ -1,6 +1,6 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. package parser @@ -8,8 +8,8 @@ import ( "reflect" "testing" - "github.com/islisp-dev/iris/reader/tokenizer" - "github.com/islisp-dev/iris/core" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/instance" ) func Test_parseAtom(t *testing.T) { @@ -19,7 +19,7 @@ func Test_parseAtom(t *testing.T) { tests := []struct { name string arguments arguments - want core.Instance + want ilos.Instance wantErr bool }{ // @@ -28,31 +28,31 @@ func Test_parseAtom(t *testing.T) { { name: "default", arguments: arguments{"3.14"}, - want: core.NewFloat(3.14), + want: instance.NewFloat(3.14), wantErr: false, }, { name: "signed", arguments: arguments{"-5.0"}, - want: core.NewFloat(-5.0), + want: instance.NewFloat(-5.0), wantErr: false, }, { name: "exponential", arguments: arguments{"-5.0E3"}, - want: core.NewFloat(-5.0 * 1000), + want: instance.NewFloat(-5.0 * 1000), wantErr: false, }, { name: "signed exponential", arguments: arguments{"5.0E-3"}, - want: core.NewFloat(5.0 * 1.0 / 1000.0), + want: instance.NewFloat(5.0 * 1.0 / 1000.0), wantErr: false, }, { name: "without point", arguments: arguments{"5E-3"}, - want: core.NewFloat(5.0 * 1.0 / 1000.0), + want: instance.NewFloat(5.0 * 1.0 / 1000.0), wantErr: false, }, { @@ -73,49 +73,49 @@ func Test_parseAtom(t *testing.T) { { name: "default", arguments: arguments{"5"}, - want: core.NewInteger(5), + want: instance.NewInteger(5), wantErr: false, }, { name: "signed", arguments: arguments{"-5"}, - want: core.NewInteger(-5), + want: instance.NewInteger(-5), wantErr: false, }, { name: "binary", arguments: arguments{"#B00101"}, - want: core.NewInteger(5), + want: instance.NewInteger(5), wantErr: false, }, { name: "signed binary", arguments: arguments{"#b+00101"}, - want: core.NewInteger(5), + want: instance.NewInteger(5), wantErr: false, }, { name: "octal", arguments: arguments{"#o00101"}, - want: core.NewInteger(65), + want: instance.NewInteger(65), wantErr: false, }, { name: "signed octal", arguments: arguments{"#O-00101"}, - want: core.NewInteger(-65), + want: instance.NewInteger(-65), wantErr: false, }, { name: "hexadecimal", arguments: arguments{"#X00101"}, - want: core.NewInteger(257), + want: instance.NewInteger(257), wantErr: false, }, { name: "signed hexadecimal", arguments: arguments{"#x-00101"}, - want: core.NewInteger(-257), + want: instance.NewInteger(-257), wantErr: false, }, { @@ -130,19 +130,19 @@ func Test_parseAtom(t *testing.T) { { name: "default", arguments: arguments{"#\\a"}, - want: core.NewCharacter('a'), + want: instance.NewCharacter('a'), wantErr: false, }, { name: "newline", arguments: arguments{"#\\newline"}, - want: core.NewCharacter('\n'), + want: instance.NewCharacter('\n'), wantErr: false, }, { name: "space", arguments: arguments{"#\\space"}, - want: core.NewCharacter(' '), + want: instance.NewCharacter(' '), wantErr: false, }, { @@ -154,9 +154,7 @@ func Test_parseAtom(t *testing.T) { } for _, tt := range tests { t.Run(tt.name, func(t *testing.T) { - env := core.NewEnvironment(nil, nil, nil, core.DefaultHandler) - tok := tokenizer.NewToken(tt.arguments.tok, -1, -1) - got, err := ParseAtom(env, tok) + got, err := ParseAtom(tt.arguments.tok) if (err != nil) != tt.wantErr { t.Errorf("parseAtom() error = %v, wantErr %v", err, tt.wantErr) return diff --git a/reader/tokenizer/tokenizer.go b/reader/tokenizer/tokenizer.go index b290452..9772da4 100644 --- a/reader/tokenizer/tokenizer.go +++ b/reader/tokenizer/tokenizer.go @@ -1,129 +1,70 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + package tokenizer import ( "bufio" "io" "regexp" - "strings" - "github.com/dlclark/regexp2" + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" ) -// BufferedTokenReader interface type is the interface +// Tokenizer interface type is the interface // for reading string with every token -// BufferedTokenReader is like bufio.BufferedTokenReader but has PeekRune -// which returns a rune without advancing pointer -type BufferedTokenReader struct { - line, column int - Raw io.Reader - *bufio.Reader +type Tokenizer struct { + sc *bufio.Scanner } -// NewBufferedTokenReader creates interal reader from io.RuneReader -func NewBufferedTokenReader(r io.Reader) *BufferedTokenReader { - return &BufferedTokenReader{1, 0, r, bufio.NewReader(r)} -} +var re *regexp.Regexp -func (t *BufferedTokenReader) ReadRune() (r rune, size int, err error) { - r, size, err = t.Reader.ReadRune() - if r == '\n' { - t.line++ - t.column = 0 - } else { - t.column++ - } - return +func Tokenize(r io.Reader) *Tokenizer { + str := `` + str += `1\+|1-|` + str += `[-+]?[[:digit:]]+\.[[:digit:]]+|` + str += `[-+]?[[:digit:]]+(?:\.[[:digit:]]+)?[eE][-+]?[[:digit:]]+|` + str += `[-+]?[[:digit:]]+|` + str += `#[bB][-+]?[01]+|` + str += `#[oO][-+]?[0-7]+|` + str += `#[xX][-+]?[[:xdigit:]]+|` + str += `#\\[[:alpha:]]+|` + str += `#\\[[:graph:]]|` + str += `"(?:\\\\|\\"|[^"])*"|` + str += `[:&][a-zA-Z]+|` + str += `\+|-|[a-zA-Z<>/*=?_!$%[\]^{}~][-a-zA-Z0-9+<>/*=?_!$%[\]^{}~]*|` + str += `\|(?:\\\\|\\\||[^|])*\||` + str += `[.()]|` + str += "#'|,@?|'|`|#[[:digit:]]*[aA]|#" // TODO: hangs at #ab or #3 + re = regexp.MustCompile(str) + sc := bufio.NewScanner(r) + sc.Split(splitter) + return &Tokenizer{sc} } -var str = `^1\+$|^1-$|` + - `^[-+]?[[:digit:]]+\.[[:digit:]]+$|` + - `^[-+]?[[:digit:]]+(?:\.[[:digit:]]+)?[eE][-+]?[[:digit:]]+$|` + - `^[-+]?[[:digit:]]+$|` + - `^#[bB][-+]?[01]*$|` + - `^#[oO][-+]?[0-7]*$|` + - `^#[xX][-+]?[[:xdigit:]]*$|` + - `^#\\[[:alpha:]]*$|` + - `^#\\[[:graph:]]?$|` + - `^"(?:\\\\|\\.|[^\\"])*"$|` + - `^[:&](?:[a-zA-Z]|-)+$|` + - `^\+$|^-$|^[a-zA-Z<>/*=?_!$%[\]^{}~][-a-zA-Z0-9+<>/*=?_!$%[\]^{}~]*$|` + - `^\|(?:\\\\|\\.|[^\\|])*\|$|` + - `^[.()]$|` + - "^;[^\n]*$|" + - `^#\|((?); +// otherwise, returns nil. obj may be any ISLISP object. +func BasicArrayStarP(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class.BasicArrayStar, obj) { + return T, nil + } + return Nil, nil +} + +// GeneralArrayStarP returns t if obj is a general-array* (instance of class ); +// otherwise, returns nil. obj may be any ISLISP object. +func GeneralArrayStarP(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class.GeneralArrayStar, obj) { + return T, nil + } + return Nil, nil +} + +// CreateArray creates an array of the given dimensions. The dimensions argument is a list of +// non-negative integers. +// +// The result is of class general-vector if there is only one dimension, or of class +// otherwise. +// +// If initial-element is given, the elements of the new array are initialized with this object, +// otherwise the initialization is implementation defined. +// +// An error shall be signaled if the requested array cannot be allocated +// (error-id. cannot-create-array). +// +// An error shall be signaled if dimensions is not a proper list of non-negative integers +// (error-id. domain-error). initial-element may be any ISLISP object +func CreateArray(e env.Environment, dimensions ilos.Instance, initialElement ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.List, dimensions); err != nil { + return nil, err + } + if err := ensure(class.Integer, dimensions.(instance.List).Slice()...); err != nil { + return nil, err + } + dim := dimensions.(instance.List).Slice() + elt := Nil + if len(initialElement) > 1 { + return nil, instance.NewArityError() + } + if len(initialElement) == 1 { + elt = initialElement[0] + } + if len(dim) == 0 { + return instance.NewGeneralArrayStar(nil, elt), nil + } + array := make([]instance.GeneralArrayStar, int(dim[0].(instance.Integer))) + for i := range array { + d, err := List(e, dim[1:]...) + if err != nil { + return nil, err + } + a, err := CreateArray(e, d, elt) + if err != nil { + return nil, err + } + array[i] = a.(instance.GeneralArrayStar) + } + return instance.NewGeneralArrayStar(array, nil), nil +} + +// Aref returns the object stored in the component of the basic-array specified by the sequence +// of integers z. This sequence must have exactly as many elements as there are dimensions in +// the basic-array, and each one must satisfy 0 ≤ zi < di , di the ith dimension and 0 ≤ i < d, +// d the number of dimensions. Arrays are indexed 0 based, so the ith row is accessed via the +// index i − 1. +// +// An error shall be signaled if basic-array is not a basic-array (error-id. domain-error). +// An error shall be signaled if any z is not a non-negative integer (error-id. domain-error). +func Aref(e env.Environment, basicArray ilos.Instance, dimensions ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.BasicArray, basicArray); err != nil { + return nil, err + } + if err := ensure(class.Integer, dimensions...); err != nil { + return nil, err + } + switch { + case ilos.InstanceOf(class.String, basicArray): + if len(dimensions) != 1 { + return nil, instance.NewArityError() + } + index := int(dimensions[0].(instance.Integer)) + if len(basicArray.(instance.String)) <= index { + return nil, instance.NewIndexOutOfRange() + } + return instance.NewCharacter(basicArray.(instance.String)[index]), nil + case ilos.InstanceOf(class.GeneralVector, basicArray): + if len(dimensions) != 1 { + return nil, instance.NewArityError() + } + index := int(dimensions[0].(instance.Integer)) + if len(basicArray.(instance.GeneralVector)) <= index { + return nil, instance.NewIndexOutOfRange() + } + return basicArray.(instance.GeneralVector)[index], nil + default: // General Array* + return Garef(e, basicArray, dimensions...) + } +} + +// Garef is like aref but an error shall be signaled if its first argument, general-array, is +// not an object of class general-vector or of class (error-id. domain-error). +func Garef(e env.Environment, generalArray ilos.Instance, dimensions ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.GeneralArrayStar, generalArray); err != nil { + return nil, err + } + if err := ensure(class.Integer, dimensions...); err != nil { + return nil, err + } + var array instance.GeneralArrayStar + for _, dim := range dimensions { + index := int(dim.(instance.Integer)) + if array.Vector == nil || len(array.Vector) <= index { + return nil, instance.NewIndexOutOfRange() + } + array = array.Vector[index] + } + if array.Scalar == nil { + return nil, instance.NewIndexOutOfRange() + } + return array.Scalar, nil +} + +// SetAref replaces the object obtainable by aref or garef with obj . The returned value is obj. +// The constraints on the basic-array, the general-array, and the sequence of indices z is the +// same as for aref and garef. +func SetAref(e env.Environment, obj, basicArray ilos.Instance, dimensions ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.BasicArray, basicArray); err != nil { + return nil, err + } + if err := ensure(class.Integer, dimensions...); err != nil { + return nil, err + } + switch { + case ilos.InstanceOf(class.String, basicArray): + if err := ensure(class.Character, obj); err != nil { + return nil, err + } + if len(dimensions) != 1 { + return nil, instance.NewArityError() + } + index := int(dimensions[0].(instance.Integer)) + if len(basicArray.(instance.String)) <= index { + return nil, instance.NewIndexOutOfRange() + } + basicArray.(instance.String)[index] = rune(obj.(instance.Character)) + return obj, nil + case ilos.InstanceOf(class.GeneralVector, basicArray): + if len(dimensions) != 1 { + return nil, instance.NewArityError() + } + index := int(dimensions[0].(instance.Integer)) + if len(basicArray.(instance.GeneralVector)) <= index { + return nil, instance.NewIndexOutOfRange() + } + basicArray.(instance.GeneralVector)[index] = obj + return obj, nil + default: // General Array* + return SetGaref(e, obj, basicArray, dimensions...) + } +} + +// SetGaref replaces the object obtainable by aref or garef with obj . The returned value is obj. +// The constraints on the basic-array, the general-array, and the sequence of indices z is the +// same as for aref and garef. +func SetGaref(e env.Environment, obj, generalArray ilos.Instance, dimensions ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.GeneralArrayStar, generalArray); err != nil { + return nil, err + } + if err := ensure(class.Integer, dimensions...); err != nil { + return nil, err + } + var array instance.GeneralArrayStar + for _, dim := range dimensions { + index := int(dim.(instance.Integer)) + if array.Vector == nil || len(array.Vector) <= index { + return nil, instance.NewIndexOutOfRange() + } + array = array.Vector[index] + } + if array.Scalar == nil { + return nil, instance.NewIndexOutOfRange() + } + array.Scalar = obj + return obj, nil +} + +// ArrayDimensions returns a list of the dimensions of a given basic-array. +// An error shall be signaled if basic-array is not a basic-array (error-id. domain-error). +// The consequences are undefined if the returned list is modified. +func ArrayDimensions(e env.Environment, basicArray ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.BasicArray, basicArray); err != nil { + return nil, err + } + switch { + case ilos.InstanceOf(class.String, basicArray): + return List(e, instance.NewInteger(len(basicArray.(instance.String)))) + case ilos.InstanceOf(class.GeneralVector, basicArray): + return List(e, instance.NewInteger(len(basicArray.(instance.GeneralVector)))) + default: // General Array* + var array instance.GeneralArrayStar + dimensions := []ilos.Instance{} + for array.Vector != nil { + dimensions = append(dimensions, instance.NewInteger(len(array.Vector))) + array = array.Vector[0] + } + return List(e, dimensions...) + } +} diff --git a/runtime/boolean.go b/runtime/boolean.go new file mode 100644 index 0000000..8b36520 --- /dev/null +++ b/runtime/boolean.go @@ -0,0 +1,34 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// The values t and nil are called booleans. t denotes true, +// and nil is the only value denoting false. Predicates, +// also called boolean functions, are functions that return +// t when satisfied and nil otherwise. +// +// Any object other than nil is treated as true (not just t). +// When objects are treated as true or nil this way they are +// called quasi-booleans. +// +// t is an identifier naming the symbol t, and nil is +// an identifier naming the symbol nil (which is also the empty list). +// nil is the unique instance of the null class. +// +// Like boolean functions, the and and or special forms return truth values; +// however, these truth values are nil when the test is not +// satisfied and a non-nil value otherwise. +// The result of and and or are quasi-booleans. +// +// t is a named constant whose value is the symbol t itself. +// nil is a named constant whose value is the symbol nil itself. +var ( + Nil = instance.Nil + T = instance.NewSymbol("T") +) diff --git a/runtime/character.go b/runtime/character.go new file mode 100644 index 0000000..af40fe0 --- /dev/null +++ b/runtime/character.go @@ -0,0 +1,90 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// Characterp returns t if obj is a character (instance of class character); +// otherwise, returns nil. obj may be any ISLISP object. +func Characterp(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class.Character, obj) { + return T, nil + } + return Nil, nil +} + +// CharEqual tests whether char1 is the same character as char2. +func CharEqual(e env.Environment, char1, char2 ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Character, char1, char2); err != nil { + return nil, err + } + if char1 == char2 { + return T, nil + } + return Nil, nil +} + +// CharNotEqual if and only if they are not char=. +func CharNotEqual(e env.Environment, char1, char2 ilos.Instance) (ilos.Instance, ilos.Instance) { + ret, err := CharEqual(e, char1, char2) + if err != nil { + return nil, err + } + return Not(e, ret) +} + +// CharGreaterThan tests whether char1 is greater than char2. +// An error shall be signaled if either char1 or char2 is not a character (error-id. domain-error). +func CharGreaterThan(e env.Environment, char1, char2 ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Character, char1, char2); err != nil { + return nil, err + } + if char1.(instance.Character) > char2.(instance.Character) { + return T, nil + } + return Nil, nil +} + +// CharGreaterThanOrEqual tests whether char1 is greater than or equal to char2. +// An error shall be signaled if either char1 or char2 is not a character (error-id. domain-error). +func CharGreaterThanOrEqual(e env.Environment, char1, char2 ilos.Instance) (ilos.Instance, ilos.Instance) { + gt, err := CharGreaterThan(e, char1, char2) + if err != nil { + return nil, err + } + eq, err := CharEqual(e, char1, char2) + if err != nil { + return nil, err + } + if gt == Nil && eq == Nil { + return Nil, nil + } + return T, nil +} + +// CharLessThan tests whether char1 is less than char2. +// An error shall be signaled if either char1 or char2 is not a character (error-id. domain-error). +func CharLessThan(e env.Environment, char1, char2 ilos.Instance) (ilos.Instance, ilos.Instance) { + gt, err := CharGreaterThanOrEqual(e, char1, char2) + if err != nil { + return nil, err + } + return Not(e, gt) +} + +// CharLessThanOrEqual tests whether char1 is less than or equal to char2. +// An error shall be signaled if either char1 or char2 is not a character (error-id. domain-error). +func CharLessThanOrEqual(e env.Environment, char1, char2 ilos.Instance) (ilos.Instance, ilos.Instance) { + gt, err := CharGreaterThan(e, char1, char2) + if err != nil { + return nil, err + } + return Not(e, gt) +} diff --git a/runtime/class.go b/runtime/class.go new file mode 100644 index 0000000..fbf126b --- /dev/null +++ b/runtime/class.go @@ -0,0 +1,286 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "fmt" + "reflect" + + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +func ClassOf(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + return obj.Class(), nil +} + +func Instancep(e env.Environment, obj ilos.Instance, class ilos.Class) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class, obj) { + return T, nil + } + return Nil, nil +} + +func Subclassp(e env.Environment, class1, class2 ilos.Class) (ilos.Instance, ilos.Instance) { + if ilos.SubclassOf(class1, class2) { + return T, nil + } + return Nil, nil +} + +func Class(e env.Environment, className ilos.Instance) (ilos.Class, ilos.Instance) { + if v, ok := e.Class[:1].Get(className); ok { + return v.(ilos.Class), nil + } + return nil, instance.NewUndefinedClass(className) +} + +func checkSuperClass(a, b ilos.Class) bool { + if reflect.DeepEqual(a, class.StandardObject) || reflect.DeepEqual(b, class.StandardObject) { + return false + } + if ilos.SubclassOf(a, b) || ilos.SubclassOf(b, a) { + return true + } + for _, c := range a.Supers() { + if checkSuperClass(c, b) { + return true + } + } + for _, c := range b.Supers() { + if checkSuperClass(a, c) { + return true + } + } + return false +} + +func Defclass(e env.Environment, className, scNames, slotSpecs ilos.Instance, classOpts ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Symbol, className); err != nil { + return nil, err + } + if err := ensure(class.List, scNames, slotSpecs); err != nil { + return nil, err + } + supers := []ilos.Class{class.StandardObject} + for _, scName := range scNames.(instance.List).Slice() { + super, err := Class(e, scName) + if err != nil { + return nil, err + } + for _, before := range supers { + if checkSuperClass(before, super) { + return nil, instance.NewArityError() + } + } + supers = append(supers, super.(ilos.Class)) + } + slots := []ilos.Instance{} + initforms := map[ilos.Instance]ilos.Instance{} + initargs := map[ilos.Instance]ilos.Instance{} + for _, slotSpec := range slotSpecs.(instance.List).Slice() { + if ilos.InstanceOf(class.Symbol, slotSpec) { + slotName := slotSpec + slots = append(slots, slotName) + continue + } + slotName := slotSpec.(*instance.Cons).Car + slots = append(slots, slotName) + slotOpts := slotSpec.(*instance.Cons).Cdr.(instance.List).Slice() + for i := 0; i < len(slotOpts); i += 2 { + switch slotOpts[i] { + case instance.NewSymbol(":INITFORM"): + closure, err := newNamedFunction(e, instance.NewSymbol("CLOSURE"), Nil, slotOpts[i+1]) + if err != nil { + return nil, err + } + initforms[slotName] = closure + case instance.NewSymbol(":INITARG"): + initargs[slotOpts[i+1]] = slotName + } + } + } + metaclass := class.StandardClass + abstractp := Nil + for _, classOpt := range classOpts { + var err ilos.Instance + switch classOpt.(*instance.Cons).Car { + case instance.NewSymbol(":METACLASS"): + if metaclass, err = Class(e, classOpt.(instance.List).Nth(1)); err != nil { + return nil, err + } + case instance.NewSymbol(":ABSTRACTP"): + if abstractp, err = Eval(e, classOpt.(instance.List).Nth(1)); err != nil { + return nil, err + } + } + } + classObject := instance.NewStandardClass(className, supers, slots, initforms, initargs, metaclass, abstractp) + e.Class[:1].Define(className, classObject) + for _, slotSpec := range slotSpecs.(instance.List).Slice() { + if ilos.InstanceOf(class.Symbol, slotSpec) { + continue + } + slotName := slotSpec.(*instance.Cons).Car + slotOpts := slotSpec.(*instance.Cons).Cdr.(instance.List).Slice() + var readerFunctionName, writerFunctionName, boundpFunctionName ilos.Instance + for i := 0; i < len(slotOpts); i += 2 { + switch slotOpts[i] { + case instance.NewSymbol(":READER"): + readerFunctionName = slotOpts[i+1] + case instance.NewSymbol(":WRITER"): + writerFunctionName = slotOpts[i+1] + case instance.NewSymbol(":ACCESSOR"): + readerFunctionName = slotOpts[i+1] + writerFunctionName = instance.NewSymbol(fmt.Sprintf("(SETF %v)", slotOpts[i+1])) + case instance.NewSymbol(":BOUNDP"): + boundpFunctionName = slotOpts[i+1] + } + } + if readerFunctionName != nil { + lambdaList, err := List(e, instance.NewSymbol("INSTANCE")) + if err != nil { + return nil, err + } + if g, ok := e.Function.Get(readerFunctionName); !ok || !ilos.InstanceOf(class.GenericFunction, g) { + Defgeneric(e, readerFunctionName, lambdaList) + } + fun, _ := e.Function.Get(readerFunctionName) + fun.(*instance.GenericFunction).AddMethod(nil, lambdaList, []ilos.Class{classObject}, instance.NewFunction(readerFunctionName, func(e env.Environment, object ilos.Instance) (ilos.Instance, ilos.Instance) { + slot, ok := object.(instance.Instance).GetSlotValue(slotName, classObject) + if ok { + return slot, nil + } + return Nil, nil // TODO: shoud throw an error. + })) + } + if writerFunctionName != nil { + lambdaList, err := List(e, instance.NewSymbol("Y"), instance.NewSymbol("X")) + if err != nil { + return nil, err + } + if g, ok := e.Function.Get(writerFunctionName); !ok || !ilos.InstanceOf(class.GenericFunction, g) { + Defgeneric(e, writerFunctionName, lambdaList) + } + fun, _ := e.Function.Get(writerFunctionName) + fun.(*instance.GenericFunction).AddMethod(nil, lambdaList, []ilos.Class{class.Object, classObject}, instance.NewFunction(writerFunctionName, func(e env.Environment, obj, object ilos.Instance) (ilos.Instance, ilos.Instance) { + ok := object.(instance.Instance).SetSlotValue(obj, slotName, classObject) + if ok { + return obj, nil + } + return Nil, nil + })) + } + if boundpFunctionName != nil { + lambdaList, err := List(e, instance.NewSymbol("INSTANCE")) + if err != nil { + return nil, err + } + if g, ok := e.Function.Get(boundpFunctionName); !ok || !ilos.InstanceOf(class.GenericFunction, g) { + Defgeneric(e, boundpFunctionName, lambdaList) + } + fun, _ := e.Function.Get(boundpFunctionName) + fun.(*instance.GenericFunction).AddMethod(nil, lambdaList, []ilos.Class{classObject}, instance.NewFunction(boundpFunctionName, func(e env.Environment, object ilos.Instance) (ilos.Instance, ilos.Instance) { + _, ok := object.(instance.Instance).GetSlotValue(slotName, classObject) + if ok { + return T, nil + } + return Nil, nil + })) + } + } + return className, nil +} + +func Create(e env.Environment, c ilos.Instance, i ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.StandardClass, c); err != nil { + return nil, err + } + return instance.Create(e, c, i...), nil +} + +func InitializeObject(e env.Environment, object ilos.Instance, inits ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.StandardObject, object); err != nil { + return nil, err + } + return instance.InitializeObject(e, object, inits...), nil +} + +func Defmethod(e env.Environment, arguments ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if len(arguments) < 2 { + return nil, instance.NewArityError() + } + name := arguments[0] + var qualifier ilos.Instance + i := 0 + if arguments[1] == instance.NewSymbol(":AROUND") || arguments[1] == instance.NewSymbol(":BEFORE") || arguments[1] == instance.NewSymbol(":AFTER") { + qualifier = arguments[1] + i++ + } + parameterList := []ilos.Instance{} + for _, pp := range arguments[i+1].(instance.List).Slice() { + if ilos.InstanceOf(class.Symbol, pp) { + parameterList = append(parameterList, pp) + } else { + parameterList = append(parameterList, pp.(instance.List).Nth(0)) + } + } + lambdaList, err := List(e, parameterList...) + if err != nil { + return nil, err + } + classList := []ilos.Class{} + for _, pp := range arguments[i+1].(instance.List).Slice() { + if pp == instance.NewSymbol(":REST") && pp == instance.NewSymbol("&REST") { + break + } + if ilos.InstanceOf(class.Symbol, pp) { + classList = append(classList, class.Object) + } else { + class, ok := e.Class[:1].Get(pp.(instance.List).Nth(1)) + if !ok { + return nil, instance.NewUndefinedClass(pp.(instance.List).Nth(1)) + } + classList = append(classList, class.(ilos.Class)) + } + } + fun, err := newNamedFunction(e, name, lambdaList, arguments[i+2:]...) + if err != nil { + return nil, err + } + gen, ok := e.Function[:1].Get(name) + if !ok { + return nil, instance.NewUndefinedFunction(name) + } + if !gen.(*instance.GenericFunction).AddMethod(qualifier, lambdaList, classList, fun) { + return nil, instance.NewUndefinedFunction(name) + } + return name, nil +} + +func Defgeneric(e env.Environment, funcSpec, lambdaList ilos.Instance, optionsOrMethodDescs ...ilos.Instance) (ilos.Instance, ilos.Instance) { + var methodCombination ilos.Instance + genericFunctionClass := class.StandardGenericFunction + forms := []ilos.Instance{} + for _, optionOrMethodDesc := range optionsOrMethodDescs { + switch optionOrMethodDesc.(instance.List).Nth(0) { + case instance.NewSymbol(":METHOD-COMBINATION"): + methodCombination = optionOrMethodDesc.(instance.List).Nth(1) + case instance.NewSymbol(":GENERIC-FUNCTION-CLASS"): + class, ok := e.Class[:1].Get(optionOrMethodDesc.(instance.List).Nth(1)) + if !ok { + return nil, instance.NewUndefinedClass(optionOrMethodDesc.(instance.List).Nth(1)) + } + genericFunctionClass = class.(ilos.Class) + case instance.NewSymbol(":METHOD"): + forms = append(forms, instance.NewCons(instance.NewSymbol("DEFMETHOD"), optionOrMethodDesc.(instance.List).NthCdr(1))) + } + } + e.Function[:1].Define(funcSpec, instance.NewGenericFunction(funcSpec, lambdaList, methodCombination, genericFunctionClass)) + Progn(e, forms...) + return funcSpec, nil +} diff --git a/lib/class_test.go b/runtime/class_test.go similarity index 90% rename from lib/class_test.go rename to runtime/class_test.go index c11d5ff..11110fe 100644 --- a/lib/class_test.go +++ b/runtime/class_test.go @@ -1,8 +1,8 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. -package lib +package runtime import "testing" diff --git a/runtime/condition.go b/runtime/condition.go new file mode 100644 index 0000000..bfdd9d4 --- /dev/null +++ b/runtime/condition.go @@ -0,0 +1,99 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +func SignalCondition(e env.Environment, condition, continuable ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.SeriousCondition, condition); err != nil { + return nil, err + } + condition.(instance.Instance).SetSlotValue(instance.NewSymbol("IRIS.CONTINUABLE"), continuable, class.SeriousCondition) + _, c := e.Handler.(instance.Applicable).Apply(e, condition) + if ilos.InstanceOf(class.Continue, c) { + o, _ := c.(instance.Instance).GetSlotValue(instance.NewSymbol("IRIS.OBJECT"), class.Continue) + return o, nil + } + return nil, c +} + +func Cerror(e env.Environment, continueString, errorString ilos.Instance, objs ...ilos.Instance) (ilos.Instance, ilos.Instance) { + arguments, err := List(e, objs...) + if err != nil { + return nil, err + } + condition := instance.Create(e, class.SimpleError, instance.NewSymbol("FORMAT-STRING"), errorString, instance.NewSymbol("FORAMT-OBJECTS"), arguments) + ss, err := CreateStringOutputStream(e) + if err != nil { + return nil, err + } + if _, err := Format(e, ss, continueString, objs...); err != nil { + return nil, err + } + continuable, err := GetOutputStreamString(e, ss) + if err != nil { + return nil, err + } + return SignalCondition(e, condition, continuable) +} + +func Error(e env.Environment, continueString, errorString ilos.Instance, objs ...ilos.Instance) (ilos.Instance, ilos.Instance) { + arguments, err := List(e, objs...) + if err != nil { + return nil, err + } + condition := instance.Create(e, class.SimpleError, instance.NewSymbol("FORMAT-STRING"), errorString, instance.NewSymbol("FORAMT-OBJECTS"), arguments) + return SignalCondition(e, condition, Nil) +} + +func IgnoreError(e env.Environment, forms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + ret, err := Progn(e, forms...) + if err != nil && ilos.InstanceOf(class.Error, err) { + return Nil, nil + } + return ret, err +} + +func ReportCondition(e env.Environment, condition, stream ilos.Instance) (ilos.Instance, ilos.Instance) { + return Format(e, e.StandardOutput, instance.NewString("~A"), condition) +} + +func ConditionContinuable(e env.Environment, condition ilos.Instance) (ilos.Instance, ilos.Instance) { + if continuable, ok := condition.(instance.Instance).GetSlotValue(instance.NewSymbol("IRIS.CONTINUABLE"), class.SeriousCondition); ok { + return continuable, nil + } + return Nil, nil +} + +func ContinueCondition(e env.Environment, condition ilos.Instance, value ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if b, ok := condition.(instance.Instance).GetSlotValue(instance.NewSymbol("IRIS.CONTINUABLE"), class.SeriousCondition); !ok || b == Nil { + return nil, instance.Create(e, class.ProgramError) + } + if len(value) == 1 { + return nil, instance.Create(e, class.Continue, instance.NewSymbol("IRIS.OBJECT"), value[0]) + } + if len(value) == 0 { + return nil, instance.Create(e, class.Continue, instance.NewSymbol("IRIS.OBJECT"), Nil) + } + return nil, instance.Create(e, class.ProgramError) +} + +func WithHandler(e env.Environment, handler ilos.Instance, forms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + fun, err := Eval(e, handler) + if err != nil { + return nil, err + } + e.Handler = fun + ret, err := Progn(e, forms...) + if err != nil { + return nil, err + } + return ret, err +} diff --git a/lib/condition_test.go b/runtime/condition_test.go similarity index 80% rename from lib/condition_test.go rename to runtime/condition_test.go index 59f04df..335a3de 100644 --- a/lib/condition_test.go +++ b/runtime/condition_test.go @@ -1,8 +1,8 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. -package lib +package runtime import "testing" diff --git a/runtime/conditional.go b/runtime/conditional.go new file mode 100644 index 0000000..84fb15b --- /dev/null +++ b/runtime/conditional.go @@ -0,0 +1,153 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// If is conditional expression. +// The test-form is evaluated. If its result is anything non-nil, +// the then-form is evaluated and its value is returned; +// otherwise (if the test-form returned nil), the else-form +// is evaluated and its value is returned. +// +// If no else-form is provided, it defaults to nil. +func If(e env.Environment, testForm, thenForm ilos.Instance, elseForm ...ilos.Instance) (ilos.Instance, ilos.Instance) { + tf, err := Eval(e, testForm) + if err != nil { + return nil, err + } + if tf == T { + return Eval(e, thenForm) + } + if len(elseForm) > 1 { + return nil, instance.NewArityError() + } + if len(elseForm) == 0 { + return Nil, nil + } + return Eval(e, elseForm[0]) +} + +// Cond the clauses (test form*) are scanned sequentially +// and in each case the test is evaluated; when a test delivers a non-nil value +// the scanning process stops and all forms associated with the corresponding clause +//are sequentially evaluated and the value of the last one is returned. +// If no test is true, then nil is returned. +// If no form exists for the successful test then the value of this test is returned. +func Cond(e env.Environment, testFrom ...ilos.Instance) (ilos.Instance, ilos.Instance) { + for _, tf := range testFrom { + if err := ensure(class.List, tf); err != nil { + return nil, err + } + s := tf.(instance.List).Slice() + if len(s) == 0 { + return nil, instance.NewArityError() + } + ret, err := Eval(e, s[0]) + if err != nil { + return nil, err + } + if ret == T { + return Progn(e, s[1:]...) + } + } + return Nil, nil +} + +// Case special form, called case form, provide a mechanism +// to execute a matching clause from a series of clauses based on the value of a dispatching form keyform. +// +// The clause to be executed is identified by a set of keys. A key can be any object. +// If the keylist of the last clause is t the associated clause is executed if no key matches the keyform. +// +// keyform is a form to be computed at the beginning of execution of the case form. +// If the result of evaluating keyform is equivalent to a key, then the forms, if any, +// in the corresponding clause are evaluated sequentially and the value of the last one +// is returned as value of the whole case form. case determines match equivalence by using eql; +// the value returned by keyform and key. If no form exists for a matching key, the case form evaluates to nil. +// If the value of keyform is different from every key, and there is a default clause, its forms, if any, +// are evaluated sequentially, and the value of the last one is the result of the case form. +func Case(e env.Environment, key ilos.Instance, pattern ...ilos.Instance) (ilos.Instance, ilos.Instance) { + key, err := Eval(e, key) + if err != nil { + return nil, err + } + for idx, pat := range pattern { + if err := ensure(class.List, pat); err != nil { + return nil, err + } + form := pat.(instance.List).Slice() + if len(form) < 1 { + return nil, instance.NewArityError() + } + if idx == len(pattern)-1 && form[0] == T { + return Progn(e, form[1:]...) + } + if err := ensure(class.List, form[0]); err != nil { + return nil, err + } + for _, k := range form[0].(instance.List).Slice() { + if k == key { + return Progn(e, form[1:]...) + } + } + } + return Nil, nil +} + +// CaseUsing special form, called case forms, provide a mechanism +// to execute a matching clause from a series of clauses based on the value of a dispatching form keyform. +// +// The clause to be executed is identified by a set of keys. A key can be any object. +// If the keylist of the last clause is t the associated clause is executed if no key matches the keyform. +// +// keyform is a form to be computed at the beginning of execution of the case form. +// If the result of evaluating keyform is equivalent to a key, then the forms, if any, +// in the corresponding clause are evaluated sequentially and the value of the last one +// is returned as value of the whole case form. +// case-using match determines equivalence by using the result of evaluating predform. +// predform must be a boolean or quasi-boolean function that accepts two arguments, +// the value returned by keyform and key. If no form exists for a matching key, the case form evaluates to nil. +// If the value of keyform is different from every key, and there is a default clause, its forms, if any, +// are evaluated sequentially, and the value of the last one is the result of the case form. +func CaseUsing(e env.Environment, key, pred ilos.Instance, pattern ...ilos.Instance) (ilos.Instance, ilos.Instance) { + key, err := Eval(e, key) + if err != nil { + return nil, err + } + if err := ensure(class.Function, pred); err != nil { + return nil, err + } + for idx, pat := range pattern { + if err := ensure(class.List, pat); err != nil { + return nil, err + } + form := pat.(instance.List).Slice() + if len(form) < 1 { + return nil, instance.NewArityError() + } + if idx == len(pattern)-1 && form[0] == T { + return Progn(e, form[1:]...) + } + if err := ensure(class.List, form[0]); err != nil { + return nil, err + } + for _, k := range form[0].(instance.List).Slice() { + ret, err := pred.(instance.Applicable).Apply(e.NewDynamic(), k, key) + if err != nil { + return nil, err + } + if ret != Nil { + return Progn(e, form[1:]...) + } + } + } + return Nil, nil +} diff --git a/runtime/cons.go b/runtime/cons.go new file mode 100644 index 0000000..c17d342 --- /dev/null +++ b/runtime/cons.go @@ -0,0 +1,70 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// Consp returns t if obj is a cons (instance of class cons); +// otherwise, returns nil. obj may be any ISLISP object. +func Consp(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class.Cons, obj) { + return T, nil + } + return Nil, nil +} + +// Cons builds a cons from two objects, with obj1 +// as its car (or `left') part and with obj2 as its cdr (or `right') part. +// An error shall be signaled if the requested cons cannot +// be allocated (error-id. cannot-create-cons). Both obj1 +// and obj2 may be any ISLISP object. +func Cons(e env.Environment, obj1, obj2 ilos.Instance) (ilos.Instance, ilos.Instance) { + return instance.NewCons(obj1, obj2), nil +} + +// Car returns the left component of the cons. +// An error shall be signaled if cons is not a cons (error-id. domain-error). +func Car(e env.Environment, cons ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Cons, cons); err != nil { + return nil, err + } + return cons.(*instance.Cons).Car, nil // Checked at the top of this function +} + +// Cdr returns the right component of the cons. +// An error shall be signaled if cons is not a cons (error-id. domain-error). +func Cdr(e env.Environment, cons ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Cons, cons); err != nil { + return nil, err + } + return cons.(*instance.Cons).Cdr, nil // Checked at the top of this function +} + +// SetCar updates the left component of cons with obj. The returned value is obj . +// An error shall be signaled if cons is not a cons (error-id. domain-error). +// obj may be any ISLISP object. +func SetCar(e env.Environment, obj, cons ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Cons, cons); err != nil { + return nil, err + } + cons.(*instance.Cons).Car = obj + return obj, nil +} + +// SetCdr updates the right component of cons with obj. The returned value is obj . +// An error shall be signaled if cons is not a cons (error-id. domain-error). +// obj may be any ISLISP object. +func SetCdr(e env.Environment, obj, cons ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Cons, cons); err != nil { + return nil, err + } + cons.(*instance.Cons).Cdr = obj + return obj, nil +} diff --git a/runtime/constants.go b/runtime/constants.go new file mode 100644 index 0000000..7334a0e --- /dev/null +++ b/runtime/constants.go @@ -0,0 +1,16 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" +) + +// Quote is used to include any object in an ISLisp text. +// A quoted expression denotes a reference to an object. +func Quote(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + return obj, nil +} diff --git a/runtime/define.go b/runtime/define.go new file mode 100644 index 0000000..4d21c87 --- /dev/null +++ b/runtime/define.go @@ -0,0 +1,101 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// Defconstant is used to define a named constant in the variable namespace of the current toplevel +// scope. The scope of name is the entire current toplevel scope except the body form. +// +// Although name is globally constant, a variable binding for name can be ely established by a +// binding form. +// +// The result of the evaluation of form is bound to the variable named by name. The binding and +// the object created as the result of evaluating the second argument are immutable. The symbol named +// name is returned. +func Defconstant(e env.Environment, name, form ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Symbol, name); err != nil { + return nil, err + } + if _, ok := e.Constant[:1].Get(name); ok { + return nil, instance.NewImmutableBinding() + } + ret, err := Eval(e, form) + if err != nil { + return nil, err + } + e.Constant[:1].Define(name, ret) + return name, nil +} + +// Defglobal is used to define an identifier in the variable namespace of the current toplevel scope. +// The scope of name is the entire current toplevel scope except the body form. +// +// form is evaluated to compute an initializing value for the variable named name. Therefore, +// defglobal is used only for defining variables and not for modifying them. The symbol named name is +// returned. +// +// A lexical variable binding for name can still be ely established by a binding form; in that +// case, the e binding lexically shadows the outer binding of name defined by defe. +func Defglobal(e env.Environment, name, form ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Symbol, name); err != nil { + return nil, err + } + if _, ok := e.Constant[:1].Get(name); ok { + return nil, instance.NewImmutableBinding() + } + ret, err := Eval(e, form) + if err != nil { + return nil, err + } + e.Variable[:1].Define(name, ret) + return name, nil +} + +// Defdynamic is used to define a dynamic variable identifier in the dynamic variable namespace. +// The scope of name is the entire current toplevel scope except the body form. +// +//The symbol named name is returned. +func Defdynamic(e env.Environment, name, form ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Symbol, name); err != nil { + return nil, err + } + if _, ok := e.Constant[:1].Get(name); ok { + return nil, instance.NewImmutableBinding() + } + ret, err := Eval(e, form) + if err != nil { + return nil, err + } + e.DynamicVariable[:1].Define(name, ret) + return name, nil +} + +// Defun defines function-name as an identifier in the function namespace; function-name is +// bound to a function object equivalent to (lambda lambda-list form*). +// +// The scope of function-name is the whole current toplevel scope. Therefore, the definition of a +// function admits recursion, occurrences of function-name within the form* refer to the function +// being defined. The binding between function-name and the function object is immutable. +// +// defun returns the function name which is the symbol named function-name. The free identifiers in +// the body form* (i.e., those which are not contained in the lambda list) follow the rules of lexical +// scoping. +func Defun(e env.Environment, functionName, lambdaList ilos.Instance, forms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Symbol, functionName); err != nil { + return nil, err + } + ret, err := newNamedFunction(e, functionName, lambdaList, forms...) + if err != nil { + return nil, err + } + e.Function[:1].Define(functionName, ret) + return functionName, nil +} diff --git a/lib/define_test.go b/runtime/define_test.go similarity index 92% rename from lib/define_test.go rename to runtime/define_test.go index eacd1f2..b581ec3 100644 --- a/lib/define_test.go +++ b/runtime/define_test.go @@ -1,8 +1,8 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. -package lib +package runtime import "testing" diff --git a/runtime/dynamic.go b/runtime/dynamic.go new file mode 100644 index 0000000..1bd95ac --- /dev/null +++ b/runtime/dynamic.go @@ -0,0 +1,102 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// Dynamic denotes a reference to the identifier denoting a +// dynamic variable. This special form is not allowed in the scope of a +// definition of var which is not done by defdynamic or dynamic-let. +// +// During activation, the current dynamic binding of the variable var is +// returned that was established most recently and is still in effect. An +// error shall be signaled if such a binding does not exist +// (error-id. unbound-variable). +func Dynamic(e env.Environment, var1 ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Symbol, var1); err != nil { + return nil, err + } + if v, ok := e.DynamicVariable.Get(var1); ok { + return v, nil + } + if v, ok := e.DynamicVariable.Get(var1); ok { + return v, nil + } + return nil, instance.NewUndefinedVariable(var1) +} + +// SetDynamic denotes an assignment to a dynamic variable. This +// form can appear anywhere that (dynamic var) can appear. +// +// form is evaluated and the result of the evaluation is used to change +// the dynamic binding of var. +// +// An error shall be signaled if var has no dynamic value +// (error-id. unbound-variable). setf of dynamic can be used only for +// modifying bindings, and not for establishing them. +func SetDynamic(e env.Environment, form, var1 ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Symbol, var1); err != nil { + return nil, err + } + form, err := Eval(e, form) + if err != nil { + return nil, form + } + if e.DynamicVariable.Set(var1, form) { + return form, nil + } + if e.DynamicVariable.Set(var1, form) { + return form, nil + } + return nil, instance.NewUndefinedVariable(var1) +} + +// DynamicLet is used to establish dynamic variable bindings. +// The first subform (the dynamic-let variable list) is a list of pairs (var +// form). The scope of an identifier var defined by dynamic-let is the current +// toplevel scope. The extent of the bindings of each var is the extent of the +// body of the dynamic-let. The dynamic-let special form establishes dynamic +// variables for all vars. +// +// References to a dynamic variable named by var must be made through the +// dynamic special form. +// +// All the initializing forms are evaluated sequentially from left to right, and +// then the values are associated with the corresponding vars. Using these +// additional dynamic bindings and the already existing bindings of visible +// identifiers, the forms body-form* are evaluated in sequential order. The +// returned value of dynamic-let is that of the last body-form of the body (or +// nil if there is none). The bindings are undone when control leaves the +// prepared dynamic-let special form. +func DynamicLet(e env.Environment, varForm ilos.Instance, bodyForm ...ilos.Instance) (ilos.Instance, ilos.Instance) { + vfs := map[ilos.Instance]ilos.Instance{} + if err := ensure(class.List, varForm); err != nil { + return nil, err + } + for _, cadr := range varForm.(instance.List).Slice() { + if err := ensure(class.List, cadr); err != nil { + return nil, err + } + if cadr.(instance.List).Length() != 2 { + return nil, instance.NewArityError() + } + f, err := Eval(e, cadr.(instance.List).Nth(1)) + if err != nil { + return nil, err + } + vfs[cadr.(instance.List).Nth(0)] = f + } + for v, f := range vfs { + if !e.DynamicVariable.Define(v, f) { + return nil, instance.NewImmutableBinding() + } + } + return Progn(e, bodyForm...) +} diff --git a/runtime/env/environment.go b/runtime/env/environment.go new file mode 100644 index 0000000..c998ab0 --- /dev/null +++ b/runtime/env/environment.go @@ -0,0 +1,154 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package env + +import ( + "github.com/ta2gch/iris/runtime/ilos" +) + +// Environment struct is the struct for keeping functions and variables +type Environment struct { + // Lexical + BlockTag stack + TagbodyTag stack + Function stack + Variable stack + + // Global + Class stack + Macro stack + Special stack + Property map2 + GensymID int + Constant stack + + // Dynamic + CatchTag stack + DynamicVariable stack // deep biding + StandardInput ilos.Instance + StandardOutput ilos.Instance + ErrorOutput ilos.Instance + Handler ilos.Instance +} + +// New creates new eironment +func NewEnvironment(stdin, stdout, stderr, handler ilos.Instance) Environment { + e := new(Environment) + + // Lexical + e.BlockTag = NewStack() + e.TagbodyTag = NewStack() + e.Function = NewStack() + e.Variable = NewStack() + + // Global + e.Macro = NewStack() + e.Class = NewStack() + e.Special = NewStack() + e.Constant = NewStack() + e.Property = NewMap2() + e.GensymID = 0 + + // Dynamic + e.CatchTag = NewStack() + e.DynamicVariable = NewStack() + e.StandardInput = stdin + e.StandardOutput = stdout + e.ErrorOutput = stderr + e.Handler = handler + return *e +} + +func (e *Environment) MergeLexical(before Environment) { + e.BlockTag = append(before.BlockTag, e.BlockTag[1:]...) + e.TagbodyTag = append(before.TagbodyTag, e.TagbodyTag[1:]...) + e.Variable = append(before.Variable, e.Variable[1:]...) + e.Function = append(before.Function, e.Function[1:]...) + + e.Macro = append(before.Macro, e.Macro[1:]...) + e.Class = append(before.Class, e.Class[1:]...) + e.Special = append(before.Special, e.Special[1:]...) + e.Constant = append(before.Constant, e.Constant[1:]...) + e.Property = before.Property + e.GensymID = before.GensymID + + e.CatchTag = append(before.CatchTag, e.CatchTag[1:]...) + e.DynamicVariable = append(before.DynamicVariable, e.DynamicVariable[1:]...) + e.StandardInput = before.StandardInput + e.StandardOutput = before.StandardOutput + e.ErrorOutput = before.ErrorOutput + e.Handler = before.Handler +} + +func (e *Environment) MergeDynamic(before Environment) { + e.BlockTag = append(stack{before.BlockTag[0]}, e.BlockTag[1:]...) + e.TagbodyTag = append(stack{before.TagbodyTag[0]}, e.TagbodyTag[1:]...) + e.Variable = append(stack{before.Variable[0]}, e.Variable[1:]...) + e.Function = append(stack{before.Function[0]}, e.Function[1:]...) + + e.Macro = append(stack{before.Macro[0]}, e.Macro[1:]...) + e.Class = append(stack{before.Class[0]}, e.Class[1:]...) + e.Special = append(stack{before.Special[0]}, e.Special[1:]...) + e.Constant = append(stack{before.Constant[0]}, e.Constant[1:]...) + e.Property = before.Property + e.GensymID = before.GensymID + + e.CatchTag = append(before.CatchTag, e.CatchTag[1:]...) + e.DynamicVariable = append(before.DynamicVariable, e.DynamicVariable[1:]...) + e.StandardInput = before.StandardInput + e.StandardOutput = before.StandardOutput + e.ErrorOutput = before.ErrorOutput + e.Handler = before.Handler +} + +func (before *Environment) NewLexical() Environment { + e := NewEnvironment(before.StandardInput, before.StandardOutput, before.ErrorOutput, before.Handler) + + e.BlockTag = append(before.BlockTag, e.BlockTag[0]) + e.TagbodyTag = append(before.TagbodyTag, e.TagbodyTag[0]) + e.Variable = append(before.Variable, e.Variable[0]) + e.Function = append(before.Function, e.Function[0]) + + e.Macro = append(before.Macro, e.Macro[0]) + e.Class = append(before.Class, e.Class[0]) + e.Special = append(before.Special, e.Special[0]) + e.Constant = append(before.Constant, e.Constant[0]) + e.Property = before.Property + e.GensymID = before.GensymID + + e.CatchTag = append(before.CatchTag, e.CatchTag[0]) + e.DynamicVariable = append(before.DynamicVariable, e.DynamicVariable[0]) + e.StandardInput = before.StandardInput + e.StandardOutput = before.StandardOutput + e.ErrorOutput = before.ErrorOutput + e.Handler = before.Handler + + return e +} + +func (before *Environment) NewDynamic() Environment { + e := NewEnvironment(before.StandardInput, before.StandardOutput, before.ErrorOutput, before.Handler) + + e.BlockTag = append(stack{before.BlockTag[0]}, e.BlockTag[0]) + e.TagbodyTag = append(stack{before.TagbodyTag[0]}, e.TagbodyTag[0]) + e.Variable = append(stack{before.Variable[0]}, e.Variable[0]) + e.Function = append(stack{before.Function[0]}, e.Function[0]) + + e.Macro = append(stack{before.Macro[0]}, e.Macro[0]) + e.Class = append(stack{before.Class[0]}, e.Class[0]) + e.Special = append(stack{before.Special[0]}, e.Special[0]) + e.Constant = append(stack{before.Constant[0]}, e.Constant[0]) + e.Property = before.Property + e.GensymID = before.GensymID + + e.CatchTag = append(before.CatchTag, e.CatchTag[0]) + e.DynamicVariable = append(before.DynamicVariable, e.DynamicVariable[0]) + e.StandardInput = before.StandardInput + e.StandardOutput = before.StandardOutput + e.ErrorOutput = before.ErrorOutput + e.Handler = before.Handler + + return e +} diff --git a/runtime/env/map2.go b/runtime/env/map2.go new file mode 100644 index 0000000..697c71e --- /dev/null +++ b/runtime/env/map2.go @@ -0,0 +1,33 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package env + +import ( + "github.com/ta2gch/iris/runtime/ilos" +) + +type map2 map[[2]ilos.Instance]ilos.Instance + +func NewMap2() map2 { + return map[[2]ilos.Instance]ilos.Instance{} +} + +func (s map2) Get(key1, key2 ilos.Instance) (ilos.Instance, bool) { + if v, ok := s[[2]ilos.Instance{key1, key2}]; ok { + return v, true + } + return nil, false +} +func (s map2) Set(key1, key2, value ilos.Instance) { + s[[2]ilos.Instance{key1, key2}] = value +} + +func (s map2) Delete(key1, key2 ilos.Instance) (ilos.Instance, bool) { + if v, ok := s[[2]ilos.Instance{key1, key2}]; ok { + delete(s, [2]ilos.Instance{key1, key2}) + return v, true + } + return nil, false +} diff --git a/runtime/env/stack.go b/runtime/env/stack.go new file mode 100644 index 0000000..c69dea5 --- /dev/null +++ b/runtime/env/stack.go @@ -0,0 +1,43 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package env + +import ( + "github.com/ta2gch/iris/runtime/ilos" +) + +type stack []map[ilos.Instance]ilos.Instance + +func NewStack() stack { + return []map[ilos.Instance]ilos.Instance{map[ilos.Instance]ilos.Instance{}} +} + +func (s stack) Get(key ilos.Instance) (ilos.Instance, bool) { + for i := len(s) - 1; i >= 0; i-- { + if v, ok := s[i][key]; ok { + return v, true + } + } + return nil, false +} + +func (s stack) Set(key, value ilos.Instance) bool { + for i := len(s) - 1; i >= 0; i-- { + if _, ok := s[i][key]; ok { + s[i][key] = value + return true + } + } + return false +} + +func (s stack) Define(key, value ilos.Instance) bool { + if _, ok := s[len(s)-1][key]; !ok { + s[len(s)-1][key] = value + return true + } + s[len(s)-1][key] = value + return false +} diff --git a/runtime/equality.go b/runtime/equality.go new file mode 100644 index 0000000..e8c6b67 --- /dev/null +++ b/runtime/equality.go @@ -0,0 +1,73 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "reflect" + + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" +) + +func isComparable(t reflect.Type) bool { + if t.Comparable() { + if t.Kind() == reflect.Interface { + return false + } + if t.Kind() == reflect.Struct { + for i := 0; i < t.NumField(); i++ { + if !isComparable(t.Field(i).Type) { + return false + } + } + } + return true + } + return false +} + +// Eq tests whether obj1 and obj2 are same identical object. +// They return t if the objects are the same; otherwise, they return nil. +// Two objects are the same if there is no operation that could distinguish +// them (without modifying them), and if modifying one would modify the other the same way. +func Eq(e env.Environment, obj1, obj2 ilos.Instance) (ilos.Instance, ilos.Instance) { + v1, v2 := reflect.ValueOf(obj1), reflect.ValueOf(obj2) + if v1 == v2 || ilos.InstanceOf(class.Symbol, obj1) && ilos.InstanceOf(class.Symbol, obj2) && obj1 == obj2 { + return T, nil + } + return Nil, nil +} + +// Eql tests whether obj1 and obj2 are same identical object. +// They return t if the objects are the same; otherwise, they return nil. +// Two objects are the same if there is no operation that could distinguish +// them (without modifying them), and if modifying one would modify the other the same way. +func Eql(e env.Environment, obj1, obj2 ilos.Instance) (ilos.Instance, ilos.Instance) { + t1, t2 := reflect.TypeOf(obj1), reflect.TypeOf(obj2) + if isComparable(t1) || isComparable(t2) { + if obj1 == obj2 { + return T, nil + } + return Nil, nil + } + v1, v2 := reflect.ValueOf(obj1), reflect.ValueOf(obj2) + if v1 == v2 { + return T, nil + } + return Nil, nil +} + +// Equal tests whether obj1 and obj2 are isomorphic—i.e., whether obj1 and obj2 denote the same +// structure with equivalent values. equal returns t if the test was satisfied, and nil if not. +// Specifically: +// +// If obj1 and obj2 are direct instances of the same class, equal returns t if they are eql. +func Equal(e env.Environment, obj1, obj2 ilos.Instance) (ilos.Instance, ilos.Instance) { + if reflect.DeepEqual(obj1, obj2) { + return T, nil + } + return Nil, nil +} diff --git a/lib/equality_test.go b/runtime/equality_test.go similarity index 94% rename from lib/equality_test.go rename to runtime/equality_test.go index bf8de28..012235c 100644 --- a/lib/equality_test.go +++ b/runtime/equality_test.go @@ -1,8 +1,8 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. -package lib +package runtime import "testing" @@ -40,7 +40,7 @@ func TestEq(t *testing.T) { }, { exp: `(eq 2 2)`, - want: `T`, + want: `nil`, wantErr: false, }, { @@ -122,17 +122,17 @@ func TestEq(t *testing.T) { }, { exp: `(eq #\a #\a)`, - want: `T`, + want: `nil`, wantErr: false, }, { exp: `(eq #\space #\Space)`, - want: `T`, + want: `nil`, wantErr: false, }, { exp: `(eq #\space #\space)`, - want: `T`, + want: `nil`, wantErr: false, }, } @@ -193,7 +193,7 @@ func TestEql(t *testing.T) { }, { exp: `(eql (cons 1 2) (cons 1 2))`, - want: `T`, + want: `nil`, wantErr: false, }, { @@ -203,7 +203,7 @@ func TestEql(t *testing.T) { }, { exp: `(eql '(a) '(a))`, - want: `T`, + want: `nil`, wantErr: false, }, { @@ -212,12 +212,12 @@ func TestEql(t *testing.T) { (y '(a b))) (eql x (cdr y))) `, - want: `T`, + want: `nil`, wantErr: false, }, { exp: `(eql '(b) (cdr '(a b)))`, - want: `T`, + want: `nil`, wantErr: false, }, { diff --git a/runtime/eval.go b/runtime/eval.go new file mode 100644 index 0000000..9d46799 --- /dev/null +++ b/runtime/eval.go @@ -0,0 +1,172 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +func evalArguments(e env.Environment, arguments ilos.Instance) (ilos.Instance, ilos.Instance) { + // if arguments ends here + if arguments == Nil { + return Nil, nil + } + if err := ensure(class.Cons, arguments); err != nil { + return nil, err + } + car := arguments.(*instance.Cons).Car // Checked there + cdr := arguments.(*instance.Cons).Cdr // Checked there + a, err := Eval(e, car) + if err != nil { + return nil, err + } + b, err := evalArguments(e, cdr) + if err != nil { + return nil, err + } + return instance.NewCons(a, b), nil + +} + +func evalLambda(e env.Environment, car, cdr ilos.Instance) (ilos.Instance, ilos.Instance, bool) { + // eval if lambda form + if ilos.InstanceOf(class.Cons, car) { + caar := car.(*instance.Cons).Car // Checked at the top of// This sentence + if caar == instance.NewSymbol("LAMBDA") { + fun, err := Eval(e, car) + if err != nil { + return nil, err, true + } + + arguments, err := evalArguments(e, cdr) + if err != nil { + return nil, err, true + } + ret, err := fun.(instance.Applicable).Apply(e.NewDynamic(), arguments.(instance.List).Slice()...) + if err != nil { + return nil, err, true + } + return ret, nil, true + } + } + return nil, nil, false +} + +func evalSpecial(e env.Environment, car, cdr ilos.Instance) (ilos.Instance, ilos.Instance, bool) { + // get special instance has value of Function interface + var spl ilos.Instance + if s, ok := e.Special.Get(car); ok { + spl = s + } + if spl != nil { + ret, err := spl.(instance.Applicable).Apply(e.NewLexical(), cdr.(instance.List).Slice()...) + if err != nil { + return nil, err, true + } + return ret, nil, true + } + return nil, nil, false +} + +func evalMacro(e env.Environment, car, cdr ilos.Instance) (ilos.Instance, ilos.Instance, bool) { + // get special instance has value of Function interface + var mac ilos.Instance + if m, ok := e.Macro.Get(car); ok { + mac = m + } + if mac != nil { + ret, err := mac.(instance.Applicable).Apply(e.NewDynamic(), cdr.(instance.List).Slice()...) + if err != nil { + return nil, err, true + } + ret, err = Eval(e, ret) + if err != nil { + return nil, err, true + } + return ret, nil, true + } + return nil, nil, false +} + +func evalFunction(e env.Environment, car, cdr ilos.Instance) (ilos.Instance, ilos.Instance, bool) { + // get special instance has value of Function interface + var fun ilos.Instance + if f, ok := e.Function.Get(car); ok { + fun = f + } + if fun != nil { + arguments, err := evalArguments(e, cdr) + if err != nil { + return nil, err, true + } + ret, err := fun.(instance.Applicable).Apply(e.NewDynamic(), arguments.(instance.List).Slice()...) + if err != nil { + return nil, err, true + } + return ret, nil, true + } + return nil, nil, false +} + +func evalCons(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Cons, obj); err != nil { + return nil, err + } + car := obj.(*instance.Cons).Car // Checked at the top of// This function + cdr := obj.(*instance.Cons).Cdr // Checked at the top of// This function + + // eval if lambda form + if a, b, c := evalLambda(e, car, cdr); c { + return a, b + } + // get special instance has value of Function interface + if a, b, c := evalSpecial(e, car, cdr); c { + return a, b + } + // get macro instance has value of Function interface + if a, b, c := evalMacro(e, car, cdr); c { + return a, b + } + // get function instance has value of Function interface + if a, b, c := evalFunction(e, car, cdr); c { + return a, b + } + return nil, instance.NewUndefinedFunction(car) +} + +func evalVariable(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if val, ok := e.Variable.Get(obj); ok { + return val, nil + } + if val, ok := e.Constant.Get(obj); ok { + return val, nil + } + return nil, instance.NewUndefinedVariable(obj) +} + +// Eval evaluates any classs +func Eval(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if obj == Nil { + return Nil, nil + } + if ilos.InstanceOf(class.Symbol, obj) { + ret, err := evalVariable(e, obj) + if err != nil { + return nil, err + } + return ret, nil + } + if ilos.InstanceOf(class.Cons, obj) { + ret, err := evalCons(e, obj) + if err != nil { + return nil, err + } + return ret, nil + } + return obj, nil +} diff --git a/runtime/float.go b/runtime/float.go new file mode 100644 index 0000000..67a3a29 --- /dev/null +++ b/runtime/float.go @@ -0,0 +1,88 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "math" + + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// The value of MostPositiveFloat is the implementation-dependent +// floating-point number closest to positive infinity. +// +// The value of MostNegativeFloat is the implementation-dependent +// floating-point number closest to negative infinity. +var ( + MostPositiveFloat = instance.NewFloat(math.MaxFloat64) + MostNegativeFloat = instance.NewFloat(-math.MaxFloat64) +) + +// Floatp returns t if obj is a float (instance of class float); +// otherwise, returns nil. The obj may be any ISLISP object. +func Floatp(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class.Float, obj) { + return T, nil + } + return Nil, nil +} + +// Float returns x itself if it is an instance of the class float +// and returns a floating-point approximation of x otherwise. +// An error shall be signaled if x is not a number (error-id. domain-error). +func Float(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + f, _, err := convFloat64(x) + if err != nil { + return nil, err + } + return instance.NewFloat(f), nil +} + +// Floor returns the greatest integer less than or equal to x . +// That is, x is truncated towards negative infinity. An error +// shall be signaled if x is not a number (error-id. domain-error). +func Floor(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + f, _, err := convFloat64(x) + if err != nil { + return nil, err + } + return instance.NewInteger(int(math.Floor(f))), nil +} + +// Ceiling Returns the smallest integer that is not smaller than x. +// That is, x is truncated towards positive infinity. An error +// shall be signaled if x is not a number (error-id. domain-error). +func Ceiling(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + f, _, err := convFloat64(x) + if err != nil { + return nil, err + } + return instance.NewInteger(int(math.Ceil(f))), nil +} + +// Truncate returns the integer between 0 and x (inclusive) that is nearest to x. +// That is, x is truncated towards zero. An error shall be signaled +// if x is not a number (error-id. domain-error). +func Truncate(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + f, _, err := convFloat64(x) + if err != nil { + return nil, err + } + return instance.NewInteger(int(math.Trunc(f))), nil +} + +// Round returns the integer nearest to x. +// If x is exactly halfway between two integers, the even one is chosen. +// An error shall be signaled if x is not a number (error-id. domain-error). +func Round(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + f, _, err := convFloat64(x) + if err != nil { + return nil, err + } + return instance.NewInteger(int(math.Floor(f + .5))), nil +} diff --git a/runtime/function.go b/runtime/function.go new file mode 100644 index 0000000..b3b27f0 --- /dev/null +++ b/runtime/function.go @@ -0,0 +1,182 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// Functionp returns t if obj is a (normal or generic) function; +// otherwise, returns nil. obj may be any ISLISP object. +// +// Function bindings are entities established during execution of +// a prepared labels or flet forms or by a function-defining form. +// A function binding is an association between an identifier, function-name, +// and a function object that is denoted by function-name—if in operator +// position—or by (function function-name) elsewhere. +func Functionp(e env.Environment, fun ilos.Instance) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class.Function, fun) { + return T, nil + } + return Nil, nil +} + +// Function returns the function object named by function-name. +// +// An error shall be signaled if no binding has been established for the identifier +// in the function namespace of current lexical eironment (error-id. undefined-function). +// The consequences are undefined if the function-name names a macro or special form +func Function(e env.Environment, fun ilos.Instance) (ilos.Instance, ilos.Instance) { + // car must be a symbol + if err := ensure(class.Symbol, fun); err != nil { + return nil, err + } + if f, ok := e.Function.Get(fun); ok { + return f, nil + } + if f, ok := e.Function.Get(fun); ok { + return f, nil + } + return nil, instance.NewUndefinedFunction(fun) +} + +// Lambda special form creates a function object. +// +// The scope of the identifiers of the lambda-list is the sequence of forms form*, +// collectively referred to as the body. +// +// When the prepared function is activated later (even if transported as object +// to some other activation) with some arguments, the body of the function is +// evaluated as if it was at the same textual position where the lambda special +// form is located, but in a context where the lambda variables are bound +// in the variable namespace with the values of the corresponding arguments. +// A &rest or :rest variable, if any, is bound to the list of the values of +// the remaining arguments. An error shall be signaled if the number of +// arguments received is incompatible with the specified lambda-list +// (error-id. arity-error). +// +// Once the lambda variables have been bound, the body is executed. +// If the body is empty, nil is returned otherwise the result of the evaluation of +// the last form of body is returned if the body was not left by a non-e exit. +// +// If the function receives a &rest or :rest parameter R, the list L1 to which that +// parameter is bound has indefinite extent. L1 is newly allocated unless the function +// was called with apply and R corresponds to the final argument, L2 , to that call +// to apply (or some subtail of L2), in which case it is implementation defined whether +// L1 shares structure with L2 . +func Lambda(e env.Environment, lambdaList ilos.Instance, form ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := checkLambdaList(lambdaList); err != nil { + return nil, err + } + return newNamedFunction(e, instance.NewSymbol("ANONYMOUS-FUNCTION"), lambdaList, form...) +} + +// Labels special form allow the definition of new identifiers in the function +// namespace for function objects. +// +// In a labels special form the scope of an identifier function-name is the whole +// labels special form (excluding nested scopes, if any); for the flet special form, +// the scope of an identifier is only the body-form*. Within these scopes, +// each function-name is bound to a function object whose behavior is equivalent +// to (lambda lambda-list form*), where free identifier references are resolved as follows: +// +// For a labels form, such free references are resolved in the lexical eironment +// that was active immediately outside the labels form augmented by the function +// bindings for the given function-names (i.e., any reference to a function +// function-name refers to a binding created by the labels). +// +// For a flet form, free identifier references in the lambda-expression are resolved +// in the lexical eironment that was active immediately outside the flet form +// (i.e., any reference to a function function-name are not visible). +// +// During activation, the prepared labels or flet establishes function bindings and +// then evaluates each body-form in the body sequentially; the value of the last one +// (or nil if there is none) is the value returned by the special form activation. +// +// No function-name may appear more than once in the function bindings. +func Labels(e env.Environment, functions ilos.Instance, bodyForm ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.List, functions); err != nil { + return nil, err + } + for _, function := range functions.(instance.List).Slice() { + if err := ensure(class.List, function); err != nil { + return nil, err + } + definition := function.(instance.List).Slice() + if len(definition) < 2 { + return nil, instance.NewArityError() + } + functionName := definition[0] + lambdaList := definition[1] + forms := definition[2:] + fun, err := newNamedFunction(e, functionName, lambdaList, forms...) + if err != nil { + return nil, err + } + if !e.Function.Define(functionName, fun) { + return nil, instance.NewImmutableBinding() + } + } + return Progn(e, bodyForm...) +} + +// Flet special form allow the definition of new identifiers in the function +// namespace for function objects (see Labels). +func Flet(e env.Environment, functions ilos.Instance, bodyForm ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.List, functions); err != nil { + return nil, err + } + newEnv := e.NewLexical() + for _, function := range functions.(instance.List).Slice() { + if err := ensure(class.List, function); err != nil { + return nil, err + } + definition := function.(instance.List).Slice() + if len(definition) < 2 { + return nil, instance.NewArityError() + } + functionName := definition[0] + lambdaList := definition[1] + forms := definition[2:] + fun, err := newNamedFunction(e, functionName, lambdaList, forms...) + if err != nil { + return nil, err + } + if !newEnv.Function.Define(functionName, fun) { + return nil, instance.NewImmutableBinding() + } + } + return Progn(newEnv, bodyForm...) +} + +// Apply applies function to the arguments, obj*, followed by the elements of list, +// if any. It returns the value returned by function. +// +// An error shall be signaled if function is not a function (error-id. domain-error). +// Each obj may be any ISLISP object. An error shall be signaled +// if list is not a proper list (error-id. improper-argument-list). +func Apply(e env.Environment, function ilos.Instance, obj ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Function, function); err != nil { + return nil, err + } + if err := ensure(class.List, obj[len(obj)-1]); err != nil { + return nil, err + } + obj = append(obj[:len(obj)-1], obj[len(obj)-1].(instance.List).Slice()...) + return function.(instance.Applicable).Apply(e, obj...) +} + +// Funcall activates the specified function function and returns the value that the function returns. +// The ith argument (2 ≤ i) of funcall becomes the (i − 1)th argument of the function. +// +// An error shall be signaled if function is not a function (error-id. domain-error). +// Each obj may be any ISLISP object. +func Funcall(e env.Environment, function ilos.Instance, obj ...ilos.Instance) (ilos.Instance, ilos.Instance) { + obj = append(obj, Nil) + return Apply(e, function, obj...) +} diff --git a/lib/function_test.go b/runtime/function_test.go similarity index 94% rename from lib/function_test.go rename to runtime/function_test.go index 64570b1..6688299 100644 --- a/lib/function_test.go +++ b/runtime/function_test.go @@ -1,8 +1,8 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. -package lib +package runtime import ( "testing" diff --git a/runtime/ilos/class/class.go b/runtime/ilos/class/class.go new file mode 100644 index 0000000..a365f94 --- /dev/null +++ b/runtime/ilos/class/class.go @@ -0,0 +1,57 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package class + +import ( + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +var Object = instance.ObjectClass +var BuiltInClass = instance.BuiltInClassClass +var StandardClass = instance.StandardClassClass +var BasicArray = instance.BasicArrayClass +var BasicArrayStar = instance.BasicArrayStarClass +var GeneralArrayStar = instance.GeneralArrayStarClass +var BasicVector = instance.BasicVectorClass +var GeneralVector = instance.GeneralVectorClass +var String = instance.StringClass +var Character = instance.CharacterClass +var Function = instance.FunctionClass +var GenericFunction = instance.GenericFunctionClass +var StandardGenericFunction = instance.StandardGenericFunctionClass +var List = instance.ListClass +var Cons = instance.ConsClass +var Null = instance.NullClass +var Symbol = instance.SymbolClass +var Number = instance.NumberClass +var Integer = instance.IntegerClass +var Float = instance.FloatClass + +var SeriousCondition = instance.SeriousConditionClass +var Error = instance.ErrorClass +var ArithmeticError = instance.ArithmeticErrorClass +var DivisionByZero = instance.DivisionByZeroClass +var FloatingPointOnderflow = instance.FloatingPointOnderflowClass +var FloatingPointUnderflow = instance.FloatingPointUnderflowClass +var ControlError = instance.ControlErrorClass +var ParseError = instance.ParseErrorClass +var ProgramError = instance.ProgramErrorClass +var DomainError = instance.DomainErrorClass +var UndefinedEntity = instance.UndefinedEntityClass +var UndefinedVariable = instance.UndefinedVariableClass +var UndefinedFunction = instance.UndefinedFunctionClass +var SimpleError = instance.SimpleErrorClass +var StreamError = instance.StreamErrorClass +var EndOfStream = instance.EndOfStreamClass +var StorageExhausted = instance.StorageExhaustedClass +var StandardObject = instance.StandardObjectClass +var Stream = instance.StreamClass + +// Implementation defined +var Escape = instance.EscapeClass +var CatchTag = instance.CatchTagClass +var TagbodyTag = instance.TagbodyTagClass +var BlockTag = instance.BlockTagClass +var Continue = instance.ContinueClass diff --git a/core/ilos.go b/runtime/ilos/ilos.go similarity index 56% rename from core/ilos.go rename to runtime/ilos/ilos.go index 399dec9..ced1bfb 100644 --- a/core/ilos.go +++ b/runtime/ilos/ilos.go @@ -1,13 +1,11 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. -package core +package ilos import ( "reflect" - - "github.com/google/go-cmp/cmp" ) type Class interface { @@ -24,15 +22,10 @@ type Instance interface { String() string } -func DeepEqual(x, y interface{}) bool { - return reflect.DeepEqual(x, y) || cmp.Equal(x, y, cmp.AllowUnexported(BuiltInClass{}, StandardClass{}, Function{})) - //, cmpopts.IgnoreUnexported(Symbol{})) -} - func SubclassOf(super, sub Class) bool { var subclassof func(p, c Class) bool subclassof = func(p, c Class) bool { - if DeepEqual(p, c) { + if reflect.DeepEqual(c, p) { return true } for _, d := range c.Supers() { @@ -50,9 +43,9 @@ func SubclassOf(super, sub Class) bool { return false } -func InstanceOf(c Class, i Instance) bool { - if DeepEqual(c, i.Class()) { +func InstanceOf(p Class, i Instance) bool { + if reflect.DeepEqual(i.Class(), p) { return true } - return SubclassOf(c, i.Class()) + return SubclassOf(p, i.Class()) } diff --git a/runtime/ilos/instance/basic-array.go b/runtime/ilos/instance/basic-array.go new file mode 100644 index 0000000..32b7c62 --- /dev/null +++ b/runtime/ilos/instance/basic-array.go @@ -0,0 +1,67 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package instance + +import ( + "github.com/k0kubun/pp" + "github.com/ta2gch/iris/runtime/ilos" +) + +// +// General Array * +// + +type GeneralArrayStar struct { + Vector []GeneralArrayStar + Scalar ilos.Instance +} + +func NewGeneralArrayStar(vector []GeneralArrayStar, scalar ilos.Instance) ilos.Instance { + return GeneralArrayStar{vector, scalar} +} + +func (GeneralArrayStar) Class() ilos.Class { + return GeneralArrayStarClass +} + +func (i GeneralArrayStar) String() string { + return "" +} + +// +// General Vector +// + +type GeneralVector []ilos.Instance + +func NewGeneralVector(v []ilos.Instance) ilos.Instance { + return GeneralVector(v) +} + +func (GeneralVector) Class() ilos.Class { + return GeneralVectorClass +} + +func (i GeneralVector) String() string { + return pp.Sprint([]ilos.Instance(i)) +} + +// +// String +// + +type String []rune + +func NewString(s string) ilos.Instance { + return String(s) +} + +func (String) Class() ilos.Class { + return StringClass +} + +func (i String) String() string { + return "\"" + string(i) + "\"" +} diff --git a/runtime/ilos/instance/built-in-class.go b/runtime/ilos/instance/built-in-class.go new file mode 100644 index 0000000..6d45dd6 --- /dev/null +++ b/runtime/ilos/instance/built-in-class.go @@ -0,0 +1,49 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package instance + +import ( + "fmt" + + "github.com/ta2gch/iris/runtime/ilos" +) + +type BuiltInClass struct { + name ilos.Instance + supers []ilos.Class + slots []ilos.Instance +} + +func NewBuiltInClass(name string, super ilos.Class, slots ...string) ilos.Class { + slotNames := []ilos.Instance{} + for _, slot := range slots { + slotNames = append(slotNames, NewSymbol(slot)) + } + return BuiltInClass{NewSymbol(name), []ilos.Class{super}, slotNames} +} + +func (p BuiltInClass) Supers() []ilos.Class { + return p.supers +} + +func (p BuiltInClass) Slots() []ilos.Instance { + return p.slots +} + +func (p BuiltInClass) Initform(arg ilos.Instance) (ilos.Instance, bool) { + return nil, false +} + +func (p BuiltInClass) Initarg(arg ilos.Instance) (ilos.Instance, bool) { + return arg, true +} + +func (BuiltInClass) Class() ilos.Class { + return BuiltInClassClass +} + +func (p BuiltInClass) String() string { + return fmt.Sprint(p.name) +} diff --git a/runtime/ilos/instance/character.go b/runtime/ilos/instance/character.go new file mode 100644 index 0000000..5be552b --- /dev/null +++ b/runtime/ilos/instance/character.go @@ -0,0 +1,27 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package instance + +import ( + "github.com/ta2gch/iris/runtime/ilos" +) + +// +// Character +// + +type Character rune + +func NewCharacter(r rune) ilos.Instance { + return Character(r) +} + +func (Character) Class() ilos.Class { + return CharacterClass +} + +func (i Character) String() string { + return string(i) +} diff --git a/core/class.go b/runtime/ilos/instance/class.go similarity index 85% rename from core/class.go rename to runtime/ilos/instance/class.go index a214b31..8a1098e 100644 --- a/core/class.go +++ b/runtime/ilos/instance/class.go @@ -1,10 +1,14 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. -package core +package instance -var ObjectClass = BuiltInClass{NewSymbol(""), []Class{}, []Instance{}} +import ( + "github.com/ta2gch/iris/runtime/ilos" +) + +var ObjectClass = BuiltInClass{NewSymbol(""), []ilos.Class{}, []ilos.Instance{}} var BuiltInClassClass = NewBuiltInClass("", ObjectClass) var StandardClassClass = NewBuiltInClass("", ObjectClass) var BasicArrayClass = NewBuiltInClass("", ObjectClass) @@ -19,13 +23,13 @@ var GenericFunctionClass = NewBuiltInClass("", FunctionClass) var StandardGenericFunctionClass = NewBuiltInClass("", GenericFunctionClass) var ListClass = NewBuiltInClass("", ObjectClass) var ConsClass = NewBuiltInClass("", ListClass) -var NullClass = BuiltInClass{NewSymbol(""), []Class{ListClass, SymbolClass}, []Instance{}} +var NullClass = BuiltInClass{NewSymbol(""), []ilos.Class{ListClass, SymbolClass}, []ilos.Instance{}} var SymbolClass = NewBuiltInClass("", ObjectClass) var NumberClass = NewBuiltInClass("", ObjectClass) var IntegerClass = NewBuiltInClass("", NumberClass) var FloatClass = NewBuiltInClass("", NumberClass) -var SeriousConditionClass = NewBuiltInClass("", ObjectClass, "IRIS.STACKTRACE") +var SeriousConditionClass = NewBuiltInClass("", ObjectClass) var ErrorClass = NewBuiltInClass("", SeriousConditionClass) var ArithmeticErrorClass = NewBuiltInClass("", ErrorClass, "OPERATION", "OPERANDS") var DivisionByZeroClass = NewBuiltInClass("", ArithmeticErrorClass) @@ -34,9 +38,9 @@ var FloatingPointUnderflowClass = NewBuiltInClass("", var ControlErrorClass = NewBuiltInClass("", ErrorClass) var ParseErrorClass = NewBuiltInClass("", ErrorClass, "STRING", "EXPECTED-CLASS") var ProgramErrorClass = NewBuiltInClass("", ErrorClass) -var DomainErrorClass = NewBuiltInClass("", ProgramErrorClass, "OBJECT", "EXPECTED-CLASS") +var DomainErrorClass = NewBuiltInClass("", ProgramErrorClass, "IRIS.OBJECT", "EXPECTED-CLASS") var UndefinedEntityClass = NewBuiltInClass("", ProgramErrorClass, "NAME", "NAMESPACE") -var UnboundVariableClass = NewBuiltInClass("", UndefinedEntityClass) +var UndefinedVariableClass = NewBuiltInClass("", UndefinedEntityClass) var UndefinedFunctionClass = NewBuiltInClass("", UndefinedEntityClass) var SimpleErrorClass = NewBuiltInClass("", ErrorClass, "FORMAT-STRING", "FORMAT-ARGUMENTS") var StreamErrorClass = NewBuiltInClass("", ErrorClass) @@ -46,7 +50,7 @@ var StandardObjectClass = NewBuiltInClass("", ObjectClass) var StreamClass = NewBuiltInClass("", ObjectClass, "STREAM") // Implementation defined -var EscapeClass = NewBuiltInClass("", ObjectClass, "IRIS.TAG", "IRIS.UID") +var EscapeClass = NewBuiltInClass("", ObjectClass, "IRIS.TAG") var CatchTagClass = NewBuiltInClass("", EscapeClass, "IRIS.OBJECT") var TagbodyTagClass = NewBuiltInClass("", EscapeClass) var BlockTagClass = NewBuiltInClass("", EscapeClass, "IRIS.OBJECT") diff --git a/runtime/ilos/instance/error.go b/runtime/ilos/instance/error.go new file mode 100644 index 0000000..561ade1 --- /dev/null +++ b/runtime/ilos/instance/error.go @@ -0,0 +1,83 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package instance + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" +) + +func NewArithmeticError(operation, operands ilos.Instance) ilos.Instance { + return Create(env.NewEnvironment(nil, nil, nil, nil), + ArithmeticErrorClass, + NewSymbol("OPERATION"), operation, + NewSymbol("OPERANDS"), operands) +} + +func NewDivisionByZero(operation, operands ilos.Instance) ilos.Instance { + return Create(env.NewEnvironment(nil, nil, nil, nil), + DivisionByZeroClass, + NewSymbol("OPERATION"), operation, + NewSymbol("OPERANDS"), operands) +} + +func NewParseError(str, expectedClass ilos.Instance) ilos.Instance { + return Create(env.NewEnvironment(nil, nil, nil, nil), + ParseErrorClass, + NewSymbol("STRING"), str, + NewSymbol("EXPECTED-CLASS"), expectedClass) +} + +func NewDomainError(object ilos.Instance, expectedClass ilos.Class) ilos.Instance { + return Create(env.NewEnvironment(nil, nil, nil, nil), + DomainErrorClass, + NewSymbol("CAUSE"), NewSymbol("DOMAIN-ERROR"), + NewSymbol("IRIS.OBJECT"), object, + NewSymbol("EXPECTED-CLASS"), expectedClass) +} + +func NewUndefinedFunction(name ilos.Instance) ilos.Instance { + return Create(env.NewEnvironment(nil, nil, nil, nil), + UndefinedFunctionClass, + NewSymbol("NAME"), name, + NewSymbol("NAMESPACE"), NewSymbol("FUNCTION")) +} + +func NewUndefinedVariable(name ilos.Instance) ilos.Instance { + return Create(env.NewEnvironment(nil, nil, nil, nil), + UndefinedVariableClass, + NewSymbol("NAME"), name, + NewSymbol("NAMESPACE"), NewSymbol("VARIABLE")) +} + +func NewUndefinedClass(name ilos.Instance) ilos.Instance { + return Create(env.NewEnvironment(nil, nil, nil, nil), + UndefinedEntityClass, + NewSymbol("NAME"), name, + NewSymbol("NAMESPACE"), NewSymbol("CLASS")) +} + +func NewArityError() ilos.Instance { + return Create(env.NewEnvironment(nil, nil, nil, nil), ProgramErrorClass) +} + +func NewIndexOutOfRange() ilos.Instance { + return Create(env.NewEnvironment(nil, nil, nil, nil), ProgramErrorClass) +} + +func NewImmutableBinding() ilos.Instance { + return Create(env.NewEnvironment(nil, nil, nil, nil), ProgramErrorClass) +} + +func NewSimpleError(formatString, formatArguments ilos.Instance) ilos.Instance { + return Create(env.NewEnvironment(nil, nil, nil, nil), + SimpleErrorClass, + NewSymbol("FORMAT-STRING"), formatString, + NewSymbol("FORMAT-ARGUMENTS"), formatArguments) +} + +func NewControlError() ilos.Instance { + return Create(env.NewEnvironment(nil, nil, nil, nil), ControlErrorClass) +} diff --git a/core/function.go b/runtime/ilos/instance/function.go similarity index 61% rename from core/function.go rename to runtime/ilos/instance/function.go index f94d96b..7f9c5e5 100644 --- a/core/function.go +++ b/runtime/ilos/instance/function.go @@ -1,29 +1,32 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. -package core +package instance import ( "fmt" "reflect" "sort" + + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" ) type Applicable interface { - Apply(Environment, ...Instance) (Instance, Instance) + Apply(env.Environment, ...ilos.Instance) (ilos.Instance, ilos.Instance) } type Function struct { - name Instance + name ilos.Instance function interface{} } -func NewFunction(name Instance, function interface{}) Instance { +func NewFunction(name ilos.Instance, function interface{}) ilos.Instance { return Function{name, function} } -func (Function) Class() Class { +func (Function) Class() ilos.Class { return FunctionClass } @@ -31,12 +34,7 @@ func (f Function) String() string { return fmt.Sprintf("#%v", f.Class()) } -func (f Function) Apply(e Environment, arguments ...Instance) (Instance, Instance) { - for _, arg := range arguments { - if arg == nil { - return SignalCondition(e, NewDomainError(e, arg, ObjectClass), Nil) - } - } +func (f Function) Apply(e env.Environment, arguments ...ilos.Instance) (ilos.Instance, ilos.Instance) { fv := reflect.ValueOf(f.function) ft := reflect.TypeOf(f.function) argv := []reflect.Value{reflect.ValueOf(e)} @@ -44,46 +42,46 @@ func (f Function) Apply(e Environment, arguments ...Instance) (Instance, Instanc argv = append(argv, reflect.ValueOf(cadr)) } if ft.NumIn() != len(argv) && (!ft.IsVariadic() || ft.NumIn()-2 >= len(argv)) { - return SignalCondition(e, NewArityError(e), Nil) + return nil, NewArityError() } rets := fv.Call(argv) - a, _ := rets[0].Interface().(Instance) - b, _ := rets[1].Interface().(Instance) + a, _ := rets[0].Interface().(ilos.Instance) + b, _ := rets[1].Interface().(ilos.Instance) return a, b } type method struct { - qualifier Instance - classList []Class + qualifier ilos.Instance + classList []ilos.Class function Function } type GenericFunction struct { - funcSpec Instance - lambdaList Instance - methodCombination Instance - genericFunctionClass Class + funcSpec ilos.Instance + lambdaList ilos.Instance + methodCombination ilos.Instance + genericFunctionClass ilos.Class methods []method } -func NewGenericFunction(funcSpec, lambdaList, methodCombination Instance, genericFunctionClass Class) Instance { +func NewGenericFunction(funcSpec, lambdaList, methodCombination ilos.Instance, genericFunctionClass ilos.Class) ilos.Instance { return &GenericFunction{funcSpec, lambdaList, methodCombination, genericFunctionClass, []method{}} } -func (f *GenericFunction) AddMethod(qualifier, lambdaList Instance, classList []Class, function Instance) bool { +func (f *GenericFunction) AddMethod(qualifier, lambdaList ilos.Instance, classList []ilos.Class, function ilos.Instance) bool { if f.lambdaList.(List).Length() != lambdaList.(List).Length() { return false } for i, param := range f.lambdaList.(List).Slice() { - if DeepEqual(param, NewSymbol(":REST")) || DeepEqual(param, NewSymbol("&REST")) { + if param == NewSymbol(":REST") || param == NewSymbol("&REST") { if lambdaList.(List).Nth(i) != NewSymbol(":REST") && lambdaList.(List).Nth(i) != NewSymbol("&REST") { return false } } } for i := range f.methods { - if DeepEqual(f.methods[i].qualifier, qualifier) && DeepEqual(f.methods[i].classList, classList) { + if f.methods[i].qualifier == qualifier && reflect.DeepEqual(f.methods[i].classList, classList) { f.methods[i].function = function.(Function) return true } @@ -92,7 +90,7 @@ func (f *GenericFunction) AddMethod(qualifier, lambdaList Instance, classList [] return true } -func (f *GenericFunction) Class() Class { +func (f *GenericFunction) Class() ilos.Class { return f.genericFunctionClass } @@ -100,25 +98,23 @@ func (f *GenericFunction) String() string { return fmt.Sprintf("#%v", f.Class()) } -func (f *GenericFunction) Apply(e Environment, arguments ...Instance) (Instance, Instance) { +func (f *GenericFunction) Apply(e env.Environment, arguments ...ilos.Instance) (ilos.Instance, ilos.Instance) { parameters := f.lambdaList.(List).Slice() variadic := false { - test := func(i int) bool { - return DeepEqual(parameters[i], NewSymbol(":REST")) || DeepEqual(parameters[i], NewSymbol("&REST")) - } + test := func(i int) bool { return parameters[i] == NewSymbol(":REST") || parameters[i] == NewSymbol("&REST") } if sort.Search(len(parameters), test) < len(parameters) { variadic = true } } if (variadic && len(parameters)-2 > len(arguments)) || (!variadic && len(parameters) != len(arguments)) { - return SignalCondition(e, NewArityError(e), Nil) + return nil, NewArityError() } methods := []method{} for _, method := range f.methods { matched := true for i, c := range method.classList { - if !InstanceOf(c, arguments[i]) { + if !ilos.InstanceOf(c, arguments[i]) { matched = false break } @@ -132,65 +128,63 @@ func (f *GenericFunction) Apply(e Environment, arguments ...Instance) (Instance, after := NewSymbol(":AFTER") sort.Slice(methods, func(a, b int) bool { for i := range methods[a].classList { - if SubclassOf(methods[a].classList[i], methods[b].classList[i]) { + if ilos.SubclassOf(methods[a].classList[i], methods[b].classList[i]) { return false } - if SubclassOf(methods[b].classList[i], methods[a].classList[i]) { + if ilos.SubclassOf(methods[b].classList[i], methods[a].classList[i]) { return true } } - t := map[Instance]int{around: 4, before: 3, nil: 2, after: 1} + t := map[ilos.Instance]int{around: 4, before: 3, nil: 2, after: 1} return t[methods[a].qualifier] > t[methods[b].qualifier] }) - nextMethodPisNil := NewFunction(NewSymbol("NEXT-METHOD-P"), func(e Environment) (Instance, Instance) { + nextMethodPisNil := NewFunction(NewSymbol("NEXT-METHOD-P"), func(e env.Environment) (ilos.Instance, ilos.Instance) { return Nil, nil }) - nextMethodPisT := NewFunction(NewSymbol("NEXT-METHOD-P"), func(e Environment) (Instance, Instance) { + nextMethodPisT := NewFunction(NewSymbol("NEXT-METHOD-P"), func(e env.Environment) (ilos.Instance, ilos.Instance) { return T, nil }) - if DeepEqual(f.methodCombination, Nil) { - var callNextMethod func(e Environment) (Instance, Instance) // To Recursive - callNextMethod = func(e Environment) (Instance, Instance) { // CALL-NEXT-METHOD - depth, _ := e.DynamicVariable.Get(NewSymbol("IRIS.DEPTH")) // Get previous depth + if f.methodCombination == NewSymbol("NIL") { + var callNextMethod func(e env.Environment) (ilos.Instance, ilos.Instance) // To Recursive + callNextMethod = func(e env.Environment) (ilos.Instance, ilos.Instance) { // CALL-NEXT-METHOD + depth, _ := e.DynamicVariable.Get(NewSymbol("IRIS/DEPTH")) // Get previous depth index := int(depth.(Integer)) + 1 // Get index of next method - e.DynamicVariable.Define(NewSymbol("IRIS.DEPTH"), NewInteger(index)) // Set current depth + e.DynamicVariable.Define(NewSymbol("IRIS/DEPTH"), NewInteger(index)) // Set current depth // If Generic Function has no next-mehtods, NEXT-METHOD-P e function returns nil - e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisNil) - if index + 1 < len(methods) { // If Generic Function has next method, set these functionss + e.Function.Define(NewSymbol("NEXT-METHOD-P"), NewFunction(NewSymbol("NEXT-METHOD-P"), nextMethodPisNil)) + if int(depth.(Integer))+1 < len(methods) { // If Generic Function has next method, set these functionss e.Function.Define(NewSymbol("CALL-NEXT-METHOD"), NewFunction(NewSymbol("CALL-NEXT-METHOD"), callNextMethod)) - e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisT) + e.Function.Define(NewSymbol("NEXT-METHOD-P"), NewFunction(NewSymbol("NEXT-METHOD-P"), nextMethodPisT)) } return methods[index].function.Apply(e, arguments...) // Call next method } - e.DynamicVariable.Define(NewSymbol("IRIS.DEPTH"), NewInteger(0)) // Set current depth + e.DynamicVariable.Define(NewSymbol("IRIS/DEPTH"), NewInteger(0)) // Set current depth // If Generic Function has no next-mehtods, NEXT-METHOD-P e function returns nil - e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisNil) + e.Function.Define(NewSymbol("NEXT-METHOD-P"), NewFunction(NewSymbol("NEXT-METHOD-P"), nextMethodPisNil)) if 1 < len(methods) { // If Generic Function has next method, set these functionss - e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisT) + e.Function.Define(NewSymbol("NEXT-METHOD-P"), NewFunction(NewSymbol("NEXT-METHOD-P"), nextMethodPisT)) e.Function.Define(NewSymbol("CALL-NEXT-METHOD"), NewFunction(NewSymbol("CALL-NEXT-METHOD"), callNextMethod)) } return methods[0].function.Apply(e, arguments...) //Call first of method } - // if DeepEqual(f.methodCombination, NewSymbol("STANDARD")) + // if f.methodCombination == NewSymbol("STANDARD") { - test := func(i int) bool { return DeepEqual(methods[i].qualifier, around) } + test := func(i int) bool { return methods[i].qualifier == around } width := len(methods) if index := sort.Search(width, test); index < width { // if has :around methods // This callNextMethod is called in :around methods - var callNextMethod func(e Environment) (Instance, Instance) - callNextMethod = func(e Environment) (Instance, Instance) { - depth, _ := e.DynamicVariable.Get(NewSymbol("IRIS.DEPTH")) // Get previous depth + var callNextMethod func(e env.Environment) (ilos.Instance, ilos.Instance) + callNextMethod = func(e env.Environment) (ilos.Instance, ilos.Instance) { + depth, _ := e.DynamicVariable.Get(NewSymbol("IRIS/DEPTH")) // Get previous depth for index, method := range methods[:int(depth.(Integer))+1] { - if DeepEqual(method.qualifier, around) { // If have :around method - e.DynamicVariable.Define(NewSymbol("IRIS.DEPTH"), NewInteger(index)) // Set Current depth + if method.qualifier == around { // If have :around method + e.DynamicVariable.Define(NewSymbol("IRIS/DEPTH"), NewInteger(index)) // Set Current depth // If Generic Function has no next-mehtods, NEXT-METHOD-P e function returns nil e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisNil) { // If Generic Function has next method, set these functionss width := len(methods) - index - 1 - test := func(i int) bool { - return DeepEqual(methods[index+i+1].qualifier, nil) || DeepEqual(methods[index+i+1].qualifier, around) - } + test := func(i int) bool { return methods[index+i+1].qualifier == nil || methods[index+i+1].qualifier == around } if sort.Search(width, test) < width { e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisT) e.Function.Define(NewSymbol("CALL-NEXT-METHOD"), NewFunction(NewSymbol("CALL-NEXT-METHOD"), callNextMethod)) @@ -202,7 +196,7 @@ func (f *GenericFunction) Apply(e Environment, arguments ...Instance) (Instance, // If has no :around method then, // Do All :before mehtods for _, method := range methods { - if DeepEqual(method.qualifier, before) { + if method.qualifier == before { if _, err := method.function.Apply(e, arguments...); err != nil { return nil, err } @@ -210,30 +204,24 @@ func (f *GenericFunction) Apply(e Environment, arguments ...Instance) (Instance, } // Do the first of primary methods // this callNextMethod is called in primary methods - var callNextMethod func(e Environment) (Instance, Instance) - callNextMethod = func(e Environment) (Instance, Instance) { - depth, _ := e.DynamicVariable.Get(NewSymbol("IRIS.DEPTH")) // Get previous depth + var callNextMethod func(e env.Environment) (ilos.Instance, ilos.Instance) + callNextMethod = func(e env.Environment) (ilos.Instance, ilos.Instance) { + depth, _ := e.DynamicVariable.Get(NewSymbol("IRIS/DEPTH")) // Get previous depth index := int(depth.(Integer)) // Convert depth to integer { width := len(methods) - index - 1 - for i := 0; i < width; i++ { - if DeepEqual(methods[index+i+1].qualifier, nil) { - index = i - break - } - } - e.DynamicVariable.Define(NewSymbol("IRIS.DEPTH"), NewInteger(index)) // Set current depth + test := func(i int) bool { return methods[index+i+1].qualifier == nil } + index = sort.Search(width, test) // Get index of next mehotd + e.DynamicVariable.Define(NewSymbol("IRIS/DEPTH"), NewInteger(index)) // Set current depth } // If Generic Function has no next-mehtods, NEXT-METHOD-P e function returns nil e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisNil) { // If Generic Function has next method, set these functionss width := len(methods) - index - 1 - for i := 0; i < width; i++ { - if DeepEqual(methods[index+i+1].qualifier, nil) { - e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisT) - e.Function.Define(NewSymbol("CALL-NEXT-METHOD"), NewFunction(NewSymbol("CALL-NEXT-METHOD"), callNextMethod)) - break - } + test := func(i int) bool { return methods[index+i+1].qualifier == nil } + if sort.Search(width, test) < width { + e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisT) + e.Function.Define(NewSymbol("CALL-NEXT-METHOD"), NewFunction(NewSymbol("CALL-NEXT-METHOD"), callNextMethod)) } } return methods[index].function.Apply(e, arguments...) // Call next method @@ -241,14 +229,14 @@ func (f *GenericFunction) Apply(e Environment, arguments ...Instance) (Instance, index := 0 // index of the first primary method { // index != 0 is always true because this function has :around methods width := len(methods) - index - 1 - test := func(i int) bool { return DeepEqual(methods[index+i+1].qualifier, nil) } + test := func(i int) bool { return methods[index+i+1].qualifier == nil } index = sort.Search(width, test) - e.DynamicVariable.Define(NewSymbol("IRIS.DEPTH"), NewInteger(index)) + e.DynamicVariable.Define(NewSymbol("IRIS/DEPTH"), NewInteger(index)) } // If Generic Function has no next-mehtods, NEXT-METHOD-P e function returns nil e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisNil) { // If Generic Function has next method, set these functionss - test := func(i int) bool { return DeepEqual(methods[index+i+1].qualifier, nil) } + test := func(i int) bool { return methods[index+i+1].qualifier == nil } width := len(methods) - index - 1 if sort.Search(width, test) < width { e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisT) @@ -262,7 +250,7 @@ func (f *GenericFunction) Apply(e Environment, arguments ...Instance) (Instance, } // Do all :after methods for i := len(methods) - 1; i >= 0; i-- { - if DeepEqual(methods[i].qualifier, after) { + if methods[i].qualifier == after { if _, err := methods[i].function.Apply(e, arguments...); err != nil { return nil, err } @@ -270,11 +258,11 @@ func (f *GenericFunction) Apply(e Environment, arguments ...Instance) (Instance, } return ret, err } - e.DynamicVariable.Define(NewSymbol("IRIS.DEPTH"), NewInteger(index)) // Set Current depth + e.DynamicVariable.Define(NewSymbol("IRIS/DEPTH"), NewInteger(index)) // Set Current depth // If Generic Function has no next-mehtods, NEXT-METHOD-P e function returns nil e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisNil) { // If Generic Function has next method, set these functionss - test := func(i int) bool { return DeepEqual(methods[index+i+1].qualifier, nil) } + test := func(i int) bool { return methods[index+i+1].qualifier == nil } width := len(methods) - index - 1 if sort.Search(width, test) < width { e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisT) @@ -286,20 +274,20 @@ func (f *GenericFunction) Apply(e Environment, arguments ...Instance) (Instance, } { // Function has no :around methods // This callNextMethod is called in primary methods - var callNextMethod func(e Environment) (Instance, Instance) - callNextMethod = func(e Environment) (Instance, Instance) { - depth, _ := e.DynamicVariable.Get(NewSymbol("IRIS.DEPTH")) // Get previous depth + var callNextMethod func(e env.Environment) (ilos.Instance, ilos.Instance) + callNextMethod = func(e env.Environment) (ilos.Instance, ilos.Instance) { + depth, _ := e.DynamicVariable.Get(NewSymbol("IRIS/DEPTH")) // Get previous depth index := int(depth.(Integer)) // Convert depth to integer { - test := func(i int) bool { return DeepEqual(methods[index+i+1].qualifier, nil) } + test := func(i int) bool { return methods[index+i+1].qualifier == nil } width := len(methods) - index - 1 index = sort.Search(width, test) } - e.DynamicVariable.Define(NewSymbol("IRIS.DEPTH"), NewInteger(index)) // Set Current depth + e.DynamicVariable.Define(NewSymbol("IRIS/DEPTH"), NewInteger(index)) // Set Current depth // If Generic Function has no next-mehtods, NEXT-METHOD-P e function returns nil e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisNil) { // If Generic Function has next method, set these functionss - test := func(i int) bool { return DeepEqual(methods[index+i+1].qualifier, nil) } + test := func(i int) bool { return methods[index+i+1].qualifier == nil } width := len(methods) - index - 1 if sort.Search(width, test) < width { e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisT) @@ -310,7 +298,7 @@ func (f *GenericFunction) Apply(e Environment, arguments ...Instance) (Instance, } // callNextMethod ends here // Do All :before mehtods for _, method := range methods { - if DeepEqual(method.qualifier, before) { + if method.qualifier == before { if _, err := method.function.Apply(e, arguments...); err != nil { return nil, err } @@ -318,17 +306,17 @@ func (f *GenericFunction) Apply(e Environment, arguments ...Instance) (Instance, } index := 0 // index of the first primary method { - test := func(i int) bool { return DeepEqual(methods[i].qualifier, nil) } + test := func(i int) bool { return methods[i].qualifier == nil } width := len(methods) index := sort.Search(width, test) - e.DynamicVariable.Define(NewSymbol("IRIS.DEPTH"), NewInteger(index)) + e.DynamicVariable.Define(NewSymbol("IRIS/DEPTH"), NewInteger(index)) if index == len(methods) { - return SignalCondition(e, NewUndefinedFunction(e, f.funcSpec), Nil) + return nil, NewUndefinedFunction(f.funcSpec) } } e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisNil) { // If Generic Function has next method, set these functions - test := func(i int) bool { return DeepEqual(methods[index+i+1].qualifier, nil) } + test := func(i int) bool { return methods[index+i+1].qualifier == nil } width := len(methods) - index - 1 if sort.Search(width, test) < width { e.Function.Define(NewSymbol("NEXT-METHOD-P"), nextMethodPisT) @@ -338,7 +326,7 @@ func (f *GenericFunction) Apply(e Environment, arguments ...Instance) (Instance, ret, err := methods[index].function.Apply(e, arguments...) // Do all :after methods for i := len(methods) - 1; i >= 0; i-- { - if DeepEqual(methods[i].qualifier, after) { + if methods[i].qualifier == after { if _, err := methods[i].function.Apply(e, arguments...); err != nil { return nil, err } diff --git a/runtime/ilos/instance/instance.go b/runtime/ilos/instance/instance.go new file mode 100644 index 0000000..02ddb87 --- /dev/null +++ b/runtime/ilos/instance/instance.go @@ -0,0 +1,120 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package instance + +import ( + "fmt" + "reflect" + + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" +) + +// +// instance +// + +func Create(e env.Environment, c ilos.Instance, i ...ilos.Instance) ilos.Instance { + p := []ilos.Instance{} + for _, q := range c.(ilos.Class).Supers() { + p = append(p, Create(e, q, i...)) + } + return InitializeObject(e, Instance{c.(ilos.Class), p, map[ilos.Instance]ilos.Instance{}}, i...) +} + +func InitializeObject(e env.Environment, object ilos.Instance, inits ...ilos.Instance) ilos.Instance { + for _, super := range object.(Instance).supers { + InitializeObject(e, super, inits...) + } + for i := 0; i < len(inits); i += 2 { + argName := inits[i] + argValue := inits[i+1] + if slotName, ok := object.Class().Initarg(argName); ok { + for _, s := range object.Class().Slots() { + if slotName == s { + object.(Instance).SetSlotValue(slotName, argValue, object.Class()) + break + } + } + } + } + for _, slotName := range object.Class().Slots() { + if _, ok := object.(Instance).GetSlotValue(slotName, object.Class()); !ok { + if form, ok := object.Class().Initform(slotName); ok { + value, _ := form.(Applicable).Apply(e.NewDynamic()) + object.(Instance).SetSlotValue(slotName, value, object.Class()) + } + } + } + return object +} + +type slots map[ilos.Instance]ilos.Instance + +func (s slots) String() string { + str := "{" + for k, v := range s { + str += fmt.Sprintf(`%v: %v, `, k, v) + } + if len(str) == 1 { + return "" + } + return str[:len(str)-2] + "}" +} + +type Instance struct { + class ilos.Class + supers []ilos.Instance + slots slots +} + +func (i Instance) Class() ilos.Class { + return i.class +} + +func (i Instance) GetSlotValue(key ilos.Instance, class ilos.Class) (ilos.Instance, bool) { + if v, ok := i.slots[key]; ok && reflect.DeepEqual(i.class, class) { + return v, ok + } + for _, s := range i.supers { + if v, ok := s.(Instance).GetSlotValue(key, class); ok { + return v, ok + } + } + return nil, false +} + +func (i Instance) SetSlotValue(key ilos.Instance, value ilos.Instance, class ilos.Class) bool { + if reflect.DeepEqual(i.class, class) { + i.slots[key] = value + return true + } + for _, s := range i.supers { + if ok := s.(Instance).SetSlotValue(key, value, class); ok { + return ok + } + } + return false +} + +func (i Instance) getAllSlots() slots { + m := slots{} + for k, v := range i.slots { + m[k] = v + } + for _, c := range i.supers { + if _, ok := c.(Instance); ok { + for k, v := range c.(Instance).getAllSlots() { + m[k] = v + } + } + } + return m +} + +func (i Instance) String() string { + c := i.Class().String() + return fmt.Sprintf("#%v %v>", c[:len(c)-1], i.getAllSlots()) +} diff --git a/runtime/ilos/instance/list.go b/runtime/ilos/instance/list.go new file mode 100644 index 0000000..b1a8fa5 --- /dev/null +++ b/runtime/ilos/instance/list.go @@ -0,0 +1,126 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package instance + +import ( + "fmt" + + "github.com/ta2gch/iris/runtime/ilos" +) + +type List interface { + Slice() []ilos.Instance + Nth(i int) ilos.Instance + SetNth(obj ilos.Instance, i int) + NthCdr(i int) ilos.Instance + Length() int +} + +// +// Cons +// + +type Cons struct { + Car ilos.Instance + Cdr ilos.Instance +} + +func NewCons(car, cdr ilos.Instance) ilos.Instance { + return &Cons{car, cdr} +} + +func (*Cons) Class() ilos.Class { + return ConsClass +} + +func (i *Cons) String() string { + str := "(" + fmt.Sprint(i.Car) + cdr := i.Cdr + for ilos.InstanceOf(ConsClass, cdr) { + str += fmt.Sprintf(" %v", cdr.(*Cons).Car) // Checked at the top of this loop + cdr = cdr.(*Cons).Cdr // Checked at the top of this loop + } + if ilos.InstanceOf(NullClass, cdr) { + str += ")" + } else { + str += fmt.Sprintf(" . %v)", cdr) + } + return str +} + +func (i *Cons) Slice() []ilos.Instance { + s := []ilos.Instance{} + var cdr ilos.Instance = i + for ilos.InstanceOf(ConsClass, cdr) { + s = append(s, cdr.(*Cons).Car) + cdr = cdr.(*Cons).Cdr + } + return s +} + +func (i *Cons) Length() int { + return 1 + i.Cdr.(List).Length() +} + +func (i *Cons) Nth(n int) ilos.Instance { + if n == 0 { + return i.Car + } + return i.Cdr.(List).Nth(n - 1) +} + +func (i *Cons) SetNth(obj ilos.Instance, n int) { + if n == 0 { + i.Car = obj + } + i.Cdr.(List).SetNth(obj, n-1) +} + +func (i *Cons) NthCdr(n int) ilos.Instance { + if n == 0 { + return i.Cdr + } + return i.Cdr.(List).NthCdr(n - 1) +} + +// +// Null +// + +type Null struct{} + +var Nil = NewNull() + +func NewNull() ilos.Instance { + return &Null{} +} + +func (*Null) Class() ilos.Class { + return NullClass +} + +func (*Null) String() string { + return "NIL" +} + +func (*Null) Slice() []ilos.Instance { + return []ilos.Instance{} +} + +func (i *Null) Nth(n int) ilos.Instance { + return Nil +} + +func (i *Null) SetNth(obj ilos.Instance, n int) { + panic("NOT a cons") +} + +func (i *Null) NthCdr(n int) ilos.Instance { + return Nil +} + +func (i *Null) Length() int { + return 0 +} diff --git a/core/number.go b/runtime/ilos/instance/number.go similarity index 50% rename from core/number.go rename to runtime/ilos/instance/number.go index f8c3d85..2c12429 100644 --- a/core/number.go +++ b/runtime/ilos/instance/number.go @@ -1,21 +1,25 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. -package core +package instance import ( "fmt" + + "github.com/ta2gch/iris/runtime/ilos" ) +// // Integer +// type Integer int -func NewInteger(i int) Instance { +func NewInteger(i int) ilos.Instance { return Integer(i) } -func (Integer) Class() Class { +func (Integer) Class() ilos.Class { return IntegerClass } @@ -23,15 +27,17 @@ func (i Integer) String() string { return fmt.Sprint(int(i)) } +// // Float +// type Float float64 -func NewFloat(i float64) Instance { +func NewFloat(i float64) ilos.Instance { return Float(i) } -func (Float) Class() Class { +func (Float) Class() ilos.Class { return FloatClass } diff --git a/runtime/ilos/instance/standard-class.go b/runtime/ilos/instance/standard-class.go new file mode 100644 index 0000000..28bc761 --- /dev/null +++ b/runtime/ilos/instance/standard-class.go @@ -0,0 +1,51 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package instance + +import ( + "fmt" + + "github.com/ta2gch/iris/runtime/ilos" +) + +type StandardClass struct { + name ilos.Instance + supers []ilos.Class + slots []ilos.Instance + initforms map[ilos.Instance]ilos.Instance + initargs map[ilos.Instance]ilos.Instance + metaclass ilos.Class + abstractp ilos.Instance +} + +func NewStandardClass(name ilos.Instance, supers []ilos.Class, slots []ilos.Instance, initforms, initargs map[ilos.Instance]ilos.Instance, metaclass ilos.Class, abstractp ilos.Instance) ilos.Class { + return StandardClass{name, supers, slots, initforms, initargs, metaclass, abstractp} +} + +func (p StandardClass) Supers() []ilos.Class { + return p.supers +} + +func (p StandardClass) Slots() []ilos.Instance { + return p.slots +} + +func (p StandardClass) Initform(arg ilos.Instance) (ilos.Instance, bool) { + v, ok := p.initforms[arg] + return v, ok +} + +func (p StandardClass) Initarg(arg ilos.Instance) (ilos.Instance, bool) { + v, ok := p.initargs[arg] + return v, ok +} + +func (p StandardClass) Class() ilos.Class { + return p.metaclass +} + +func (p StandardClass) String() string { + return fmt.Sprint(p.name) +} diff --git a/runtime/ilos/instance/stream.go b/runtime/ilos/instance/stream.go new file mode 100644 index 0000000..9717b8c --- /dev/null +++ b/runtime/ilos/instance/stream.go @@ -0,0 +1,28 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package instance + +import ( + "io" + + "github.com/ta2gch/iris/runtime/ilos" +) + +type Stream struct { + Reader io.Reader + Writer io.Writer +} + +func NewStream(r io.Reader, w io.Writer) ilos.Instance { + return Stream{r, w} +} + +func (Stream) Class() ilos.Class { + return StreamClass +} + +func (Stream) String() string { + return "#" +} diff --git a/runtime/ilos/instance/symbol.go b/runtime/ilos/instance/symbol.go new file mode 100644 index 0000000..242dac7 --- /dev/null +++ b/runtime/ilos/instance/symbol.go @@ -0,0 +1,29 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package instance + +import ( + "github.com/ta2gch/iris/runtime/ilos" +) + +// +// Symbol +// + +type Symbol string + +func NewSymbol(s string) ilos.Instance { + return Symbol(s) +} + +func (Symbol) Class() ilos.Class { + return SymbolClass +} + +func (i Symbol) String() string { + return string(i) +} + +var T = NewSymbol("T") diff --git a/runtime/ilos/instance/tag.go b/runtime/ilos/instance/tag.go new file mode 100644 index 0000000..914ea76 --- /dev/null +++ b/runtime/ilos/instance/tag.go @@ -0,0 +1,31 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package instance + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" +) + +func NewBlockTag(tag, uid, object ilos.Instance) ilos.Instance { + return Create(env.NewEnvironment(nil, nil, nil, nil), + BlockTagClass, + NewSymbol("IRIS.TAG"), tag, + NewSymbol("IRIS.UID"), uid, + NewSymbol("IRIS.OBJECT"), object) +} +func NewCatchTag(tag, uid, object ilos.Instance) ilos.Instance { + return Create(env.NewEnvironment(nil, nil, nil, nil), + CatchTagClass, + NewSymbol("IRIS.TAG"), tag, + NewSymbol("IRIS.UID"), uid, + NewSymbol("IRIS.OBJECT"), object) +} +func NewTagbodyTag(tag, uid ilos.Instance) ilos.Instance { + return Create(env.NewEnvironment(nil, nil, nil, nil), + TagbodyTagClass, + NewSymbol("IRIS.TAG"), tag, + NewSymbol("IRIS.UID"), uid) +} diff --git a/runtime/integer.go b/runtime/integer.go new file mode 100644 index 0000000..6f11b40 --- /dev/null +++ b/runtime/integer.go @@ -0,0 +1,139 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "math" + + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +func convInt(z ilos.Instance) (int, ilos.Instance) { + if err := ensure(class.Integer, z); err != nil { + return 0, err + } + return int(z.(instance.Integer)), nil +} + +// Integerp returns t if obj is an integer (instance of class integer); +// otherwise, returns nil. obj may be any ISLISP object. +func Integerp(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class.Integer, obj) { + return T, nil + } + return Nil, nil +} + +// Div returns the greatest integer less than or equal to the quotient of z1 and z2. +// An error shall be signaled if z2 is zero (error-id. division-by-zero). +func Div(e env.Environment, z1, z2 ilos.Instance) (ilos.Instance, ilos.Instance) { + a, err := convInt(z1) + if err != nil { + return nil, err + } + b, err := convInt(z2) + if err != nil { + return nil, err + } + if b == 0 { + operation := instance.NewSymbol("DIV") + operands, err := List(e, z1, z2) + if err != nil { + return nil, err + } + return nil, instance.NewDivisionByZero(operation, operands) + } + return instance.NewInteger(a / b), nil +} + +// Mod returns the remainder of the integer division of z1 by z2. +// The sign of the result is the sign of z2. The result lies +// between 0 (inclusive) and z2 (exclusive), and the difference of z1 +// and this result is divisible by z2 without remainder. +// +// An error shall be signaled if either z1 or z2 is not an integer (error-id. domain-error). +func Mod(e env.Environment, z1, z2 ilos.Instance) (ilos.Instance, ilos.Instance) { + a, err := convInt(z1) + if err != nil { + return nil, err + } + b, err := convInt(z2) + if err != nil { + return nil, err + } + if b == 0 { + operation := instance.NewSymbol("MOD") + operands, err := List(e, z1, z2) + if err != nil { + return nil, err + } + return nil, instance.NewDivisionByZero(operation, operands) + } + return instance.NewInteger(a % b), nil +} + +// Gcd returns the greatest common divisor of its integer arguments. +// The result is a non-negative integer. For nonzero arguments +// the greatest common divisor is the largest integer z such that +// z1 and z2 are integral multiples of z. +// +// An error shall be signaled if either z1 or z2 is not an integer +// (error-id. domain-error). +func Gcd(e env.Environment, z1, z2 ilos.Instance) (ilos.Instance, ilos.Instance) { + gcd := func(x, y int) int { + for y != 0 { + x, y = y, x%y + } + return x + } + a, err := convInt(z1) + if err != nil { + return nil, err + } + b, err := convInt(z2) + if err != nil { + return nil, err + } + return instance.NewInteger(gcd(a, b)), nil +} + +// Lcm returns the least common multiple of its integer arguments. +// +// An error shall be signaled if either z1 or z2 is not an integer +// (error-id. domain-error). +func Lcm(e env.Environment, z1, z2 ilos.Instance) (ilos.Instance, ilos.Instance) { + gcd := func(x, y int) int { + for y != 0 { + x, y = y, x%y + } + return x + } + a, err := convInt(z1) + if err != nil { + return nil, err + } + b, err := convInt(z2) + if err != nil { + return nil, err + } + return instance.NewInteger(a * b / gcd(a, b)), nil +} + +// Isqrt Returns the greatest integer less than or equal to +// the exact positive square root of z . An error shall be signaled +// if z is not a non-negative integer (error-id. domain-error). +func Isqrt(e env.Environment, z ilos.Instance) (ilos.Instance, ilos.Instance) { + a, err := convInt(z) + if err != nil { + return nil, err + } + if a < 0 { + return nil, instance.NewDomainError(z, class.Number) + } + return instance.NewInteger(int(math.Sqrt(float64(a)))), nil +} diff --git a/runtime/iteration.go b/runtime/iteration.go new file mode 100644 index 0000000..b4e13b2 --- /dev/null +++ b/runtime/iteration.go @@ -0,0 +1,121 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// While the test-form returns a true value. Specifically: +// +// 1. test-form is evaluated, producing a value Vt. +// +// 2. If Vt is nil, then the while form immediately returns nil. +// +// 3. Otherwise, if Vt is non-nil, the forms body-form* are evaluated sequentially (from left to right). +// +// 4. Upon successful completion of the body-forms*, the while form begins again with step 1. +func While(e env.Environment, testForm ilos.Instance, bodyForm ...ilos.Instance) (ilos.Instance, ilos.Instance) { + test, err := Eval(e, testForm) + if err != nil { + return nil, err + } + for test == T { + _, err := Progn(e, bodyForm...) + if err != nil { + return nil, err + } + test, err = Eval(e, testForm) + if err != nil { + return nil, err + } + } + return Nil, nil +} + +// For repeatedly executes a sequence of forms form*, called its body. It specifies a set of identifiers naming +// variables that will be e to the for form, their initialization, and their update for each iteration. +// When a termination condition is met, the iteration exits with a specified result value. +// +// The scope of an identifier var is the body, the steps, the end-test , and the result *. A step might be omitted, +// in which case the effect is the same as if (var init var) had been written instead of (var init). +// It is a violation if more than one iteration-spec names the same var in the same for form. +// +// The for special form is executed as follows: The init forms are evaluated sequentially from left to right. +// Then each value is used as the initial value of the variable denoted by the corresponding identifier var , +// and the iteration phase begins. +// +// Each iteration begins by evaluating end-test . If the result is nil, the forms in the body are +// evaluated sequentially (for side-effects). Afterwards, the step-forms are evaluated sequentially +// order from left to right. Then their values are assigned to the corresponding variables and the next iteration begins. +// If end-test returns a non-nil value, then the result * are evaluated sequentially and the value of the +// last one is returned as value of the whole for macro. If no result is present, then the value of the for macro is nil. +func For(e env.Environment, iterationSpecs, endTestAndResults ilos.Instance, forms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.List, iterationSpecs); err != nil { + return nil, err + } + for _, is := range iterationSpecs.(instance.List).Slice() { + if err := ensure(class.List, is); err != nil { + return nil, err + } + i := is.(instance.List).Slice() + switch len(i) { + case 2, 3: + var1 := i[0] + init := i[1] + if !e.Variable.Define(var1, init) { + return nil, instance.NewImmutableBinding() + } + default: + return nil, instance.NewArityError() + } + } + if err := ensure(class.List, endTestAndResults); err != nil { + return nil, err + } + ends := endTestAndResults.(instance.List).Slice() + if len(ends) == 0 { + return nil, instance.NewArityError() + } + endTest := ends[0] + results := ends[1:] + test, err := Eval(e, endTest) + if err != nil { + return nil, err + } + for test == Nil { + _, err := Progn(e, forms...) + if err != nil { + return nil, err + } + for _, is := range iterationSpecs.(instance.List).Slice() { + if err := ensure(class.List, is); err != nil { + return nil, err + } + switch is.(instance.List).Length() { + case 2: + case 3: + var1 := is.(instance.List).Nth(0) + step, err := Eval(e, is.(instance.List).Nth(2)) + if err != nil { + return nil, err + } + if !e.Variable.Set(var1, step) { + return nil, instance.NewImmutableBinding() + } + default: + return nil, instance.NewArityError() + } + } + test, err = Eval(e, endTest) + if err != nil { + return nil, err + } + } + return Progn(e, results...) +} diff --git a/runtime/list.go b/runtime/list.go new file mode 100644 index 0000000..f62bd9c --- /dev/null +++ b/runtime/list.go @@ -0,0 +1,336 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "math" + + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// Listp returns t if obj is a list (instance of class list); otherwise, returns nil. +// obj may be any ISLISP object. +func Listp(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class.Cons, obj) { + return T, nil + } + return Nil, nil +} + +// CreateList returns a list of length i. If initial-element is given, the elements of the new list +// are initialized with this object; otherwise, the initialization is implementation defined. An +// error shall be signaled if the requested list cannot be allocated (error-id. cannot-create-list). +// An error shall be signaled if i is not a non-negative integer (error-id. domain-error). +//initial-element may be any ISLISP object. +func CreateList(e env.Environment, i ilos.Instance, initialElement ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Integer, i); err != nil { + return nil, err + } + if len(initialElement) > 1 { + return nil, instance.NewArityError() + } + elm := Nil + if len(initialElement) == 1 { + elm = initialElement[0] + } + cons := Nil + for j := 0; j < int(i.(instance.Integer)); j++ { + cons = instance.NewCons(elm, cons) + } + return cons, nil +} + +// List returns a new list whose length is the number of arguments and whose elements are the +// arguments in the same order as in the list-form. An error shall be signaled if the requested list +// cannot be allocated (error-id. cannot-create-list). Each obj may be any ISLISP object. +func List(e env.Environment, objs ...ilos.Instance) (ilos.Instance, ilos.Instance) { + cons := Nil + for i := len(objs) - 1; i >= 0; i-- { + cons = instance.NewCons(objs[i], cons) + } + return cons, nil +} + +// Reverse returns a list whose elements are those of the given list, but in reverse +// order. An error shall be signaled if list is not a list (error-id. domain-error). +// +// For reverse, no side-effect to the given list occurs. The resulting list is permitted but not +// required to share structure with the input list. +func Reverse(e env.Environment, list ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.List, list); err != nil { + return nil, err + } + cons := Nil + for _, car := range list.(instance.List).Slice() { + cons = instance.NewCons(car, cons) + } + return cons, nil +} + +// Nreverse returns a list whose elements are those of the given list, but in reverse +// order. An error shall be signaled if list is not a list (error-id. domain-error). +// +// For nreverse, the conses which make up the top level of the given list are permitted, but not +// required, to be side-effected in order to produce this new list. nreverse should never be called +// on a literal object. +func Nreverse(e env.Environment, list ilos.Instance) (ilos.Instance, ilos.Instance) { + // TODO: tests literal object + if err := ensure(class.List, list); err != nil { + return nil, err + } + cons := Nil + for _, car := range list.(instance.List).Slice() { + cons = instance.NewCons(car, cons) + } + return cons, nil +} + +// Append returns the result of appending all of the lists, or () if given no lists. An error shall +// be signaled if any list is not a list (error-id. domain-error). +// +// This function does not modify its arguments. It is implementation defined whether and when the +// result shares structure with its list arguments. +// +// An error shall be signaled if the list cannot be allocated (error-id. cannot-create-list). +func Append(e env.Environment, lists ...ilos.Instance) (ilos.Instance, ilos.Instance) { + // Ref: https://github.com/sbcl/sbcl/blob/fe4faef65315c6ad52b3b89b62b6c6497cb78d09/src/code/list.lisp#L364 + + result, err := List(e, Nil) + if err != nil { + return nil, err + } + cdr := result + if err := ensure(class.List, lists...); err != nil { + return nil, err + } + for _, list := range lists { + for _, elt := range list.(instance.List).Slice() { + it, err := List(e, elt) + if err != nil { + return nil, err + } + cdr.(*instance.Cons).Cdr = it + cdr = cdr.(*instance.Cons).Cdr + } + } + return result.(*instance.Cons).Cdr, nil +} + +// Member returnes the first sublist of list whose car is obj if list contains at least one +// occurrence of obj (as determined by eql). Otherwise, nil is returned. An error shall be signaled +// if list is not a list (error-id. domain-error). +func Member(e env.Environment, obj, list ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.List, list); err != nil { + return nil, err + } + for idx, elt := range list.(instance.List).Slice() { + if obj == elt { // eql + return list.(instance.List).NthCdr(idx), nil + } + } + return Nil, nil +} + +// Mapcar operates on successive elements of the lists. function is applied to the first element of +// each list, then to the second element of each list, and so on. The iteration terminates when the +// shortest list runs out, and excess elements in other lists are ignored. The value returned by +// mapcar is a list of the results of successive calls to function. +func Mapcar(e env.Environment, function, list1 ilos.Instance, lists ...ilos.Instance) (ilos.Instance, ilos.Instance) { + lists = append([]ilos.Instance{list1}, lists...) + if err := ensure(class.Function, function); err != nil { + return nil, err + } + if err := ensure(class.List, lists...); err != nil { + return nil, err + } + max := 0.0 + for _, list := range lists { + max = math.Max(max, float64(len(list.(instance.List).Slice()))) + } + result := []ilos.Instance{} + for i := 0; i < int(max); i++ { + arguments := make([]ilos.Instance, len(lists)) + for j, list := range lists { + arguments[j] = list.(instance.List).Nth(i) + } + ret, err := function.(instance.Applicable).Apply(e.NewDynamic(), arguments...) + if err != nil { + return nil, err + } + result = append(result, ret) + } + return List(e, result...) +} + +// Mapc is like mapcar except that the results of applying function are not accumulated; +// list1 is returned. +func Mapc(e env.Environment, function, list1 ilos.Instance, lists ...ilos.Instance) (ilos.Instance, ilos.Instance) { + lists = append([]ilos.Instance{list1}, lists...) + if err := ensure(class.Function, function); err != nil { + return nil, err + } + if err := ensure(class.List, lists...); err != nil { + return nil, err + } + max := 0.0 + for _, list := range lists { + max = math.Max(max, float64(len(list.(instance.List).Slice()))) + } + for i := 0; i < int(max); i++ { + arguments := make([]ilos.Instance, len(lists)) + for j, list := range lists { + arguments[j] = list.(instance.List).Nth(i) + } + if _, err := function.(instance.Applicable).Apply(e.NewDynamic(), arguments...); err != nil { + return nil, err + } + } + return list1, nil +} + +// Mapcan is like mapcar respectively, except that the results of applying +// function are combined into a list by the use of an operation that performs a destructive form of +// append rather than list. +func Mapcan(e env.Environment, function, list1 ilos.Instance, lists ...ilos.Instance) (ilos.Instance, ilos.Instance) { + lists = append([]ilos.Instance{list1}, lists...) + if err := ensure(class.Function, function); err != nil { + return nil, err + } + if err := ensure(class.List, lists...); err != nil { + return nil, err + } + max := 0.0 + for _, list := range lists { + max = math.Max(max, float64(len(list.(instance.List).Slice()))) + } + result := []ilos.Instance{} + for i := 0; i < int(max); i++ { + arguments := make([]ilos.Instance, len(lists)) + for j, list := range lists { + arguments[j] = list.(instance.List).Nth(i) + } + ret, err := function.(instance.Applicable).Apply(e.NewDynamic(), arguments...) + if err != nil { + return nil, err + } + result = append(result, ret) + } + return Append(e, result...) +} + +// Maplist is like mapcar except that function is applied to successive sublists of the lists. +// function is first applied to the lists themselves, and then to the cdr of each list, and then to +// the cdr of the cdr of each list, and so on. +func Maplist(e env.Environment, function, list1 ilos.Instance, lists ...ilos.Instance) (ilos.Instance, ilos.Instance) { + lists = append([]ilos.Instance{list1}, lists...) + if err := ensure(class.Function, function); err != nil { + return nil, err + } + if err := ensure(class.List, lists...); err != nil { + return nil, err + } + max := 0.0 + for _, list := range lists { + max = math.Max(max, float64(len(list.(instance.List).Slice()))) + } + result := []ilos.Instance{} + for i := 0; i < int(max); i++ { + arguments := make([]ilos.Instance, len(lists)) + for j, list := range lists { + arguments[j] = list.(instance.List).NthCdr(i) + } + ret, err := function.(instance.Applicable).Apply(e.NewDynamic(), arguments...) + if err != nil { + return nil, err + } + result = append(result, ret) + } + return List(e, result...) +} + +// Mapl is like maplist except that the results of applying function are not accumulated; +// list1 is returned. +func Mapl(e env.Environment, function, list1 ilos.Instance, lists ...ilos.Instance) (ilos.Instance, ilos.Instance) { + lists = append([]ilos.Instance{list1}, lists...) + if err := ensure(class.Function, function); err != nil { + return nil, err + } + if err := ensure(class.List, lists...); err != nil { + return nil, err + } + max := 0.0 + for _, list := range lists { + max = math.Max(max, float64(len(list.(instance.List).Slice()))) + } + for i := 0; i < int(max); i++ { + arguments := make([]ilos.Instance, len(lists)) + for j, list := range lists { + arguments[j] = list.(instance.List).NthCdr(i) + } + if _, err := function.(instance.Applicable).Apply(e.NewDynamic(), arguments...); err != nil { + return nil, err + } + } + return list1, nil +} + +// Mapcon is like maplist respectively, except that the results of applying +// function are combined into a list by the use of an operation that performs a destructive form of +// append rather than list. +func Mapcon(e env.Environment, function, list1 ilos.Instance, lists ...ilos.Instance) (ilos.Instance, ilos.Instance) { + lists = append([]ilos.Instance{list1}, lists...) + if err := ensure(class.Function, function); err != nil { + return nil, err + } + if err := ensure(class.List, lists...); err != nil { + return nil, err + } + max := 0.0 + for _, list := range lists { + max = math.Max(max, float64(len(list.(instance.List).Slice()))) + } + result := []ilos.Instance{} + for i := 0; i < int(max); i++ { + arguments := make([]ilos.Instance, len(lists)) + for j, list := range lists { + arguments[j] = list.(instance.List).NthCdr(i) + } + ret, err := function.(instance.Applicable).Apply(e.NewDynamic(), arguments...) + if err != nil { + return nil, err + } + result = append(result, ret) + } + return Append(e, result...) +} + +// Assoc returns the first cons if assocation-list contains at least one cons whose car is +// obj (as determined by eql). Otherwise, nil is returned. An error shall be signaled +// if association-list is not a list of conses (error-id. domain-error). +func Assoc(e env.Environment, obj, associationList ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.List, associationList); err != nil { + return nil, err + } + for _, pair := range associationList.(instance.List).Slice() { + if err := ensure(class.Cons, pair); err != nil { + return nil, err + } + if pair.(*instance.Cons).Car == obj { // eql + return pair.(*instance.Cons).Cdr, nil + } + } + return Nil, nil +} + +// Null returns t if obj is nil; otherwise, returns nil obj may be any ISLISP object. +func Null(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if obj == Nil { + return T, nil + } + return Nil, nil +} diff --git a/runtime/logical_connectives.go b/runtime/logical_connectives.go new file mode 100644 index 0000000..6b748de --- /dev/null +++ b/runtime/logical_connectives.go @@ -0,0 +1,61 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" +) + +// Not is the logical “not” (or “¬”). It returns t if obj is nil +// and nil otherwise. obj may be any ISLISP object. +func Not(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if obj == Nil { + return T, nil + } + return Nil, nil +} + +// And is the sequential logical “and” (or “∧”). forms are evaluated +// from left to right until either one of them evaluates to nil or else +// none are left. If one of them evaluates to nil, then nil is returned +// from the and; otherwise, the value of the last evaluated form is returned. +func And(e env.Environment, forms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + var ret ilos.Instance + for _, form := range forms { + //fmt.Printf("%v\n%#v\n", form, e.Variable) + var err ilos.Instance + ret, err = Eval(e, form) + if err != nil { + return nil, err + } + if ret == Nil { + return Nil, nil + } + } + if len(forms) == 0 { + return T, nil + } + return ret, nil +} + +// Or is the sequential logical "or" (or "∨"). forms are evaluated +// from left to right until either one of them evaluates to a non-nil value +// or else none are left. If one of them evaluates to a non-nil value, +// then this non-nil value is returned, otherwise nil is returned. +func Or(e env.Environment, forms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + var ret ilos.Instance + for _, form := range forms { + var err ilos.Instance + ret, err = Eval(e, form) + if err != nil { + return nil, err + } + if ret != Nil { + return ret, nil + } + } + return Nil, nil +} diff --git a/lib/logical_connectives_test.go b/runtime/logical_connectives_test.go similarity index 92% rename from lib/logical_connectives_test.go rename to runtime/logical_connectives_test.go index ce1d666..b30a7b6 100644 --- a/lib/logical_connectives_test.go +++ b/runtime/logical_connectives_test.go @@ -1,8 +1,8 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. -package lib +package runtime import "testing" diff --git a/lib/macros.go b/runtime/macros.go similarity index 53% rename from lib/macros.go rename to runtime/macros.go index fe7ab83..4256522 100644 --- a/lib/macros.go +++ b/runtime/macros.go @@ -1,57 +1,66 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. -package lib +package runtime -import "github.com/islisp-dev/iris/core" +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) // Defmacro defines a named (toplevel) macro. No implicit block with the macro // name is established when the macro-expansion function is invoked. macro-name // must be an identifier whose scope is the current toplevel scope in which the // defmacro form appears. lambda-list is as defined in page 23. The definition // point of macro-name is the closing parenthesis of the lambda-list. -func Defmacro(e core.Environment, macroName, lambdaList core.Instance, forms ...core.Instance) (core.Instance, core.Instance) { - if err := ensure(e, core.SymbolClass, macroName); err != nil { +func Defmacro(e env.Environment, macroName, lambdaList ilos.Instance, forms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Symbol, macroName); err != nil { return nil, err } ret, err := newNamedFunction(e, macroName, lambdaList, forms...) if err != nil { return nil, err } - e.Macro[:1].Define(macroName, ret) + e.Macro.Define(macroName, ret) return macroName, nil } -// Quasiquote ` or quasiquote constructs a list structure. quasiquote, like -// quote, returns its argument unevaluated if no commas or the syntax , -// (unquote) or ,@ (unquote-splicing) appear within the form. , (unquote) syntax -// is valid only within ` (quasiquote) expressions. When appearing within a -// quasiquote the form is evaluated and its result is inserted into the -// quasiquote structure instead of the unquote form. ,@ (unquote-splicing) is -// also syntax valid only within ` expressions. When appearing within a -// quasiquote the expression form must evaluate to a list. The elements of the -// list are spliced into the enclosing list in place of the unquote-splicing -// form sequence. Quasiquote forms may be nested. Substitutions are made only -// for unquoted expressions appearing at the same nesting level, which increases -// by one inside each successive quasiquotation and decreases by one inside each +// Quasiquote ` or quasiquote constructs a list structure. quasiquote, like quote, returns +// its argument unevaluated if no commas or the syntax , (unquote) or ,@ +// (unquote-splicing) appear within the form. +// +// , (unquote) syntax is valid only within ` (quasiquote) expressions. When +// appearing within a quasiquote the form is evaluated and its result is +// inserted into the quasiquote structure instead of the unquote form. +// +// ,@ (unquote-splicing) is also syntax valid only within ` expressions. When +// appearing within a quasiquote the expression form must evaluate to a list. +// The elements of the list are spliced into the enclosing list in place of the +// unquote-splicing form sequence. +// +// Quasiquote forms may be nested. Substitutions are made only for unquoted +// expressions appearing at the same nesting level, which increases by one +// inside each successive quasiquotation and decreases by one inside each // unquotation. -func Quasiquote(e core.Environment, form core.Instance) (core.Instance, core.Instance) { +func Quasiquote(e env.Environment, form ilos.Instance) (ilos.Instance, ilos.Instance) { return expand(e, form, 0) } -func expand(e core.Environment, form core.Instance, level int) (core.Instance, core.Instance) { - if !core.InstanceOf(core.ConsClass, form) { +func expand(e env.Environment, form ilos.Instance, level int) (ilos.Instance, ilos.Instance) { + if !ilos.InstanceOf(class.Cons, form) { return form, nil } // If form is a instance of then, - exp := []core.Instance{} + exp := []ilos.Instance{} cdr := form - for core.InstanceOf(core.ConsClass, cdr) { - cadr := cdr.(*core.Cons).Car - cddr := cdr.(*core.Cons).Cdr + for ilos.InstanceOf(class.Cons, cdr) { + cadr := cdr.(*instance.Cons).Car + cddr := cdr.(*instance.Cons).Cdr // To expand `((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons))) - if core.DeepEqual(cadr, core.NewSymbol("UNQUOTE")) && level == 0 { - caddr := cddr.(*core.Cons).Car + if cadr == instance.NewSymbol("UNQUOTE") && level == 0 { + caddr := cddr.(*instance.Cons).Car elt, err := Eval(e, caddr) if err != nil { return nil, err @@ -59,20 +68,20 @@ func expand(e core.Environment, form core.Instance, level int) (core.Instance, c exp = append(exp, elt) break } - if !core.InstanceOf(core.ConsClass, cadr) { + if !ilos.InstanceOf(class.Cons, cadr) { lst, err := List(e, cadr) if err != nil { return nil, err } exp = append(exp, lst) - cdr = cdr.(*core.Cons).Cdr + cdr = cdr.(*instance.Cons).Cdr continue } // If cadr is a instance of then, - caadr := cadr.(*core.Cons).Car - cdadr := cadr.(*core.Cons).Cdr - if core.DeepEqual(caadr, core.NewSymbol("UNQUOTE")) { - cadadr := cdadr.(*core.Cons).Car - var elt, err core.Instance + caadr := cadr.(*instance.Cons).Car + cdadr := cadr.(*instance.Cons).Cdr + if caadr == instance.NewSymbol("UNQUOTE") { + cadadr := cdadr.(*instance.Cons).Car + var elt, err ilos.Instance if level == 0 { elt, err = Eval(e, cadadr) if err != nil { @@ -83,7 +92,7 @@ func expand(e core.Environment, form core.Instance, level int) (core.Instance, c return nil, err } exp = append(exp, lst) - cdr = cdr.(*core.Cons).Cdr + cdr = cdr.(*instance.Cons).Cdr continue } else { elt, err = expand(e, cadadr, level-1) @@ -99,19 +108,19 @@ func expand(e core.Environment, form core.Instance, level int) (core.Instance, c return nil, err } exp = append(exp, lstlst) - cdr = cdr.(*core.Cons).Cdr + cdr = cdr.(*instance.Cons).Cdr continue } } - if core.DeepEqual(caadr, core.NewSymbol("UNQUOTE-SPLICING")) { - cadadr := cdadr.(*core.Cons).Car + if caadr == instance.NewSymbol("UNQUOTE-SPLICING") { + cadadr := cdadr.(*instance.Cons).Car if level == 0 { elt, err := Eval(e, cadadr) if err != nil { return nil, err } exp = append(exp, elt) - cdr = cdr.(*core.Cons).Cdr + cdr = cdr.(*instance.Cons).Cdr continue } else { elt, err := expand(e, cadadr, level-1) @@ -127,12 +136,12 @@ func expand(e core.Environment, form core.Instance, level int) (core.Instance, c return nil, err } exp = append(exp, lstlst) - cdr = cdr.(*core.Cons).Cdr + cdr = cdr.(*instance.Cons).Cdr continue } } - if core.DeepEqual(caadr, core.NewSymbol("QUASIQUOTE")) { - cadadr := cdadr.(*core.Cons).Car + if caadr == instance.NewSymbol("QUASIQUOTE") { + cadadr := cdadr.(*instance.Cons).Car elt, err := expand(e, cadadr, level+1) if err != nil { return nil, err @@ -146,7 +155,7 @@ func expand(e core.Environment, form core.Instance, level int) (core.Instance, c return nil, err } exp = append(exp, lstlst) - cdr = cdr.(*core.Cons).Cdr + cdr = cdr.(*instance.Cons).Cdr continue } // If the cadr is not special forms then, @@ -162,13 +171,13 @@ func expand(e core.Environment, form core.Instance, level int) (core.Instance, c cdr = cddr continue } - if core.InstanceOf(core.NullClass, cdr) { + if ilos.InstanceOf(class.Null, cdr) { exp = append(exp, Nil) } lst := exp[len(exp)-1] for i := len(exp) - 2; i >= 0; i-- { - if core.InstanceOf(core.ListClass, lst) { - var err core.Instance + if ilos.InstanceOf(class.List, lst) { + var err ilos.Instance lst, err = Append(e, exp[i], lst) if err != nil { return nil, err @@ -178,8 +187,8 @@ func expand(e core.Environment, form core.Instance, level int) (core.Instance, c // If the last cell of forms is not Nil, run this statements at first // the elements of exp is always a instance of because exp isn't appended lists in for-loop - for j := exp[i].(core.List).Length() - 1; j >= 0; j-- { - lst = core.NewCons(exp[i].(core.List).Nth(j), lst) + for j := exp[i].(instance.List).Length() - 1; j >= 0; j-- { + lst = instance.NewCons(exp[i].(instance.List).Nth(j), lst) } } } diff --git a/lib/macros_test.go b/runtime/macros_test.go similarity index 82% rename from lib/macros_test.go rename to runtime/macros_test.go index a309613..d75f7c6 100644 --- a/lib/macros_test.go +++ b/runtime/macros_test.go @@ -1,15 +1,15 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. -package lib +package runtime import "testing" func TestDefmacro(t *testing.T) { tests := []test{ { - exp: `(defmacro caar (x) (list 'car (list 'car x)))`, + exp: "(defmacro caar(x) (list ’car (list ’car x)))", want: "'caar", wantErr: false, }, diff --git a/runtime/namedfunc.go b/runtime/namedfunc.go new file mode 100644 index 0000000..89c50f2 --- /dev/null +++ b/runtime/namedfunc.go @@ -0,0 +1,75 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "fmt" + + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +func checkLambdaList(lambdaList ilos.Instance) ilos.Instance { + if err := ensure(class.List, lambdaList); err != nil { + return err + } + for i, cadr := range lambdaList.(instance.List).Slice() { + if err := ensure(class.Symbol, cadr); err != nil { + return err + } + if cadr == instance.NewSymbol(":REST") || cadr == instance.NewSymbol("&REST") { + if lambdaList.(instance.List).Length() != i+2 { + return instance.NewArityError() + } + } + } + return nil +} + +func newNamedFunction(e env.Environment, functionName, lambdaList ilos.Instance, forms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + lexical := e + if err := ensure(class.Symbol, functionName); err != nil { + return nil, err + } + if err := checkLambdaList(lambdaList); err != nil { + return nil, err + } + parameters := []ilos.Instance{} + variadic := false + for _, cadr := range lambdaList.(instance.List).Slice() { + if cadr == instance.NewSymbol(":REST") || cadr == instance.NewSymbol("&REST") { + variadic = true + } + parameters = append(parameters, cadr) + } + return instance.NewFunction(functionName.(instance.Symbol), func(e env.Environment, arguments ...ilos.Instance) (ilos.Instance, ilos.Instance) { + e.MergeLexical(lexical) + if (variadic && len(parameters)-2 > len(arguments)) || (!variadic && len(parameters) != len(arguments)) { + return nil, instance.NewArityError() + } + for idx := range parameters { + key := parameters[idx] + if key == instance.NewSymbol(":REST") || key == instance.NewSymbol("&REST") { + key := parameters[idx+1] + value, err := List(e, arguments[idx:]...) + if err != nil { + return nil, err + } + if !e.Variable.Define(key, value) { + return nil, instance.NewImmutableBinding() + } + break + } + value := arguments[idx] + if !e.Variable.Define(key, value) { + fmt.Print(key, value) + return nil, instance.NewImmutableBinding() + } + } + return Progn(e, forms...) + }), nil +} diff --git a/runtime/non-local_exits.go b/runtime/non-local_exits.go new file mode 100644 index 0000000..b55630c --- /dev/null +++ b/runtime/non-local_exits.go @@ -0,0 +1,236 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +/* +ISLISP defines three ways in which to perform non-e exits: + Destination Kind Established by Invoked by Operation Performed + block name block return-from lexical exit + tagbody tag tagbody go lexical transfer of control + catch tag atch throw dynamic exit + +A non-e exit, is an operation that forces transfer of control and possibly +data from an invoking special form to a previously established point in a program, +called the destination of the exit. + +A lexical exit is a non-e exit from a return-from form to a block form +which contains it both lexically and dynamically, forcing the block to return +an object specified in the return-from form. + +A dynamic exit is a non-e exit from a throw form to a catch form +which contains it dynamically (but not necessarily lexically), +forcing the catch to return an object specified in the throw form. + +A lexical transfer of control is a non-e exit from a go form to a tagged point +in a tagbody form which contains it both lexically and dynamically. + +When a non-e exit is initiated, any potential destination that was established +more recently than the destination to which control is being transferred +is immediately considered invalid. +*/ + +func Block(e env.Environment, tag ilos.Instance, body ...ilos.Instance) (ilos.Instance, ilos.Instance) { + var err ilos.Instance + tag, err = Eval(e, tag) // Checked at the top of// This function + uid := genUID() + if err != nil { + return nil, err + } + if ilos.InstanceOf(class.Number, tag) || ilos.InstanceOf(class.Character, tag) { + return nil, instance.NewDomainError(tag, class.Object) + } + if !e.BlockTag.Define(tag, uid) { + return nil, instance.NewImmutableBinding() + } + var fail ilos.Instance + sucess := Nil + for _, cadr := range body { + sucess, fail = Eval(e, cadr) + if fail != nil { + if ilos.InstanceOf(class.BlockTag, fail) { + tag1, _ := fail.(instance.Instance).GetSlotValue(instance.NewSymbol("IRIS.TAG"), class.Escape) // Checked at the head of// This condition + uid1, _ := fail.(instance.Instance).GetSlotValue(instance.NewSymbol("IRIS.UID"), class.Escape) + if tag == tag1 && uid == uid1 { + obj, _ := fail.(instance.Instance).GetSlotValue(instance.NewSymbol("IRIS.OBJECT"), class.BlockTag) // Checked at the head of// This condition + return obj, nil + } + } + return nil, fail + } + } + return sucess, nil +} + +func ReturnFrom(e env.Environment, tag, object ilos.Instance) (ilos.Instance, ilos.Instance) { + var err ilos.Instance + tag, err = Eval(e, tag) + if err != nil { + return nil, err + } + if ilos.InstanceOf(class.Number, tag) || ilos.InstanceOf(class.Character, tag) { + return nil, instance.NewDomainError(tag, class.Object) + } + object, err = Eval(e, object) + if err != nil { + return nil, err + } + uid, ok := e.BlockTag.Get(tag) + if !ok { + return nil, instance.NewSimpleError(instance.NewString("%v is not defined as the tag"), tag) + } + return nil, instance.NewBlockTag(tag, uid, object) +} + +func Catch(e env.Environment, tag ilos.Instance, body ...ilos.Instance) (ilos.Instance, ilos.Instance) { + var err ilos.Instance + tag, err = Eval(e, tag) + uid := genUID() + if err != nil { + return nil, err + } + if ilos.InstanceOf(class.Number, tag) || ilos.InstanceOf(class.Character, tag) { + return nil, instance.NewDomainError(tag, class.Object) + } + if !e.CatchTag.Define(tag, uid) { + return nil, instance.NewImmutableBinding() + } + var fail ilos.Instance + sucess := Nil + for _, cadr := range body { + sucess, fail = Eval(e, cadr) + if fail != nil { + if ilos.InstanceOf(class.CatchTag, fail) { + tag1, _ := fail.(instance.Instance).GetSlotValue(instance.NewSymbol("IRIS.TAG"), class.Escape) // Checked at the head of// This condition + uid1, _ := fail.(instance.Instance).GetSlotValue(instance.NewSymbol("IRIS.UID"), class.Escape) // Checked at the head of// This condition + if tag == tag1 && uid == uid1 { + obj, _ := fail.(instance.Instance).GetSlotValue(instance.NewSymbol("IRIS.OBJECT"), class.CatchTag) // Checked at the head of// This condition + return obj, nil + } + } + return nil, fail + } + } + return sucess, nil +} + +func Throw(e env.Environment, tag, object ilos.Instance) (ilos.Instance, ilos.Instance) { + var err ilos.Instance + tag, err = Eval(e, tag) + if err != nil { + return nil, err + } + if ilos.InstanceOf(class.Number, tag) || ilos.InstanceOf(class.Character, tag) { + return nil, instance.NewDomainError(tag, class.Object) + } + object, err = Eval(e, object) + if err != nil { + return nil, err + } + uid, ok := e.CatchTag.Get(tag) + if !ok { + return nil, instance.NewSimpleError(instance.NewString("%v is not defined as the tag"), tag) + + } + return nil, instance.NewCatchTag(tag, uid, object) +} + +func Tagbody(e env.Environment, body ...ilos.Instance) (ilos.Instance, ilos.Instance) { + uid := genUID() + for _, cadr := range body { + if !ilos.InstanceOf(class.Cons, cadr) { + if !e.TagbodyTag.Define(cadr, uid) { // ref cddr + return nil, instance.NewImmutableBinding() + } + } + } + for idx, cadr := range body { + if ilos.InstanceOf(class.Cons, cadr) { + _, fail := Eval(e, cadr) + if fail != nil { + TAG: + if ilos.InstanceOf(class.TagbodyTag, fail) { + tag1, _ := fail.(instance.Instance).GetSlotValue(instance.NewSymbol("IRIS.TAG"), class.Escape) // Checked at the top of// This loop + uid1, _ := fail.(instance.Instance).GetSlotValue(instance.NewSymbol("IRIS.UID"), class.Escape) // Checked at the top of// This loop + found := false + for _, tag := range body { + if tag == tag1 && uid == uid1 { + found = true + break + } + } + if found { + for _, form := range body[idx+1:] { + if ilos.InstanceOf(class.Cons, form) { + _, fail = Eval(e, form) + if fail != nil { + goto TAG + } + } + } + break + } + + } + return nil, fail + } + } + } + return Nil, nil +} + +func Go(e env.Environment, tag ilos.Instance) (ilos.Instance, ilos.Instance) { + uid, ok := e.TagbodyTag.Get(tag) + if !ok { + return nil, instance.NewSimpleError(instance.NewString("%v is not defined as the tag"), tag) + } + return nil, instance.NewTagbodyTag(tag, uid) +} + +// UnwindProtect first evaluates form. Evaluation of the cleanup-forms always +// occurs, regardless of whether the exit is normal or non-e. +// +// If the form exits normally yielding a value R, then if all of the +// cleanup-forms exit normally the value R is returned by the +// unwind-protect form. +// +// If a non-e exit from form occurs, then the cleanup-forms are executed as +// part of that exit, and then if all of the cleanup-forms exit normally the +// original non-e exit continues. +// +// The cleanup-forms are evaluated from left to right, discarding the resulting +// values. If execution of the cleanup-forms finishes normally, exit from the +// unwind-protect form proceeds as described above. It is permissible for a +// cleanup-form to contain a non-e exit from the unwind-protect form, +// subject to the following constraint: +// +// An error shall be signaled if during execution of the cleanup-forms of an +// unwind-protect form, a non-e exit is executed to a destination which has +// been marked as invalid due to some other non-e exit that is already in +// progress (error-id. control-error). +// +// Note: Because ISLISP does not specify an interactive debugger, it is +// unspecified whether or how error recovery can occur interactively if +// programmatic handling fails. The intent is that if the ISLISP processor does +// not terminate abnormally, normal mechanisms for non-e exit (return-from, +// throw, or go) would be used as necessary and would respect these +// cleanup-forms. +func UnwindProtect(e env.Environment, form ilos.Instance, cleanupForms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + ret1, err1 := Eval(e, form) + ret2, err2 := Progn(e, cleanupForms...) + if ilos.InstanceOf(class.Escape, err2) { + return nil, instance.NewControlError() + } + if err2 != nil { + return ret2, err2 + } + return ret1, err1 +} diff --git a/runtime/number.go b/runtime/number.go new file mode 100644 index 0000000..ed026c5 --- /dev/null +++ b/runtime/number.go @@ -0,0 +1,472 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "math" + + "github.com/ta2gch/iris/reader/parser" + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// Numberp returns t if obj is a number (instance of class number); otherwise, +// returns nil. The obj may be any ISLISP object. +func Numberp(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class.Number, obj) { + return T, nil + } + return Nil, nil +} + +// ParseNumber scans (as if by read) and if the resulting lexeme +// is the textual representation of a number, the number it represents is returned. +// +// An error shall be signaled if string is not a string (error-id. domain-error). +// An error shall be signaled if string is not the textual representation +// of a number (error-id. cannot-parse-number). +func ParseNumber(e env.Environment, str ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.String, str); err != nil { + return nil, err + } + ret, err := parser.ParseAtom(string(str.(instance.String))) + if err != nil || !ilos.InstanceOf(class.Number, ret) { + return nil, instance.NewParseError(str, class.Number) + } + return ret, err +} + +// NumberEqual returns t if x1 has the same mathematical value as x2 ; +// otherwise, returns nil. An error shall be signaled if either x1 or x2 is not a number +// (error-id. domain-error). +// +// Note: = differs from eql because = compares only the mathematical values of its arguments, +// whereas eql also compares the representations +func NumberEqual(e env.Environment, x1, x2 ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Number, x1, x2); err != nil { + return nil, err + } + ret := false + switch { + case ilos.InstanceOf(class.Integer, x1) && ilos.InstanceOf(class.Integer, x2): + ret = x1 == x2 + case ilos.InstanceOf(class.Integer, x1) && ilos.InstanceOf(class.Float, x2): + ret = float64(x1.(instance.Integer)) == float64(x2.(instance.Float)) + case ilos.InstanceOf(class.Float, x1) && ilos.InstanceOf(class.Integer, x2): + ret = float64(x1.(instance.Float)) == float64(x2.(instance.Integer)) + case ilos.InstanceOf(class.Float, x1) && ilos.InstanceOf(class.Float, x2): + ret = x1 == x2 + } + if ret { + return T, nil + } + return Nil, nil +} + +// NumberNotEqual returns t if x1 and x2 have mathematically distinct values; +// otherwise, returns nil. An error shall be signaled if either x1 or x2 is not +// a number (error-id. domain-error). +func NumberNotEqual(e env.Environment, x1, x2 ilos.Instance) (ilos.Instance, ilos.Instance) { + ret, err := NumberEqual(e, x1, x2) + if err != nil { + return ret, err + } + return Not(e, ret) +} + +// NumberGreaterThan returns t if x1 is greater than x2 +func NumberGreaterThan(e env.Environment, x1, x2 ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Number, x1, x2); err != nil { + return nil, err + } + ret := false + switch { + case ilos.InstanceOf(class.Integer, x1) && ilos.InstanceOf(class.Integer, x2): + ret = float64(x1.(instance.Integer)) > float64(x2.(instance.Integer)) + case ilos.InstanceOf(class.Integer, x1) && ilos.InstanceOf(class.Float, x2): + ret = float64(x1.(instance.Integer)) > float64(x2.(instance.Float)) + case ilos.InstanceOf(class.Float, x1) && ilos.InstanceOf(class.Integer, x2): + ret = float64(x1.(instance.Float)) > float64(x2.(instance.Integer)) + case ilos.InstanceOf(class.Float, x1) && ilos.InstanceOf(class.Float, x2): + ret = float64(x1.(instance.Float)) > float64(x2.(instance.Float)) + } + if ret { + return T, nil + } + return Nil, nil +} + +// NumberGreaterThanOrEqual returns t if x1 is greater than or = x2 +func NumberGreaterThanOrEqual(e env.Environment, x1, x2 ilos.Instance) (ilos.Instance, ilos.Instance) { + gt, err := NumberGreaterThan(e, x1, x2) + if err != nil { + return nil, err + } + eq, err := NumberEqual(e, x1, x2) + if err != nil { + return nil, err + } + if gt == Nil && eq == Nil { + return Nil, nil + } + return T, nil +} + +// NumberLessThan returns t if x1 is less than x2 +func NumberLessThan(e env.Environment, x1, x2 ilos.Instance) (ilos.Instance, ilos.Instance) { + ge, err := NumberGreaterThanOrEqual(e, x1, x2) + if err != nil { + return nil, err + } + return Not(e, ge) +} + +// NumberLessThanOrEqual returns t if x1 is less than or = x2 +func NumberLessThanOrEqual(e env.Environment, x1, x2 ilos.Instance) (ilos.Instance, ilos.Instance) { + gt, err := NumberGreaterThan(e, x1, x2) + if err != nil { + return nil, err + } + return Not(e, gt) +} + +// Add returns the sum, respectively, of their arguments. If all arguments are integers, +// the result is an integer. If any argument is a float, the result is a float. When given no arguments, +// + returns 0. An error shall be signaled if any x is not a number (error-id. domain-error). +func Add(e env.Environment, x ...ilos.Instance) (ilos.Instance, ilos.Instance) { + flt := false + sum := 0.0 + for _, a := range x { + f, b, err := convFloat64(a) + if err != nil { + return nil, err + } + flt = flt || b + sum += f + } + if flt { + return instance.NewFloat(sum), nil + } + return instance.NewInteger(int(sum)), nil +} + +// Multiply returns the product, respectively, of their arguments. If all arguments are integers, +// the result is an integer. If any argument is a float, the result is a float. When given no arguments, +// Multiply returns 1. An error shall be signaled if any x is not a number (error-id. domain-error). +func Multiply(e env.Environment, x ...ilos.Instance) (ilos.Instance, ilos.Instance) { + flt := false + pdt := 1.0 + for _, a := range x { + f, b, err := convFloat64(a) + if err != nil { + return nil, err + } + pdt *= f + flt = flt || b + } + if flt { + return instance.NewFloat(pdt), nil + } + return instance.NewInteger(int(pdt)), nil +} + +// Substruct returns its additive inverse. An error shall be signaled +// if x is not a number (error-id. domain-error). +// +// If an implementation supports a -0.0 that is distinct from 0.0, then (- 0.0) +// returns -0.0; in implementations where -0.0 and 0.0 are not distinct, (- 0.0) returns 0.0. +// Given more than one argument, x1 … xn , - returns their successive differences, +// x1 −x2 − … −xn. An error shall be signaled if any x is not a number (error-id. domain-error). +func Substruct(e env.Environment, x ilos.Instance, xs ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if len(xs) == 0 { + ret, err := Substruct(e, instance.NewInteger(0), x) + return ret, err + } + sub, flt, err := convFloat64(x) + if err != nil { + return nil, err + } + for _, a := range xs { + f, b, err := convFloat64(a) + if err != nil { + return nil, err + } + sub -= f + flt = flt || b + } + if flt { + return instance.NewFloat(sub), nil + } + return instance.NewInteger(int(sub)), nil +} + +// Quotient returns the quotient of those numbers. The result is an integer if dividend and divisor are integers and divisor evenly divides dividend , otherwise it will be a float. +// +// Given more than two arguments, quotient operates iteratively on each of the divisor1 … divisorn as in dividend /divisor1 / … /divisorn. The type of the result follows from the two-argument case because the three-or-more-argument quotient can be defined as follows: +// An error shall be signaled if dividend is not a number (error-id. domain-error). An error shall be signaled if any divisor is not a number (error-id. domain-error). An error shall be signaled if any divisor is zero (error-id. division-by-zero). +func Quotient(e env.Environment, dividend, divisor1 ilos.Instance, divisor ...ilos.Instance) (ilos.Instance, ilos.Instance) { + divisor = append([]ilos.Instance{divisor1}, divisor...) + quotient, flt, err := convFloat64(dividend) + if err != nil { + return nil, err + } + for _, a := range divisor { + f, b, err := convFloat64(a) + if err != nil { + return nil, err + } + if f == 0.0 { + arguments := Nil + for i := len(divisor) - 1; i >= 0; i-- { + arguments = instance.NewCons(divisor[i], arguments) + } + return nil, instance.NewDivisionByZero(instance.NewSymbol("QUOTIENT"), arguments) + } + if !flt && !b && int(quotient)%int(f) != 0 { + flt = true + } + quotient /= f + } + if flt { + return instance.NewFloat(quotient), nil + } + return instance.NewInteger(int(quotient)), nil +} + +// Reciprocal returns the reciprocal of its argument x ; that is, 1/x . +// An error shall be signaled if x is zero (error-id. division-by-zero). +func Reciprocal(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + return Quotient(e, instance.NewInteger(1), x) +} + +// Max returns the greatest (closest to positive infinity) of its arguments. The comparison is done by >. +// An error shall be signaled if any x is not a number (error-id. domain-error). +func Max(e env.Environment, x ilos.Instance, xs ...ilos.Instance) (ilos.Instance, ilos.Instance) { + max := x + for _, y := range xs { + ret, err := NumberGreaterThan(e, y, max) + if err != nil { + return nil, err + } + if ret == T { + max = y + } + } + return max, nil +} + +// Min returns the least (closest to negative infinity) of its arguments. The comparison is done by <. +// An error shall be signaled if any x is not a number (error-id. domain-error). +func Min(e env.Environment, x ilos.Instance, xs ...ilos.Instance) (ilos.Instance, ilos.Instance) { + min := x + for _, y := range xs { + ret, err := NumberLessThan(e, y, min) + if err != nil { + return nil, err + } + if ret == T { + min = y + } + } + return min, nil +} + +// Abs returns the absolute value of its argument. +// An error shall be signaled if x is not a number (error-id. domain-error). +func Abs(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + ret, err := NumberLessThan(e, x, instance.NewInteger(0)) + if err != nil { + return nil, err + } + if ret == T { + return Substruct(e, x) + } + return x, nil +} + +// Exp returns e raised to the power x , where e is the base of the natural logarithm. +// An error shall be signaled if x is not a number (error-id. domain-error). +func Exp(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + f, _, err := convFloat64(x) + if err != nil { + return nil, err + } + return instance.NewFloat(math.Exp(f)), nil +} + +// Log returns the natural logarithm of x. +// An error shall be signaled if x is not a positive number (error-id. domain-error). +func Log(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + f, _, err := convFloat64(x) + if err != nil { + return nil, err + } + if f <= 0.0 { + return nil, instance.NewDomainError(x, class.Number) + } + return instance.NewFloat(math.Log(f)), nil +} + +// Expt returns x1 raised to the power x2. The result will be +// an integer if x1 is an integer and x2 is a non-negative integer. +// An error shall be signaled if x1 is zero and x2 is negative, +// or if x1 is zero and x2 is a zero float, or if x1 is negative +// and x2 is not an integer. +func Expt(e env.Environment, x1, x2 ilos.Instance) (ilos.Instance, ilos.Instance) { + a, af, err := convFloat64(x1) + if err != nil { + return nil, err + } + b, bf, err := convFloat64(x2) + if err != nil { + return nil, err + } + if !af && !bf && b >= 0 { + return instance.NewInteger(int(math.Pow(a, b))), nil + } + if (a == 0 && b < 0) || (a == 0 && bf && b == 0) || (a < 0 && bf) { + operation := instance.NewSymbol("EXPT") + operands, err := List(e, x1, x2) + if err != nil { + return nil, err + } + return nil, instance.NewArithmeticError(operation, operands) + } + return instance.NewFloat(math.Pow(a, b)), nil +} + +// Sqrt returns the non-negative square root of x. An error shall be signaled +// if x is not a non-negative number (error-id. domain-error). +func Sqrt(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + a, _, err := convFloat64(x) + if err != nil { + return nil, err + } + if a < 0.0 { + return nil, instance.NewDomainError(x, class.Number) + } + if math.Ceil(math.Sqrt(a)) == math.Sqrt(a) { + return instance.NewInteger(int(math.Sqrt(a))), nil + } + return instance.NewFloat(math.Sqrt(a)), nil +} + +// Pi is an approximation of π. +var Pi = instance.NewFloat(3.141592653589793) + +// Sin returns the sine of x . x must be given in radians. +// An error shall be signaled if x is not a number (error-id. domain-error). +func Sin(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + a, _, err := convFloat64(x) + if err != nil { + return nil, err + } + return instance.NewFloat(math.Sin(a)), nil +} + +// Cos returns the cosine of x . x must be given in radians. +// An error shall be signaled if x is not a number (error-id. domain-error). +func Cos(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + a, _, err := convFloat64(x) + if err != nil { + return nil, err + } + return instance.NewFloat(math.Cos(a)), nil +} + +// Tan returns the tangent of x . x must be given in radians. +// An error shall be signaled if x is not a number (error-id. domain-error). +func Tan(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + a, _, err := convFloat64(x) + if err != nil { + return nil, err + } + return instance.NewFloat(math.Tan(a)), nil +} + +// Atan returns the arc tangent of x. +// The result is a (real) number that lies between −π/2 and π/2 (both exclusive). +// An error shall be signaled if x is not a number (error-id. domain-error). +func Atan(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + a, _, err := convFloat64(x) + if err != nil { + return nil, err + } + return instance.NewFloat(math.Atan(a)), nil +} + +// Atan2 returns the phase of its representation in polar coordinates. +// If x1 is zero and x2 is negative, the result is positive. +// If x1 and x2 are both zero, the result is implementation defined. +// +// An error shall be signaled if x is not a number (error-id. domain-error). +// The value of atan2 is always between −π (exclusive) and π (inclusive) when minus zero +// is not supported; when minus zero is supported, the range includes −π. +// +// The signs of x1 (indicated as y) and x2 (indicated as x) are used to derive quadrant information. +func Atan2(e env.Environment, x1, x2 ilos.Instance) (ilos.Instance, ilos.Instance) { + a, _, err := convFloat64(x1) + if err != nil { + return nil, err + } + b, _, err := convFloat64(x2) + if err != nil { + return nil, err + } + if a == 0 && b == 0 { + operation := instance.NewSymbol("ATAN2") + operands, err := List(e, x1, x2) + if err != nil { + return nil, err + } + return nil, instance.NewArithmeticError(operation, operands) + } + return instance.NewFloat(math.Atan2(a, b)), nil +} + +// Sinh returns the hyperbolic sine of x . x must be given in radians. +// An error shall be signaled if x is not a number (error-id. domain-error). +func Sinh(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + a, _, err := convFloat64(x) + if err != nil { + return nil, err + } + return instance.NewFloat(math.Sinh(a)), nil +} + +// Cosh returns the hyperbolic cosine of x . x must be given in radians. +// An error shall be signaled if x is not a number (error-id. domain-error). +func Cosh(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + a, _, err := convFloat64(x) + if err != nil { + return nil, err + } + return instance.NewFloat(math.Cosh(a)), nil +} + +// Tanh returns the hyperbolic tangent of x . x must be given in radians. +// An error shall be signaled if x is not a number (error-id. domain-error). +func Tanh(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + a, _, err := convFloat64(x) + if err != nil { + return nil, err + } + return instance.NewFloat(math.Tanh(a)), nil +} + +// Atanh returns the hyperbolic arc tangent of x. +// An error shall be signaled if x is not a number with absolute value less than 1 (error-id. domain-error). +func Atanh(e env.Environment, x ilos.Instance) (ilos.Instance, ilos.Instance) { + a, _, err := convFloat64(x) + if err != nil { + return nil, err + } + if math.Abs(a) >= 1 { + instance.NewDomainError(x, class.Number) + } + return instance.NewFloat(math.Atanh(a)), nil +} diff --git a/runtime/runtime.go b/runtime/runtime.go new file mode 100644 index 0000000..7056f4c --- /dev/null +++ b/runtime/runtime.go @@ -0,0 +1,260 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "math" + "os" + "regexp" + "strings" + + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +var TopLevel = env.NewEnvironment(instance.NewStream(os.Stdin, nil), instance.NewStream(nil, os.Stdout), instance.NewStream(nil, os.Stderr), nil) +var Version = "0.1.0" + +func defspecial2(name string, function interface{}) { + name = regexp.MustCompile(`(.)([A-Z])`).ReplaceAllString(name, "$1-$2") + name = strings.ToUpper(name) + symbol := instance.NewSymbol(name) + TopLevel.Special.Define(symbol, instance.NewFunction(func2symbol(function), function)) +} + +func defun2(name string, function interface{}) { + name = regexp.MustCompile(`(.)([A-Z])`).ReplaceAllString(name, "$1-$2") + name = strings.ToUpper(name) + symbol := instance.NewSymbol(name) + TopLevel.Function.Define(symbol, instance.NewFunction(symbol, function)) +} +func defglobal(name string, value ilos.Instance) { + name = regexp.MustCompile(`(.)([A-Z])`).ReplaceAllString(name, "$1-$2") + name = strings.ToUpper(name) + symbol := instance.NewSymbol(name) + TopLevel.Variable.Define(symbol, value) +} +func init() { + defglobal("*pi*", instance.Float(math.Pi)) + defglobal("*MostPositiveFloat*", MostPositiveFloat) + defglobal("*MostNegativeFloat*", MostNegativeFloat) + defun2("-", Substruct) + defun2("+", Add) + defun2("*", Multiply) + defun2("<", NumberLessThan) + defun2("<=", NumberLessThanOrEqual) + defun2("=", NumberEqual) + defun2(">", NumberGreaterThan) + defun2(">=", NumberGreaterThanOrEqual) + defspecial2("Quasiquote", Quasiquote) + defun2("Abs", Abs) + defspecial2("And", And) + defun2("Append", Append) + defun2("Apply", Apply) + defun2("Aref", Aref) + defun2("Assoc", Assoc) + // TODO: defspecial2("Assure", Assure) + defun2("Atan", Atan) + defun2("Atan2", Atan2) + defun2("Atanh", Atanh) + defun2("BasicArray*P", BasicArrayStarP) + defun2("BasicArrayP", BasicArrayP) + defun2("BasicVectorP", BasicVectorP) + defspecial2("Block", Block) + defun2("Car", Car) + defspecial2("Case", Case) + defspecial2("CaseUsing", CaseUsing) + defspecial2("Catch", Catch) + defun2("Cdr", Cdr) + defun2("Ceiling", Ceiling) + defun2("Cerror", Cerror) + defun2("CharIndex", CharIndex) + defun2("char/=", CharNotEqual) + defun2("Char<", CharLessThan) + defun2("Char<=", CharLessThanOrEqual) + defun2("Char=", CharEqual) + defun2("Char>", CharGreaterThan) + defun2("Char>=", CharGreaterThanOrEqual) + defun2("Characterp", Characterp) + defspecial2("Class", Class) + defun2("ClassOf", ClassOf) + defun2("Close", Close) + // TODO defun2("Coercion", Coercion) + defspecial2("Cond", Cond) + defun2("ConditionContinuable", ConditionContinuable) + defun2("Cons", Cons) + defun2("Consp", Consp) + defun2("ContinueCondition", ContinueCondition) + // TODO defun2("Convert", Convert) + defun2("Cos", Cos) + defun2("Cosh", Cosh) + defun2("Create", Create) //TODO Change to generic function + defun2("CreateArray", CreateArray) + defun2("CreateList", CreateList) + defun2("CreateString", CreateString) + defun2("CreateStringInputStream", CreateStringInputStream) + defun2("CreateStringOutputStream", CreateStringOutputStream) + defun2("CreateVector", CreateVector) + defspecial2("Defclass", Defclass) + defspecial2("Defconstant", Defconstant) + defspecial2("Defdynamic", Defdynamic) + defspecial2("Defgeneric", Defgeneric) + defspecial2("Defmethod", Defmethod) + defspecial2("Defglobal", Defglobal) + defspecial2("Defmacro", Defmacro) + defspecial2("Defun", Defun) + defun2("Div", Div) + defspecial2("Dynamic", Dynamic) + defspecial2("DynamicLet", DynamicLet) + defun2("Elt", Elt) + defun2("Eq", Eq) + defun2("Eql", Eql) + defun2("Equal", Equal) + defun2("Error", Error) + defun2("ErrorOutput", ErrorOutput) + defun2("Exp", Exp) + defun2("Expt", Expt) + // TODO defun2("FileLength", FileLength) + // TODO defun2("FilePosition", FilePosition) + // TODO defun2("FinishOutput", FinishOutput) + defspecial2("Flet", Flet) + defun2("Float", Float) + defun2("Floatp", Floatp) + defun2("Floor", Floor) + defspecial2("For", For) + defun2("Format", Format) // TODO full syntax + // TODO other print function + defun2("Funcall", Funcall) + defspecial2("Function", Function) + defun2("Functionp", Functionp) + defun2("Garef", Garef) + defun2("Gcd", Gcd) + defun2("GENERAL-ARRAY*-P", GeneralArrayStarP) + defun2("GeneralVectorP", GeneralVectorP) + // TODO defun2("GenericFunctionP", GenericFunctionP) + defun2("Gensym", Gensym) + // TODO defun2("GetInternalRealTime", GetInternalRealTime) + // TODO defun2("GetInternalRunTime", GetInternalRunTime) + defun2("GetOutputStreamString", GetOutputStreamString) + // TODO defun2("GetUniversalTime", GetUniversalTime) + defspecial2("Go", Go) + // TODO defun2("Identity", Identity) + defspecial2("If", If) + // TODO defspecial2("IgnoreErrors", IgnoreErrors) + defun2("InitializeObject", InitializeObject) // TODO change generic function + defun2("InputStreamP", InputStreamP) + defun2("Instancep", Instancep) + // TODO defun2("Integer", Integer) + defun2("Integerp", Integerp) + // TODO defun2("InternalTimeUnitsPerSecond", InternalTimeUnitsPerSecond) + defun2("Isqrt", Isqrt) + defspecial2("Labels", Labels) + defspecial2("Lambda", Lambda) + defun2("Lcm", Lcm) + defun2("Length", Length) + defspecial2("Let", Let) + defspecial2("LET*", LetStar) + defun2("List", List) + defun2("Listp", Listp) + defun2("Log", Log) + defun2("MapInto", MapInto) + defun2("Mapc", Mapc) + defun2("Mapcan", Mapcan) + defun2("Mapcar", Mapcar) + defun2("Mapcon", Mapcon) + defun2("Mapl", Mapl) + defun2("Maplist", Maplist) + defun2("Max", Max) + defun2("Member", Member) + defun2("Min", Min) + defun2("Mod", Mod) + defglobal("NIL", Nil) + defun2("Not", Not) + defun2("Nreverse", Nreverse) + defun2("Null", Null) + defun2("Numberp", Numberp) + defun2("OpenInputFile", OpenInputFile) + defun2("OpenIoFile", OpenIoFile) + defun2("OpenOutputFile", OpenOutputFile) + defun2("OpenStreamP", OpenStreamP) + defspecial2("Or", Or) + defun2("OutputStreamP", OutputStreamP) + defun2("ParseNumber", ParseNumber) + // TODO defun2("PreviewChar", PreviewChar) + // TODO defun2("ProveFile", ProveFile) + defspecial2("Progn", Progn) + defun2("Property", Property) + defspecial2("Quasiquote", Quasiquote) + defspecial2("Quote", Quote) + defun2("Quotient", Quotient) + defun2("Read", Read) + // TODO defun2("ReadByte", ReadByte) + defun2("ReadChar", ReadChar) + defun2("ReadLine", ReadLine) + defun2("RemoveProperty", RemoveProperty) + defun2("ReportCondition", ReportCondition) + defspecial2("ReturnFrom", ReturnFrom) + defun2("Reverse", Reverse) + defun2("Round", Round) + defun2("SetAref", SetAref) + defun2("(setf aref)", SetAref) + defun2("SetCar", SetCar) + defun2("(setf car)", SetCar) + defun2("SetCdr", SetCdr) + defun2("(setf cdr)", SetCdr) + defun2("SetDynamic", SetDynamic) + defun2("(setf dynamic)", SetDynamic) + defun2("SetElt", SetElt) + defun2("(setf elt)", SetElt) + // TODO defun2("SetFilePosition", SetFilePosition) + defun2("SetGaref", SetGaref) + defun2("(setf garef)", SetGaref) + defun2("SetProperty", SetProperty) + defun2("(setf property)", SetProperty) + defspecial2("Setf", Setf) + defspecial2("Setq", Setq) + defun2("SignalCondition", SignalCondition) + // TODO defun2("SimpleErrorFormatArguments", SimpleErrorFormatArguments) + // TODO defun2("SimpleErrorFormatString", SimpleErrorFormatString) + defun2("Sin", Sin) + defun2("Sinh", Sinh) + defun2("Sqrt", Sqrt) + defun2("StandardInput", StandardInput) + defun2("StandardOutput", StandardOutput) + defun2("StreamReadyP", StreamReadyP) + defun2("Streamp", Streamp) + defun2("StringAppend", StringAppend) + defun2("StringIndex", StringIndex) + defun2("String/=", StringNotEqual) + defun2("String<", StringGreaterThan) + defun2("String<=", StringGreaterThan) + defun2("String=", StringEqual) + defun2("String>", StringGreaterThan) + defun2("String>=", StringGreaterThanOrEqual) + defun2("Stringp", Stringp) + defun2("Subclassp", Subclassp) + defun2("Subseq", Subseq) + defun2("Symbolp", Symbolp) + defglobal("T", T) + defspecial2("Tagbody", Tagbody) + defspecial2("Tan", Tan) + defspecial2("Tanh", Tanh) + // TODO defspecial2("The", The) + defspecial2("Throw", Throw) + defun2("Truncate", Truncate) + // TODO defun2("UndefinedEntityName", UndefinedEntityName) + // TODO defun2("UndefinedEntityNamespace", UndefinedEntityNamespace) + defspecial2("UnwindProtect", UnwindProtect) + defun2("Vector", Vector) + defspecial2("While", While) + defspecial2("WithErrorOutput", WithErrorOutput) + defspecial2("WithHandler", WithHandler) + defspecial2("WithOpenInputFile", WithOpenInputFile) + defspecial2("WithOpenOutputFile", WithOpenOutputFile) + defspecial2("WithStandardInput", WithStandardInput) + defspecial2("WithStandardOutput", WithStandardOutput) + // TODO defun2("WriteByte", WriteByte) +} diff --git a/runtime/sequence_function.go b/runtime/sequence_function.go new file mode 100644 index 0000000..dc1540d --- /dev/null +++ b/runtime/sequence_function.go @@ -0,0 +1,217 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "math" + + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// Length returns the length of sequence as an integer greater than or equal to 0. +// +// When sequence is a basic-vector, length returns its dimension. +// +// When sequence is a list, the result is the number of elements in the list; if an element is +// itself a list, the elements within this sublist are not counted. In the case of dotted lists, +// length returns the number of conses at the uppermost level of the list. For example, (length ' +// (a b . c)) ⇒ 2, since '(a b . c) ≡ (cons 'a (cons 'b 'c)). +// +// An error shall be signaled if sequence is not a basic-vector or a list +// (error-id. domain-error). +func Length(e env.Environment, sequence ilos.Instance) (ilos.Instance, ilos.Instance) { + switch { + case ilos.InstanceOf(class.String, sequence): + return instance.NewInteger(len(sequence.(instance.String))), nil + case ilos.InstanceOf(class.GeneralVector, sequence): + return instance.NewInteger(len(sequence.(instance.GeneralVector))), nil + case ilos.InstanceOf(class.List, sequence): + return instance.NewInteger(sequence.(instance.List).Length()), nil + } + // TODO: class.Seq + return nil, instance.NewDomainError(sequence, class.Object) +} + +// Elt returns the element of sequence that has index z. Indexing is 0-based; i.e., z = 0 +// designates the first element, Given a sequence and an integer z satisfying 0 ≤ z < (length +// sequence). An error shall be signaled if z is an integer outside of the mentioned range +// (error-id. index-out-of-range). +// +// An error shall be signaled if sequence is not a basic-vector or a list or if z is not an +// integer (error-id. domain-error). +func Elt(e env.Environment, sequence, z ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Integer, z); err != nil { + return nil, err + } + switch { + case ilos.InstanceOf(class.String, sequence): + seq := sequence.(instance.String) + idx := int(z.(instance.Integer)) + if idx > 0 && len(seq) <= idx { + return nil, instance.NewIndexOutOfRange() + } + return instance.NewCharacter(seq[idx]), nil + case ilos.InstanceOf(class.GeneralVector, sequence): + seq := sequence.(instance.GeneralVector) + idx := int(z.(instance.Integer)) + if idx > 0 && len(seq) <= idx { + return nil, instance.NewIndexOutOfRange() + } + return seq[idx], nil + case ilos.InstanceOf(class.List, sequence): + seq := sequence.(instance.List).Slice() + idx := int(z.(instance.Integer)) + if idx > 0 && len(seq) <= idx { + return nil, instance.NewIndexOutOfRange() + } + return seq[idx], nil + } + return nil, instance.NewDomainError(sequence, class.Object) + +} + +// SetElt is that these replace the object obtainable by elt with obj. The returned value is obj. +// +// An error shall be signaled if z is an integer outside of the valid range of indices +// (error-id. index-out-of-range). An error shall be signaled if sequence is not a basic-vector +// or a list or if z is not an integer (error-id. domain-error). obj may be any ISLISP object. +func SetElt(e env.Environment, obj, sequence, z ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Integer, z); err != nil { + return nil, err + } + switch { + case ilos.InstanceOf(class.String, sequence): + seq := sequence.(instance.String) + idx := int(z.(instance.Integer)) + if idx > 0 && len(seq) <= idx { + return nil, instance.NewIndexOutOfRange() + } + if err := ensure(class.Character, obj); err != nil { + return nil, err + } + seq[idx] = rune(obj.(instance.Character)) + return obj, nil + case ilos.InstanceOf(class.GeneralVector, sequence): + seq := sequence.(instance.GeneralVector) + idx := int(z.(instance.Integer)) + if idx > 0 && len(seq) <= idx { + return nil, instance.NewIndexOutOfRange() + } + seq[idx] = obj + return obj, nil + case ilos.InstanceOf(class.List, sequence): + seq := sequence.(instance.List).Slice() + idx := int(z.(instance.Integer)) + if idx > 0 && len(seq) <= idx { + return nil, instance.NewIndexOutOfRange() + } + for idx != 0 && ilos.InstanceOf(class.Cons, sequence) { + idx-- + sequence = sequence.(*instance.Cons).Cdr + } + sequence.(*instance.Cons).Car = obj + return obj, nil + } + return nil, instance.NewDomainError(sequence, class.Object) +} + +// Subseq returns the subsequence of length z2 − z1, containing the elements with indices from +// z1 (inclusive) to z2 (exclusive). The subsequence is newly allocated, and has the same class +// as sequence, Given a sequence sequence and two integers z1 and z2 satisfying 0 ≤ z1 ≤ z2 ≤ +// (length sequence) +// +// An error shall be signaled if the requested subsequence cannot be allocated (error-id. +// cannot-create-sequence). An error shall be signaled if z1 or z2 are outside of the bounds +// mentioned (error-id. index-out-of-range). An error shall be signaled if sequence is not a +// basic-vector or a list, or if z1 is not an integer, or if z2 is not an integer +// (error-id. domain-error). +func Subseq(e env.Environment, sequence, z1, z2 ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Integer, z1, z2); err != nil { + return nil, err + } + start := int(z1.(instance.Integer)) + end := int(z2.(instance.Integer)) + switch { + case ilos.InstanceOf(class.String, sequence): + seq := sequence.(instance.String) + if !(0 <= start && start < len(seq) && 0 <= end && end < len(seq) && start <= end) { + return nil, instance.NewIndexOutOfRange() + } + return seq[start:end], nil + case ilos.InstanceOf(class.GeneralVector, sequence): + seq := sequence.(instance.GeneralVector) + if !(0 <= start && start < len(seq) && 0 <= end && end < len(seq) && start <= end) { + return nil, instance.NewIndexOutOfRange() + } + return seq[start:end], nil + case ilos.InstanceOf(class.List, sequence): + seq := sequence.(instance.List).Slice() + if !(0 < start && start < len(seq) && 0 < end && end < len(seq) && start <= end) { + return nil, instance.NewIndexOutOfRange() + } + return List(e, seq[start:end]...) + } + return nil, instance.NewDomainError(sequence, class.Object) +} + +// Destructively modifies destination to contain the results of applying function to +// successive elements in the sequences. The destination is returned. +// +// If destination and each element of sequences are not all the same length, the +// iteration terminates when the shortest sequence (of any of the sequences or the +// destination) is exhausted. +// +// The calls to function proceed from left to right, so that if function has +// side-effects, it can rely upon being called first on all of the elements with index +// 0, then on all of those numbered 1, and so on. +// +// An error shall be signaled if destination is not a basic-vector or a list +// (error-id. domain-error). +// +// An error shall be signaled if any sequence is not a basic-vector or a list +// (error-id. domain-error). +func MapInto(e env.Environment, destination, function ilos.Instance, sequences ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.List, append(sequences, destination)...); err != nil { + if err := ensure(class.BasicVector, append(sequences, destination)...); err != nil { + return nil, err + } + } + if err := ensure(class.Function, function); err != nil { + return nil, err + } + max := 0.0 + for _, seq := range sequences { + switch { + case ilos.InstanceOf(class.String, seq): + max = math.Max(max, float64(len(seq.(instance.String)))) + case ilos.InstanceOf(class.GeneralVector, seq): + max = math.Max(max, float64(len(seq.(instance.GeneralVector)))) + case ilos.InstanceOf(class.List, seq): + max = math.Max(max, float64(len(seq.(instance.List).Slice()))) + } + } + for i := 0; i < int(max); i++ { + arguments := make([]ilos.Instance, int(max)) + for _, seq := range sequences { + var err ilos.Instance + arguments[i], err = Elt(e, seq, instance.NewInteger(i)) + if err != nil { + return nil, err + } + } + ret, err := function.(instance.Applicable).Apply(e.NewDynamic(), arguments...) + if err != nil { + return nil, err + } + _, err = SetElt(e, ret, destination, instance.NewInteger(i)) + if err != nil { + return nil, err + } + } + return destination, nil +} diff --git a/runtime/sequencing_form.go b/runtime/sequencing_form.go new file mode 100644 index 0000000..640cd9f --- /dev/null +++ b/runtime/sequencing_form.go @@ -0,0 +1,27 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" +) + +// Progn allows a series of forms to be evaluated, where normally only one could be used. +// +// The result of evaluation of the last form of form* is returned. All the forms are +// evaluated from left to right. The values of all the forms but the last are discarded, +// so they are executed only for their side-effects. progn without forms returns nil. +func Progn(e env.Environment, forms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + var err ilos.Instance + ret := Nil + for _, form := range forms { + ret, err = Eval(e, form) + if err != nil { + return nil, err + } + } + return ret, nil +} diff --git a/runtime/stream.go b/runtime/stream.go new file mode 100644 index 0000000..66d4ada --- /dev/null +++ b/runtime/stream.go @@ -0,0 +1,321 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "bufio" + "bytes" + "fmt" + "os" + "regexp" + "strings" + + "github.com/ta2gch/iris/reader/parser" + "github.com/ta2gch/iris/reader/tokenizer" + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +func Streamp(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class.Stream, obj) { + return T, nil + } + return Nil, nil +} + +func OpenStreamP(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + return T, nil +} + +func InputStreamP(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if s, ok := obj.(instance.Stream); ok && s.Reader != nil { + return T, nil + } + return Nil, nil +} + +func OutputStreamP(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if s, ok := obj.(instance.Stream); ok && s.Writer != nil { + return T, nil + } + return Nil, nil +} + +func StandardInput(e env.Environment) (ilos.Instance, ilos.Instance) { + return e.StandardInput, nil +} + +func StandardOutput(e env.Environment) (ilos.Instance, ilos.Instance) { + return e.StandardOutput, nil +} + +func ErrorOutput(e env.Environment) (ilos.Instance, ilos.Instance) { + return e.ErrorOutput, nil +} + +func WithStandardInput(e env.Environment, streamForm ilos.Instance, forms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + var err ilos.Instance + e.StandardInput, err = Eval(e, streamForm) + if err != nil { + return nil, err + } + if err := ensure(class.Stream, e.ErrorOutput); err != nil { + return nil, err + } + return Progn(e, forms...) +} + +func WithStandardOutput(e env.Environment, streamForm ilos.Instance, forms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + var err ilos.Instance + e.StandardOutput, err = Eval(e, streamForm) + if err != nil { + return nil, err + } + if err := ensure(class.Stream, e.ErrorOutput); err != nil { + return nil, err + } + return Progn(e, forms...) +} + +func WithErrorOutput(e env.Environment, streamForm ilos.Instance, forms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + var err ilos.Instance + e.ErrorOutput, err = Eval(e, streamForm) + if err != nil { + return nil, err + } + if err := ensure(class.Stream, e.ErrorOutput); err != nil { + return nil, err + } + return Progn(e, forms...) +} + +func OpenInputFile(e env.Environment, filename ilos.Instance, elementClass ...ilos.Instance) (ilos.Instance, ilos.Instance) { + // TODO: elementClass + if err := ensure(class.String, filename); err != nil { + return nil, err + } + file, err := os.Open(string(filename.(instance.String))) + if err != nil { + return nil, nil // Error File Not Found + } + return instance.NewStream(file, nil), nil +} + +func OpenOutputFile(e env.Environment, filename ilos.Instance, elementClass ...ilos.Instance) (ilos.Instance, ilos.Instance) { + // TODO: elementClass + if err := ensure(class.String, filename); err != nil { + return nil, err + } + file, err := os.Open(string(filename.(instance.String))) + if err != nil { + return nil, nil // Error File Not Found + } + return instance.NewStream(nil, file), nil +} + +func OpenIoFile(e env.Environment, filename ilos.Instance, elementClass ...ilos.Instance) (ilos.Instance, ilos.Instance) { + // TODO: elementClass + if err := ensure(class.String, filename); err != nil { + return nil, err + } + file, err := os.Open(string(filename.(instance.String))) + if err != nil { + return nil, nil // Error File Not Found + } + return instance.NewStream(file, file), nil +} + +func WithOpenInputFile(e env.Environment, fileSpec ilos.Instance, forms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Cons, fileSpec); err != nil { + return nil, err + } + n := fileSpec.(*instance.Cons).Car + s, err := Eval(e, instance.NewCons(instance.NewSymbol("OPEN-INPUT-FILE"), fileSpec.(*instance.Cons).Cdr)) + if err != nil { + return nil, err + } + e.Variable.Define(n, s) + return Progn(e, forms...) +} + +func WithOpenOutputFile(e env.Environment, fileSpec ilos.Instance, forms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Cons, fileSpec); err != nil { + return nil, err + } + n := fileSpec.(*instance.Cons).Car + s, err := Eval(e, instance.NewCons(instance.NewSymbol("OPEN-OUTPUT-FILE"), fileSpec.(*instance.Cons).Cdr)) + if err != nil { + return nil, err + } + e.Variable.Define(n, s) + return Progn(e, forms...) +} + +func WithOpenIoFile(e env.Environment, fileSpec ilos.Instance, forms ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Cons, fileSpec); err != nil { + return nil, err + } + n := fileSpec.(*instance.Cons).Car + s, err := Eval(e, instance.NewCons(instance.NewSymbol("OPEN-IO-FILE"), fileSpec.(*instance.Cons).Cdr)) + if err != nil { + return nil, err + } + e.Variable.Define(n, s) + return Progn(e, forms...) +} + +func Close(e env.Environment, stream ilos.Instance) (ilos.Instance, ilos.Instance) { + // It works on file or std stream. + if err := ensure(class.Stream, stream); err != nil { + return nil, err + } + if stream.(instance.Stream).Reader != nil { + stream.(instance.Stream).Reader.(*os.File).Close() + } + if stream.(instance.Stream).Writer != nil { + stream.(instance.Stream).Writer.(*os.File).Close() + } + return Nil, nil +} + +func FlushOutput(e env.Environment, stream ilos.Instance) (ilos.Instance, ilos.Instance) { + // It works on file or std stream. + if err := ensure(class.Stream, stream); err != nil { + return nil, err + } + if stream.(instance.Stream).Writer != nil { + stream.(instance.Stream).Writer.(*os.File).Close() + } + return Nil, nil +} + +func CreateStringInputStream(e env.Environment, str ilos.Instance) (ilos.Instance, ilos.Instance) { + return instance.NewStream(strings.NewReader(string(str.(instance.String))), nil), nil +} + +func CreateStringOutputStream(e env.Environment) (ilos.Instance, ilos.Instance) { + return instance.NewStream(nil, new(bytes.Buffer)), nil +} + +func GetOutputStreamString(e env.Environment, stream ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Stream, stream); err != nil { + return nil, err + } + return instance.NewString(stream.(instance.Stream).Writer.(*bytes.Buffer).String()), nil +} + +func Read(e env.Environment, options ...ilos.Instance) (ilos.Instance, ilos.Instance) { + s := e.StandardInput + if len(options) > 0 { + s = options[0] + } + if b, _ := InputStreamP(e, s); b == Nil { + return nil, nil // throw Error + } + eosErrorP := true + if len(options) > 1 { + if options[1] == Nil { + eosErrorP = false + } + } + eosValue := Nil + if len(options) > 2 { + if options[2] == Nil { + eosValue = options[2] + } + } + v, err := parser.Parse(tokenizer.Tokenize(s.(instance.Stream).Reader)) + if err != nil && ilos.InstanceOf(class.EndOfStream, err) { + if eosErrorP { + return nil, err + } + return eosValue, nil + } + return v, nil +} + +func ReadChar(e env.Environment, options ...ilos.Instance) (ilos.Instance, ilos.Instance) { + s := e.StandardInput + if len(options) > 0 { + s = options[0] + } + if b, _ := InputStreamP(e, s); b == Nil { + return nil, nil // throw Error + } + eosErrorP := true + if len(options) > 1 { + if options[1] == Nil { + eosErrorP = false + } + } + eosValue := Nil + if len(options) > 2 { + if options[2] == Nil { + eosValue = options[2] + } + } + v, _, err := bufio.NewReader(s.(instance.Stream).Reader).ReadRune() + if err != nil { + if eosErrorP { + return nil, instance.Create(e, class.EndOfStream) + } + return eosValue, nil + } + return instance.NewCharacter(v), nil +} + +func ReadLine(e env.Environment, options ...ilos.Instance) (ilos.Instance, ilos.Instance) { + s := e.StandardInput + if len(options) > 0 { + s = options[0] + } + if b, _ := InputStreamP(e, s); b == Nil { + return nil, nil // throw Error + } + eosErrorP := true + if len(options) > 1 { + if options[1] == Nil { + eosErrorP = false + } + } + eosValue := Nil + if len(options) > 2 { + if options[2] == Nil { + eosValue = options[2] + } + } + v, _, err := bufio.NewReader(s.(instance.Stream).Reader).ReadLine() + if err != nil { + if eosErrorP { + return nil, instance.Create(e, class.EndOfStream) + } + return eosValue, nil + } + return instance.NewString(string(v)), nil +} + +// TODO: preview-char (Hint: Bufio.Rreader) + +func StreamReadyP(e env.Environment, inputStream ilos.Instance) (ilos.Instance, ilos.Instance) { + // TODO: stream-ready-p + return T, nil +} + +func Format(e env.Environment, stream, formatString ilos.Instance, objs ...ilos.Instance) (ilos.Instance, ilos.Instance) { + f := regexp.MustCompile("([^~])~A").ReplaceAllString(string(formatString.(instance.String)), "%1%v") + f = regexp.MustCompile(`\\`).ReplaceAllString(string(formatString.(instance.String)), `\\`) + f = regexp.MustCompile("([^~])~%").ReplaceAllString(string(formatString.(instance.String)), "%1\n") + if b, _ := OutputStreamP(e, stream); b == Nil { + return nil, nil // throw Error + } + args := []interface{}{} + for _, obj := range objs { + args = append(args, obj) + } + fmt.Fprintf(stream.(instance.Stream).Writer, f, args...) + return Nil, nil +} diff --git a/runtime/string.go b/runtime/string.go new file mode 100644 index 0000000..39de2ef --- /dev/null +++ b/runtime/string.go @@ -0,0 +1,198 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "strings" + + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// Stringp returns t if obj is a string (instance of class string); +// otherwise, returns nil. obj may be any ISLISP object. +func Stringp(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class.String, obj) { + return T, nil + } + return Nil, nil +} + +// CreateString returns a string of length i. If initial-character is given, then the characters of +// the new string are initialized with this character, otherwise the initialization is implementation defined. +// An error shall be signaled if the requested string cannot be allocated (error-id. cannot-create-string). +// An error shall be signaled if i is not a non-negative integer or if initial-character is not a character (error-id. domain-error). +func CreateString(e env.Environment, i ilos.Instance, initialElement ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if !ilos.InstanceOf(class.Integer, i) || int(i.(instance.Integer)) < 0 { + return nil, instance.NewDomainError(i, class.Integer) + } + if len(initialElement) > 1 { + return nil, instance.NewArityError() + } + n := int(i.(instance.Integer)) + v := make([]ilos.Instance, n) + for i := 0; i < n; i++ { + if len(initialElement) == 0 { + v[i] = Nil + } else { + if err := ensure(class.Character, initialElement[0]); err != nil { + return nil, err + } + v[i] = initialElement[0] + } + } + return instance.GeneralVector(v), nil +} + +// StringEqual tests whether string1 is the same string as string2. +func StringEqual(e env.Environment, string1, string2 ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.String, string1, string2); err != nil { + return nil, err + } + if string(string1.(instance.String)) == string(string2.(instance.String)) { + return T, nil + } + return Nil, nil +} + +// StringNotEqual tests whether string1 not is the same string as string2. +func StringNotEqual(e env.Environment, string1, string2 ilos.Instance) (ilos.Instance, ilos.Instance) { + ret, err := StringEqual(e, string1, string2) + if err != nil { + return nil, err + } + return Not(e, ret) +} + +// StringGreaterThan tests whether string1 is greater than string2. +func StringGreaterThan(e env.Environment, string1, string2 ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.String, string1, string2); err != nil { + return nil, err + } + if string(string1.(instance.String)) > string(string2.(instance.String)) { + return T, nil + } + return Nil, nil +} + +// StringGreaterThanOrEqual tests whether string1 is greater than or equal to string2. +func StringGreaterThanOrEqual(e env.Environment, string1, string2 ilos.Instance) (ilos.Instance, ilos.Instance) { + gt, err := StringGreaterThan(e, string1, string2) + if err != nil { + return nil, err + } + eq, err := StringEqual(e, string1, string2) + if err != nil { + return nil, err + } + if gt == Nil && eq == Nil { + return Nil, nil + } + return T, nil +} + +// StringLessThan tests whether string1 is less than string2. +func StringLessThan(e env.Environment, string1, string2 ilos.Instance) (ilos.Instance, ilos.Instance) { + gt, err := StringGreaterThanOrEqual(e, string1, string2) + if err != nil { + return nil, err + } + return Not(e, gt) +} + +// StringLessThanOrEqual tests whether string1 is less than or equal to string2. +func StringLessThanOrEqual(e env.Environment, string1, string2 ilos.Instance) (ilos.Instance, ilos.Instance) { + gt, err := StringGreaterThan(e, string1, string2) + if err != nil { + return nil, err + } + return Not(e, gt) +} + +// CharIndex returns the position of char in string, The search starts from the position indicated +// by start-position (which is 0-based and defaults to 0). The value returned if the search +// succeeds is an offset from the beginning of the string, not from the starting point. +// If the char does not occur in the string, nil is returned. The function char= is used for the comparisons. +// +// An error shall be signaled if char is not a character or if string is not a string (error-id. domain-error). +func CharIndex(e env.Environment, char, str ilos.Instance, startPosition ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Character, char); err != nil { + return nil, err + } + if err := ensure(class.String, str); err != nil { + return nil, err + } + if len(startPosition) > 1 { + return nil, instance.NewArityError() + } + n := 0 + if len(startPosition) == 1 { + if err := ensure(class.Integer, startPosition[0]); err != nil { + return nil, err + } + n = int(startPosition[0].(instance.Integer)) + } + s := string(str.(instance.String)[n:]) + c := rune(char.(instance.Character)) + i := strings.IndexRune(s, c) + if i < 0 { + return Nil, nil + } + return instance.NewInteger(i), nil +} + +// StringIndex returns the position of the given substring within string. The search starts +// from the position indicated by start-position (which is 0-based and defaults to 0). +// The value returned if the search succeeds is an offset from the beginning of the string, +// not from the starting point. If that substring does not occur in the string, nil is returned. +// Presence of the substring is done by sequential use of char= on corresponding elements of the two strings. +// +// An error shall be signaled if either substring or string is not a string (error-id. domain-error). +func StringIndex(e env.Environment, sub, str ilos.Instance, startPosition ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.String, sub); err != nil { + return nil, err + } + if err := ensure(class.String, str); err != nil { + return nil, err + } + if len(startPosition) > 1 { + return nil, instance.NewArityError() + } + n := 0 + if len(startPosition) == 1 { + if err := ensure(class.Integer, startPosition[0]); err != nil { + return nil, err + } + n = int(startPosition[0].(instance.Integer)) + } + s := string(str.(instance.String)[n:]) + c := string(sub.(instance.String)) + i := strings.Index(s, c) + if i < 0 { + return Nil, nil + } + return instance.NewInteger(i), nil +} + +// StringAppend returns a single string containing a sequence of characters that results +// from appending the sequences of characters of each of the strings, or "" if given no strings. +// An error shall be signaled if any string is not a string (error-id. domain-error). +// +// This function does not modify its arguments. It is implementation defined whether and +// when the result shares structure with its string arguments. +// +// An error shall be signaled if the string cannot be allocated (error-id. cannot-create-string). +func StringAppend(e env.Environment, str ...ilos.Instance) (ilos.Instance, ilos.Instance) { + ret := "" + for _, s := range str { + if err := ensure(class.String, s); err != nil { + return nil, err + } + ret += string(s.(instance.String)) + } + return instance.NewString(ret), nil +} diff --git a/runtime/symbol.go b/runtime/symbol.go new file mode 100644 index 0000000..b75a4ec --- /dev/null +++ b/runtime/symbol.go @@ -0,0 +1,81 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "fmt" + + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// Symbolp returns t if obj is a symbol (instance of class symbol); +// otherwise, returns nil. The obj may be any ISLISP object. +func Symbolp(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class.Symbol, obj) { + return T, nil + } + return Nil, nil +} + +// Property returns the value of the property named property-name +// associated with the symbol symbol . If symbol has no property named +// property-name, obj (which defaults to nil) is returned. +// +// An error shall be signaled if either symbol or property-name is not a +// symbol (error-id. domain-error). obj may be any ISLISP object +func Property(e env.Environment, symbol, propertyName ilos.Instance, obj ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Symbol, symbol); err != nil { + return nil, err + } + if len(obj) > 1 { + return nil, instance.NewArityError() + } + ret, ok := e.Property.Get(symbol, propertyName) + if ok { + return ret, nil + } + return obj[1], nil +} + +// SetProperty causes obj to be the new value of the property named +// property-name asssociated with the symbol symbol . If the property +// named property-name already exists, its corresponding property value is +// replaced; otherwise, a new property is created. obj is returned. +// +// An error shall be signaled if either symbol or property-name is not a +// symbol (error-id. domain-error). obj may be any ISLISP object +func SetProperty(e env.Environment, obj, symbol, propertyName ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Symbol, symbol); err != nil { + return nil, err + } + e.Property.Set(symbol, propertyName, obj) + return obj, nil +} + +// RemoveProperty removes the property property-name associated with +// symbol and returns the property value of the removed property if there +// is such a property. If there is no such property, nil is returned. +// +// An error shall be signaled if either symbol or property-name is not a +// symbol (error-id. domain-error). +func RemoveProperty(e env.Environment, symbol, propertyName ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.Symbol, symbol); err != nil { + return nil, err + } + if v, ok := e.Property.Delete(symbol, propertyName); ok { + return v, nil + } + return Nil, nil +} + +// Gensym returns an unnamed symbol. gensym is useful for writing macros. +// It is impossible for an identifier to name an unnamed symbol. +func Gensym(e env.Environment) (ilos.Instance, ilos.Instance) { + e.GensymID++ + return instance.NewSymbol(fmt.Sprintf("IRIS/G#%v", e.GensymID)), nil +} diff --git a/runtime/test.go b/runtime/test.go new file mode 100644 index 0000000..4554092 --- /dev/null +++ b/runtime/test.go @@ -0,0 +1,33 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "reflect" + "runtime" + "testing" +) + +type test struct { + exp string + want string + wantErr bool +} + +func execTests(t *testing.T, function interface{}, tests []test) { + name := runtime.FuncForPC(reflect.ValueOf(function).Pointer()).Name() + for _, tt := range tests { + t.Run(tt.exp, func(t *testing.T) { + got, err := Eval(TopLevel, readFromString(tt.exp)) + want, _ := Eval(TopLevel, readFromString(tt.want)) + if !tt.wantErr && !reflect.DeepEqual(got, want) { + t.Errorf("%v() got = %v, want %v", name, got, want) + } + if (err != nil) != tt.wantErr { + t.Errorf("%v() err = %v, wantErr %v", name, err, tt.wantErr) + } + }) + } +} diff --git a/runtime/util.go b/runtime/util.go new file mode 100644 index 0000000..bb3735e --- /dev/null +++ b/runtime/util.go @@ -0,0 +1,74 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "reflect" + "regexp" + "runtime" + "strings" + + "github.com/ta2gch/iris/runtime/env" + + "github.com/ta2gch/iris/reader/parser" + "github.com/ta2gch/iris/reader/tokenizer" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +func isProperList(i ilos.Instance) bool { + if ilos.InstanceOf(class.Cons, i) { + return isProperList(i.(*instance.Cons).Cdr) // Checked at the top of this statements + } + if i == Nil { + return true + } + return false +} + +func convFloat64(x ilos.Instance) (float64, bool, ilos.Instance) { + switch { + case ilos.InstanceOf(class.Integer, x): + return float64(x.(instance.Integer)), false, nil + case ilos.InstanceOf(class.Float, x): + return float64(x.(instance.Float)), true, nil + default: + return 0.0, false, instance.NewDomainError(x, class.Number) + } +} + +func readFromString(s string) ilos.Instance { + ret, _ := parser.Parse(tokenizer.Tokenize(strings.NewReader(s))) + return ret +} +func evalString(e env.Environment, s string) ilos.Instance { + ret, _ := Eval(e, readFromString(s)) + return ret +} + +func ensure(c ilos.Class, i ...ilos.Instance) ilos.Instance { + for _, o := range i { + if !ilos.InstanceOf(c, o) { + return instance.NewDomainError(o, c) + } + } + return nil +} + +var uidsrc = 0 + +func genUID() ilos.Instance { + uidsrc++ + return instance.NewInteger(uidsrc) +} + +func func2symbol(function interface{}) ilos.Instance { + name := runtime.FuncForPC(reflect.ValueOf(function).Pointer()).Name() + name = regexp.MustCompile(`.*\.`).ReplaceAllString(name, "") + name = regexp.MustCompile(`(.)([A-Z])`).ReplaceAllString(name, "$1-$2") + name = strings.ToUpper(name) + return instance.NewSymbol(name) +} diff --git a/runtime/variable.go b/runtime/variable.go new file mode 100644 index 0000000..5aef4f9 --- /dev/null +++ b/runtime/variable.go @@ -0,0 +1,130 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "fmt" + + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// Setq represents an assignment to the variable denoted by the identifier. In consequence, +// the identifier may designate a different object than before, the value of form. +// +// The result of the evaluation of form is returned. This result is used to +// modify the variable binding denoted by the identifier var (if it is mutable). +// setq can be used only for modifying bindings, and not for establishing a variable. +// The setq special form must be contained in the scope of var , established by defglobal, +// let, let*, for, or a lambda expression. +func Setq(e env.Environment, var1, form ilos.Instance) (ilos.Instance, ilos.Instance) { + ret, err := Eval(e, form) + if err != nil { + return nil, err + } + if e.Variable.Set(var1, ret) { + return ret, nil + } + if e.Variable.Set(var1, ret) { + return ret, nil + } + return nil, instance.NewUndefinedVariable(var1) +} + +func Setf(e env.Environment, var1, form ilos.Instance) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class.Symbol, var1) { + val, err := Eval(e, form) + if err != nil { + return nil, err + } + return Setq(e, var1, val) + } + funcSpec := instance.NewSymbol(fmt.Sprintf("(SETF %v)", var1.(instance.List).Nth(0))) + fun, ok := e.Function.Get(funcSpec) + if !ok { + return nil, instance.NewUndefinedFunction(funcSpec) + } + arguments, err := evalArguments(e, instance.NewCons(form, var1.(*instance.Cons).Cdr)) + if err != nil { + return nil, err + } + return fun.(instance.Applicable).Apply(e, arguments.(instance.List).Slice()...) +} + +// Let is used to define a scope for a group of identifiers +// for a sequence of forms body-form* (collectively referred to as the body). +// The list of pairs (var form)* is called the let variable list. +// The scope of the identifier var is the body. +// +// The forms are evaluated sequentially from left to right; +// then each variable denoted by the identifier var is initialized to the corresponding value. +// Using these bindings along with the already existing bindings of visible +// identifiers the body-forms are evaluated. The returned value of let is the result +// of the evaluation of the last body-form of its body (or nil if there is none). +// +// No var may appear more than once in let variable list. +func Let(e env.Environment, varForm ilos.Instance, bodyForm ...ilos.Instance) (ilos.Instance, ilos.Instance) { + vfs := map[ilos.Instance]ilos.Instance{} + if err := ensure(class.List, varForm); err != nil { + return nil, err + } + for _, cadr := range varForm.(instance.List).Slice() { + if err := ensure(class.List, cadr); err != nil { + return nil, err + } + if cadr.(instance.List).Length() != 2 { + return nil, instance.NewArityError() + } + f, err := Eval(e, cadr.(instance.List).Nth(1)) + if err != nil { + return nil, err + } + vfs[cadr.(instance.List).Nth(0)] = f + } + for v, f := range vfs { + if !e.Variable.Define(v, f) { + return nil, instance.NewImmutableBinding() + } + } + return Progn(e, bodyForm...) +} + +// LetStar form is used to define a scope for a group of identifiers for a sequence +// of forms body-form* (collectively referred to as the body). +// The first subform (the let* variable list) is a list of pairs (var form). +// The scope of an identifier var is the body along with all form +// forms following the pair (var form) in the let* variable list. +// +// For each pair (var form) the following is done: form is evaluated in the context +// of the bindings in effect at that point in the evaluation. The result of +// the evaluation is bound to its associated variable named by the identifier var . +// These variable bindings enlarge the set of current valid identifiers perhaps +// shadowing previous variable bindings (in case some var was defined outside), +// and in this enlarged or modified eironment the body-forms are executed. +// The returned value of let* is the result of the evaluation of the last form +// of its body (or nil if there is none). +func LetStar(e env.Environment, varForm ilos.Instance, bodyForm ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if err := ensure(class.List, varForm); err != nil { + return nil, err + } + for _, cadr := range varForm.(instance.List).Slice() { + if err := ensure(class.List, cadr); err != nil { + return nil, err + } + if cadr.(instance.List).Length() != 2 { + return nil, instance.NewArityError() + } + f, err := Eval(e, cadr.(instance.List).Nth(1)) + if err != nil { + return nil, err + } + if !e.Variable.Define(cadr.(instance.List).Nth(0), f) { + return nil, instance.NewImmutableBinding() + } + } + return Progn(e, bodyForm...) +} diff --git a/lib/variable_test.go b/runtime/variable_test.go similarity index 63% rename from lib/variable_test.go rename to runtime/variable_test.go index d4553f5..95ce2b4 100644 --- a/lib/variable_test.go +++ b/runtime/variable_test.go @@ -1,8 +1,8 @@ -// This Source Code Form is subject to the terms of the Mozilla Public License, -// v. 2.0. If a copy of the MPL was not distributed with this file, You can -// obtain one at http://mozilla.org/MPL/2.0/. +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. -package lib +package runtime import "testing" diff --git a/runtime/vector.go b/runtime/vector.go new file mode 100644 index 0000000..165a8d6 --- /dev/null +++ b/runtime/vector.go @@ -0,0 +1,64 @@ +// This Source Code Form is subject to the terms of the Mozilla Public +// License, v. 2.0. If a copy of the MPL was not distributed with this +// file, You can obtain one at http://mozilla.org/MPL/2.0/. + +package runtime + +import ( + "github.com/ta2gch/iris/runtime/env" + "github.com/ta2gch/iris/runtime/ilos" + "github.com/ta2gch/iris/runtime/ilos/class" + "github.com/ta2gch/iris/runtime/ilos/instance" +) + +// BasicVectorP returns t if obj is a basic-vector (instance of class basic-vector); +// otherwise, returns nil. obj may be any ISLISP object. +func BasicVectorP(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class.BasicVector, obj) { + return T, nil + } + return Nil, nil +} + +// GeneralVectorP returns t if obj is a general-vector (instance of class general-vector); +// otherwise, returns nil. obj may be any ISLISP object. +func GeneralVectorP(e env.Environment, obj ilos.Instance) (ilos.Instance, ilos.Instance) { + if ilos.InstanceOf(class.GeneralVector, obj) { + return T, nil + } + return Nil, nil +} + +// CreateVector returns a general-vector of length i. If initial-element is given, +// the elements of the new vector are initialized with this object, +// otherwise the initialization is implementation defined. An error shall be signaled +// if the requested vector cannot be allocated (error-id. cannot-create-vector). +// An error shall be signaled if i is not a non-negative integer (error-id. domain-error). +// initial-element may be any ISLISP object. +func CreateVector(e env.Environment, i ilos.Instance, initialElement ...ilos.Instance) (ilos.Instance, ilos.Instance) { + if !ilos.InstanceOf(class.Integer, i) || int(i.(instance.Integer)) < 0 { + return nil, instance.NewDomainError(i, class.Integer) + } + if len(initialElement) > 1 { + return nil, instance.NewArityError() + } + n := int(i.(instance.Integer)) + v := make([]ilos.Instance, n) + for i := 0; i < n; i++ { + if len(initialElement) == 0 { + v[i] = Nil + } else { + v[i] = initialElement[0] + } + } + return instance.GeneralVector(v), nil +} + +// Vector returns a new general-vector whose elements are its obj arguments. +// The length of the newly created vector is, therefore, the number of objs passed as arguments. +// The vector is indexed by integers ranging from 0 to dimension−1. An error shall be signaled +// if the requested vector cannot be allocated (error-id. cannot-create-vector). +// Each obj may be any ISLISP object. +func Vector(e env.Environment, obj ...ilos.Instance) (ilos.Instance, ilos.Instance) { + return instance.GeneralVector(obj), nil +} diff --git a/validator/validator.go b/validator/validator.go deleted file mode 100644 index 7723304..0000000 --- a/validator/validator.go +++ /dev/null @@ -1,147 +0,0 @@ -package validator - -import ( - "github.com/dlclark/regexp2" - "github.com/islisp-dev/iris/core" -) - -type ValidationError struct { - Actual core.Instance - Expected core.Instance -} - -func (err ValidationError) Error() string { - return "Validation Error" -} - -type Validator = func (core.Instance) error - -func Any(_ core.Instance) error { - return nil -} - -func InstanceOf(class core.Class) Validator { - return func (instance core.Instance) error { - ok := core.InstanceOf(class, instance) - if !ok { - return ValidationError{instance, class} - } - return nil - } -} - -func Symbol(pattern string) Validator { - re := regexp2.MustCompile(pattern, 0) - return func (instance core.Instance) error { - symbol, ok := instance.(core.Symbol) - if !ok { - return ValidationError{instance, core.SymbolClass} - } - ok, err := re.MatchString(symbol.String()) - if err != nil || !ok { - return ValidationError{instance, core.SymbolClass} - } - return nil - } -} - -func Or(validators ...Validator) Validator { - return func (instance core.Instance) error { - for _, validator := range validators { - if err := validator(instance); err == nil { - return nil - } - } - return ValidationError{instance, core.ObjectClass} - } -} - -func And(validators ...Validator) Validator { - return func (instance core.Instance) error { - for _, validator := range validators { - if err := validator(instance); err != nil { - return err - } - } - return nil - } -} - -func Not(validator Validator) Validator { - return func (instance core.Instance) error { - if err := validator(instance); err != nil { - return nil - } - return ValidationError{instance, core.ObjectClass} - } -} - -func List(validators ...Validator) Validator { - return func (args core.Instance) error { - if len(validators) == 0 && args == core.Nil { - return nil - } - if len(validators) == 0 || args == core.Nil { - return ValidationError{args, core.ListClass} - } - cons, ok := args.(*core.Cons) - if !ok { - return ValidationError{args, core.ConsClass} - } - if err := validators[0](cons.Car); err != nil { - return err - } - if err := List(validators...)(cons.Cdr); err != nil { - return err - } - return nil - } -} - -var Nil = List() - -func Append(validators ...Validator) Validator { - return func (args core.Instance) error { - if len(validators) == 0 { - return nil - } - rest := args - for { - cons, ok := rest.(*core.Cons) - if !ok { - return ValidationError{rest, core.ConsClass} - } - rest := cons.Cdr - cons.Cdr = core.Nil - if err := validators[0](args); err != nil { - cons.Cdr = rest - continue - } - if err := Append(validators...)(rest); err != nil { - cons.Cdr = rest - continue - } - return nil - } - } -} - -func Repeat(inner Validator) (outer Validator) { - outer = func (args core.Instance) error { - if args == core.Nil { - return nil - } - cons, ok := args.(*core.Cons) - if !ok { - return ValidationError{args, core.ConsClass} - } - if err := inner(cons.Car); err != nil { - return err - } - if err := outer(cons.Cdr); err != nil { - return err - } - return nil - } - return -} diff --git a/wasm/wasm_exec.js b/wasm/wasm_exec.js deleted file mode 100644 index 02a753c..0000000 --- a/wasm/wasm_exec.js +++ /dev/null @@ -1,415 +0,0 @@ -// Copyright 2018 The Go Authors. All rights reserved. -// Use of this source code is governed by a BSD-style -// license that can be found in the LICENSE file. - -(() => { - // Map web browser API and Node.js API to a single common API (preferring web standards over Node.js API). - const isNodeJS = typeof process !== "undefined"; - if (isNodeJS) { - global.require = require; - global.fs = require("fs"); - - const nodeCrypto = require("crypto"); - global.crypto = { - getRandomValues(b) { - nodeCrypto.randomFillSync(b); - }, - }; - - global.performance = { - now() { - const [sec, nsec] = process.hrtime(); - return sec * 1000 + nsec / 1000000; - }, - }; - - const util = require("util"); - global.TextEncoder = util.TextEncoder; - global.TextDecoder = util.TextDecoder; - } else { - if (typeof window !== "undefined") { - window.global = window; - } else if (typeof self !== "undefined") { - self.global = self; - } else { - throw new Error("cannot export Go (neither window nor self is defined)"); - } - - let outputBuf = ""; - global.fs = { - constants: { O_WRONLY: -1, O_RDWR: -1, O_CREAT: -1, O_TRUNC: -1, O_APPEND: -1, O_EXCL: -1, O_NONBLOCK: -1, O_SYNC: -1 }, // unused - writeSync(fd, buf) { - outputBuf += decoder.decode(buf); - const nl = outputBuf.lastIndexOf("\n"); - if (nl != -1) { - console.log(outputBuf.substr(0, nl)); - outputBuf = outputBuf.substr(nl + 1); - } - return buf.length; - }, - openSync(path, flags, mode) { - const err = new Error("not implemented"); - err.code = "ENOSYS"; - throw err; - }, - }; - } - - const encoder = new TextEncoder("utf-8"); - const decoder = new TextDecoder("utf-8"); - - global.Go = class { - constructor() { - this.argv = ["js"]; - this.env = {}; - this.exit = (code) => { - if (code !== 0) { - console.warn("exit code:", code); - } - }; - this._callbackTimeouts = new Map(); - this._nextCallbackTimeoutID = 1; - - const mem = () => { - // The buffer may change when requesting more memory. - return new DataView(this._inst.exports.mem.buffer); - } - - const setInt64 = (addr, v) => { - mem().setUint32(addr + 0, v, true); - mem().setUint32(addr + 4, Math.floor(v / 4294967296), true); - } - - const getInt64 = (addr) => { - const low = mem().getUint32(addr + 0, true); - const high = mem().getInt32(addr + 4, true); - return low + high * 4294967296; - } - - const loadValue = (addr) => { - const f = mem().getFloat64(addr, true); - if (!isNaN(f)) { - return f; - } - - const id = mem().getUint32(addr, true); - return this._values[id]; - } - - const storeValue = (addr, v) => { - const nanHead = 0x7FF80000; - - if (typeof v === "number") { - if (isNaN(v)) { - mem().setUint32(addr + 4, nanHead, true); - mem().setUint32(addr, 0, true); - return; - } - mem().setFloat64(addr, v, true); - return; - } - - switch (v) { - case undefined: - mem().setUint32(addr + 4, nanHead, true); - mem().setUint32(addr, 1, true); - return; - case null: - mem().setUint32(addr + 4, nanHead, true); - mem().setUint32(addr, 2, true); - return; - case true: - mem().setUint32(addr + 4, nanHead, true); - mem().setUint32(addr, 3, true); - return; - case false: - mem().setUint32(addr + 4, nanHead, true); - mem().setUint32(addr, 4, true); - return; - } - - let ref = this._refs.get(v); - if (ref === undefined) { - ref = this._values.length; - this._values.push(v); - this._refs.set(v, ref); - } - let typeFlag = 0; - switch (typeof v) { - case "string": - typeFlag = 1; - break; - case "symbol": - typeFlag = 2; - break; - case "function": - typeFlag = 3; - break; - } - mem().setUint32(addr + 4, nanHead | typeFlag, true); - mem().setUint32(addr, ref, true); - } - - const loadSlice = (addr) => { - const array = getInt64(addr + 0); - const len = getInt64(addr + 8); - return new Uint8Array(this._inst.exports.mem.buffer, array, len); - } - - const loadSliceOfValues = (addr) => { - const array = getInt64(addr + 0); - const len = getInt64(addr + 8); - const a = new Array(len); - for (let i = 0; i < len; i++) { - a[i] = loadValue(array + i * 8); - } - return a; - } - - const loadString = (addr) => { - const saddr = getInt64(addr + 0); - const len = getInt64(addr + 8); - return decoder.decode(new DataView(this._inst.exports.mem.buffer, saddr, len)); - } - - const timeOrigin = Date.now() - performance.now(); - this.importObject = { - go: { - // func wasmExit(code int32) - "runtime.wasmExit": (sp) => { - const code = mem().getInt32(sp + 8, true); - this.exited = true; - delete this._inst; - delete this._values; - delete this._refs; - this.exit(code); - }, - - // func wasmWrite(fd uintptr, p unsafe.Pointer, n int32) - "runtime.wasmWrite": (sp) => { - const fd = getInt64(sp + 8); - const p = getInt64(sp + 16); - const n = mem().getInt32(sp + 24, true); - fs.writeSync(fd, new Uint8Array(this._inst.exports.mem.buffer, p, n)); - }, - - // func nanotime() int64 - "runtime.nanotime": (sp) => { - setInt64(sp + 8, (timeOrigin + performance.now()) * 1000000); - }, - - // func walltime() (sec int64, nsec int32) - "runtime.walltime": (sp) => { - const msec = (new Date).getTime(); - setInt64(sp + 8, msec / 1000); - mem().setInt32(sp + 16, (msec % 1000) * 1000000, true); - }, - - // func scheduleCallback(delay int64) int32 - "runtime.scheduleCallback": (sp) => { - const id = this._nextCallbackTimeoutID; - this._nextCallbackTimeoutID++; - this._callbackTimeouts.set(id, setTimeout( - () => { this._resolveCallbackPromise(); }, - getInt64(sp + 8) + 1, // setTimeout has been seen to fire up to 1 millisecond early - )); - mem().setInt32(sp + 16, id, true); - }, - - // func clearScheduledCallback(id int32) - "runtime.clearScheduledCallback": (sp) => { - const id = mem().getInt32(sp + 8, true); - clearTimeout(this._callbackTimeouts.get(id)); - this._callbackTimeouts.delete(id); - }, - - // func getRandomData(r []byte) - "runtime.getRandomData": (sp) => { - crypto.getRandomValues(loadSlice(sp + 8)); - }, - - // func stringVal(value string) ref - "syscall/js.stringVal": (sp) => { - storeValue(sp + 24, loadString(sp + 8)); - }, - - // func valueGet(v ref, p string) ref - "syscall/js.valueGet": (sp) => { - storeValue(sp + 32, Reflect.get(loadValue(sp + 8), loadString(sp + 16))); - }, - - // func valueSet(v ref, p string, x ref) - "syscall/js.valueSet": (sp) => { - Reflect.set(loadValue(sp + 8), loadString(sp + 16), loadValue(sp + 32)); - }, - - // func valueIndex(v ref, i int) ref - "syscall/js.valueIndex": (sp) => { - storeValue(sp + 24, Reflect.get(loadValue(sp + 8), getInt64(sp + 16))); - }, - - // valueSetIndex(v ref, i int, x ref) - "syscall/js.valueSetIndex": (sp) => { - Reflect.set(loadValue(sp + 8), getInt64(sp + 16), loadValue(sp + 24)); - }, - - // func valueCall(v ref, m string, args []ref) (ref, bool) - "syscall/js.valueCall": (sp) => { - try { - const v = loadValue(sp + 8); - const m = Reflect.get(v, loadString(sp + 16)); - const args = loadSliceOfValues(sp + 32); - storeValue(sp + 56, Reflect.apply(m, v, args)); - mem().setUint8(sp + 64, 1); - } catch (err) { - storeValue(sp + 56, err); - mem().setUint8(sp + 64, 0); - } - }, - - // func valueInvoke(v ref, args []ref) (ref, bool) - "syscall/js.valueInvoke": (sp) => { - try { - const v = loadValue(sp + 8); - const args = loadSliceOfValues(sp + 16); - storeValue(sp + 40, Reflect.apply(v, undefined, args)); - mem().setUint8(sp + 48, 1); - } catch (err) { - storeValue(sp + 40, err); - mem().setUint8(sp + 48, 0); - } - }, - - // func valueNew(v ref, args []ref) (ref, bool) - "syscall/js.valueNew": (sp) => { - try { - const v = loadValue(sp + 8); - const args = loadSliceOfValues(sp + 16); - storeValue(sp + 40, Reflect.construct(v, args)); - mem().setUint8(sp + 48, 1); - } catch (err) { - storeValue(sp + 40, err); - mem().setUint8(sp + 48, 0); - } - }, - - // func valueLength(v ref) int - "syscall/js.valueLength": (sp) => { - setInt64(sp + 16, parseInt(loadValue(sp + 8).length)); - }, - - // valuePrepareString(v ref) (ref, int) - "syscall/js.valuePrepareString": (sp) => { - const str = encoder.encode(String(loadValue(sp + 8))); - storeValue(sp + 16, str); - setInt64(sp + 24, str.length); - }, - - // valueLoadString(v ref, b []byte) - "syscall/js.valueLoadString": (sp) => { - const str = loadValue(sp + 8); - loadSlice(sp + 16).set(str); - }, - - // func valueInstanceOf(v ref, t ref) bool - "syscall/js.valueInstanceOf": (sp) => { - mem().setUint8(sp + 24, loadValue(sp + 8) instanceof loadValue(sp + 16)); - }, - - "debug": (value) => { - console.log(value); - }, - } - }; - } - - async run(instance) { - this._inst = instance; - this._values = [ // TODO: garbage collection - NaN, - undefined, - null, - true, - false, - global, - this._inst.exports.mem, - this, - ]; - this._refs = new Map(); - this._callbackShutdown = false; - this.exited = false; - - const mem = new DataView(this._inst.exports.mem.buffer) - - // Pass command line arguments and environment variables to WebAssembly by writing them to the linear memory. - let offset = 4096; - - const strPtr = (str) => { - let ptr = offset; - new Uint8Array(mem.buffer, offset, str.length + 1).set(encoder.encode(str + "\0")); - offset += str.length + (8 - (str.length % 8)); - return ptr; - }; - - const argc = this.argv.length; - - const argvPtrs = []; - this.argv.forEach((arg) => { - argvPtrs.push(strPtr(arg)); - }); - - const keys = Object.keys(this.env).sort(); - argvPtrs.push(keys.length); - keys.forEach((key) => { - argvPtrs.push(strPtr(`${key}=${this.env[key]}`)); - }); - - const argv = offset; - argvPtrs.forEach((ptr) => { - mem.setUint32(offset, ptr, true); - mem.setUint32(offset + 4, 0, true); - offset += 8; - }); - - while (true) { - const callbackPromise = new Promise((resolve) => { - this._resolveCallbackPromise = () => { - if (this.exited) { - throw new Error("bad callback: Go program has already exited"); - } - setTimeout(resolve, 0); // make sure it is asynchronous - }; - }); - this._inst.exports.run(argc, argv); - if (this.exited) { - break; - } - await callbackPromise; - } - } - } - - if (isNodeJS) { - if (process.argv.length < 3) { - process.stderr.write("usage: go_js_wasm_exec [wasm binary] [arguments]\n"); - process.exit(1); - } - - const go = new Go(); - go.argv = process.argv.slice(2); - go.env = process.env; - go.exit = process.exit; - WebAssembly.instantiate(fs.readFileSync(process.argv[2]), go.importObject).then((result) => { - process.on("exit", (code) => { // Node.js exits if no callback is pending - if (code === 0 && !go.exited) { - // deadlock, make Go print error and stack traces - go._callbackShutdown = true; - go._inst.exports.run(); - } - }); - return go.run(result.instance); - }).catch((err) => { - throw err; - }); - } -})();