diff --git a/interpreter/expressions.go b/interpreter/expressions.go index c9f4674..81152c8 100644 --- a/interpreter/expressions.go +++ b/interpreter/expressions.go @@ -74,7 +74,13 @@ func (pair SexpPair) SexpString() string { } type SexpArray []Sexp -type SexpHash map[int][]SexpPair +type SexpHash struct { + TypeName *string + Map map[int][]SexpPair + KeyOrder *[]Sexp // must user pointers here, else hset! will fail to update. + GoStruct *interface{} + NumKeys *int +} type SexpInt int type SexpBool bool type SexpFloat float64 @@ -99,7 +105,7 @@ func (arr SexpArray) SexpString() string { func (hash SexpHash) SexpString() string { str := "{" - for _, arr := range hash { + for _, arr := range hash.Map { for _, pair := range arr { str += pair.head.SexpString() + " " str += pair.tail.SexpString() + " " @@ -178,3 +184,11 @@ func IsTruthy(expr Sexp) bool { } return true } + +type SexpStackmark struct { + sym SexpSymbol +} + +func (mark SexpStackmark) SexpString() string { + return "stackmark " + mark.sym.name +} diff --git a/interpreter/functions.go b/interpreter/functions.go index 41c0192..d3b4db5 100644 --- a/interpreter/functions.go +++ b/interpreter/functions.go @@ -257,17 +257,17 @@ func HashAccessFunction(env *Glisp, name string, args []Sexp) (Sexp, error) { switch name { case "hget": if len(args) == 3 { - return HashGetDefault(hash, args[1], args[2]) + return hash.HashGetDefault(args[1], args[2]) } - return HashGet(hash, args[1]) + return hash.HashGet(args[1]) case "hset!": - err := HashSet(hash, args[1], args[2]) + err := hash.HashSet(args[1], args[2]) return SexpNull, err case "hdel!": if len(args) != 2 { return SexpNull, WrongNargs } - err := HashDelete(hash, args[1]) + err := hash.HashDelete(args[1]) return SexpNull, err } @@ -544,7 +544,7 @@ func ConstructorFunction(env *Glisp, name string, args []Sexp) (Sexp, error) { case "list": return MakeList(args), nil case "hash": - return MakeHash(args) + return MakeHash(args, "hash") } return SexpNull, errors.New("invalid constructor") } @@ -636,60 +636,69 @@ func MakeUserFunction(name string, ufun GlispUserFunction) SexpFunction { } var BuiltinFunctions = map[string]GlispUserFunction{ - "<": CompareFunction, - ">": CompareFunction, - "<=": CompareFunction, - ">=": CompareFunction, - "=": CompareFunction, - "not=": CompareFunction, - "sll": BinaryIntFunction, - "sra": BinaryIntFunction, - "srl": BinaryIntFunction, - "mod": BinaryIntFunction, - "+": NumericFunction, - "-": NumericFunction, - "*": NumericFunction, - "/": NumericFunction, - "bit-and": BitwiseFunction, - "bit-or": BitwiseFunction, - "bit-xor": BitwiseFunction, - "bit-not": ComplementFunction, - "read": ReadFunction, - "cons": ConsFunction, - "first": FirstFunction, - "rest": RestFunction, - "car": FirstFunction, - "cdr": RestFunction, - "list?": TypeQueryFunction, - "null?": TypeQueryFunction, - "array?": TypeQueryFunction, - "hash?": TypeQueryFunction, - "number?": TypeQueryFunction, - "int?": TypeQueryFunction, - "float?": TypeQueryFunction, - "char?": TypeQueryFunction, - "symbol?": TypeQueryFunction, - "string?": TypeQueryFunction, - "zero?": TypeQueryFunction, - "empty?": TypeQueryFunction, - "println": PrintFunction, - "print": PrintFunction, - "not": NotFunction, - "apply": ApplyFunction, - "map": MapFunction, - "make-array": MakeArrayFunction, - "aget": ArrayAccessFunction, - "aset!": ArrayAccessFunction, - "sget": SgetFunction, - "hget": HashAccessFunction, - "hset!": HashAccessFunction, - "hdel!": HashAccessFunction, - "slice": SliceFunction, - "len": LenFunction, - "append": AppendFunction, - "concat": ConcatFunction, - "array": ConstructorFunction, - "list": ConstructorFunction, - "hash": ConstructorFunction, - "symnum": SymnumFunction, + "<": CompareFunction, + ">": CompareFunction, + "<=": CompareFunction, + ">=": CompareFunction, + "=": CompareFunction, + "not=": CompareFunction, + "sll": BinaryIntFunction, + "sra": BinaryIntFunction, + "srl": BinaryIntFunction, + "mod": BinaryIntFunction, + "+": NumericFunction, + "-": NumericFunction, + "*": NumericFunction, + "/": NumericFunction, + "bit-and": BitwiseFunction, + "bit-or": BitwiseFunction, + "bit-xor": BitwiseFunction, + "bit-not": ComplementFunction, + "read": ReadFunction, + "cons": ConsFunction, + "first": FirstFunction, + "rest": RestFunction, + "car": FirstFunction, + "cdr": RestFunction, + "list?": TypeQueryFunction, + "null?": TypeQueryFunction, + "array?": TypeQueryFunction, + "hash?": TypeQueryFunction, + "number?": TypeQueryFunction, + "int?": TypeQueryFunction, + "float?": TypeQueryFunction, + "char?": TypeQueryFunction, + "symbol?": TypeQueryFunction, + "string?": TypeQueryFunction, + "zero?": TypeQueryFunction, + "empty?": TypeQueryFunction, + "println": PrintFunction, + "print": PrintFunction, + "not": NotFunction, + "apply": ApplyFunction, + "map": MapFunction, + "make-array": MakeArrayFunction, + "aget": ArrayAccessFunction, + "aset!": ArrayAccessFunction, + "sget": SgetFunction, + "hget": HashAccessFunction, + "hset!": HashAccessFunction, + "hdel!": HashAccessFunction, + "slice": SliceFunction, + "len": LenFunction, + "append": AppendFunction, + "concat": ConcatFunction, + "array": ConstructorFunction, + "list": ConstructorFunction, + "hash": ConstructorFunction, + "symnum": SymnumFunction, + "str": StringifyFunction, +} + +func StringifyFunction(env *Glisp, name string, args []Sexp) (Sexp, error) { + if len(args) != 1 { + return SexpNull, WrongNargs + } + + return SexpStr(args[0].SexpString()), nil } diff --git a/interpreter/generator.go b/interpreter/generator.go index 8775916..45bd40e 100644 --- a/interpreter/generator.go +++ b/interpreter/generator.go @@ -13,6 +13,16 @@ type Generator struct { instructions []Instruction } +type Loop struct { + stmtname SexpSymbol + loopStart int + loopLen int + breakOffset int // i.e. relative to loopStart + continueOffset int // i.e. relative to loopStart +} + +func (loop *Loop) IsStackElem() {} + func NewGenerator(env *Glisp) *Generator { gen := new(Generator) gen.env = env @@ -332,50 +342,6 @@ func (gen *Generator) GenerateQuote(args []Sexp) error { return nil } -func (gen *Generator) GenerateSyntaxQuote(args []Sexp) error { - if len(args) != 1 { - return errors.New("syntax-quote takes 1 argument") - } - - if args[0] == SexpNull || !IsList(args[0]) { - gen.AddInstruction(PushInstr{args[0]}) - return nil - } - quotebody, _ := ListToArray(args[0]) - - if len(quotebody) == 2 { - var issymbol bool - var sym SexpSymbol - switch t := quotebody[0].(type) { - case SexpSymbol: - sym = t - issymbol = true - default: - issymbol = false - } - if issymbol { - if sym.name == "unquote" { - gen.Generate(quotebody[1]) - return nil - } else if sym.name == "unquote-splicing" { - gen.Generate(quotebody[1]) - gen.AddInstruction(ExplodeInstr(0)) - return nil - } - } - } - - gen.AddInstruction(PushInstr{SexpMarker}) - - for _, expr := range quotebody { - gen.GenerateSyntaxQuote([]Sexp{expr}) - } - - gen.AddInstruction(SquashInstr(0)) - - return nil -} - func (gen *Generator) GenerateLet(name string, args []Sexp) error { if len(args) < 2 { return errors.New("malformed let statement") @@ -643,3 +609,141 @@ func (gen *Generator) Reset() { gen.tail = false gen.scopes = 0 } + +// side-effect (or main effect) has to be pushing an expression on the top of +// the datastack that represents the expanded and substituted expression +func (gen *Generator) GenerateSyntaxQuote(args []Sexp) error { + + if len(args) != 1 { + return errors.New("syntax-quote takes exactly one argument") + } + arg := args[0] + + // need to handle arrays, since they can have unquotes + // in them too. + switch arg.(type) { + case SexpArray: + gen.generateSyntaxQuoteArray(arg) + return nil + case SexpPair: + if !IsList(arg) { + break + } + gen.generateSyntaxQuoteList(arg) + return nil + case SexpHash: + gen.generateSyntaxQuoteHash(arg) + return nil + } + gen.AddInstruction(PushInstr{arg}) + return nil +} + +func (gen *Generator) generateSyntaxQuoteList(arg Sexp) error { + + switch a := arg.(type) { + case SexpPair: + //good, required here + default: + return fmt.Errorf("arg to generateSyntaxQuoteList() must be list; got %T", a) + } + + // things that need unquoting end up as + // (unquote mysym) + // i.e. a pair + // list of length 2 exactly, with first atom + // being "unquote" and second being the symbol + // to substitute. + quotebody, _ := ListToArray(arg) + + if len(quotebody) == 2 { + var issymbol bool + var sym SexpSymbol + switch t := quotebody[0].(type) { + case SexpSymbol: + sym = t + issymbol = true + default: + issymbol = false + } + if issymbol { + if sym.name == "unquote" { + gen.Generate(quotebody[1]) + return nil + } else if sym.name == "unquote-splicing" { + gen.Generate(quotebody[1]) + gen.AddInstruction(ExplodeInstr(0)) + return nil + } + } + } + + gen.AddInstruction(PushInstr{SexpMarker}) + + for _, expr := range quotebody { + gen.GenerateSyntaxQuote([]Sexp{expr}) + } + + gen.AddInstruction(SquashInstr(0)) + + return nil +} + +func (gen *Generator) generateSyntaxQuoteArray(arg Sexp) error { + + var arr SexpArray + switch a := arg.(type) { + case SexpArray: + //good, required here + arr = a + default: + return fmt.Errorf("arg to generateSyntaxQuoteArray() must be an array; got %T", a) + } + + gen.AddInstruction(PushInstr{SexpMarker}) + for _, expr := range arr { + gen.AddInstruction(PushInstr{SexpMarker}) + gen.GenerateSyntaxQuote([]Sexp{expr}) + gen.AddInstruction(SquashInstr(0)) + gen.AddInstruction(ExplodeInstr(0)) + } + gen.AddInstruction(VectorizeInstr(0)) + return nil +} + +func (gen *Generator) generateSyntaxQuoteHash(arg Sexp) error { + + var hash SexpHash + switch a := arg.(type) { + case SexpHash: + //good, required here + hash = a + default: + return fmt.Errorf("arg to generateSyntaxQuoteHash() must be a hash; got %T", a) + } + n := HashCountKeys(hash) + gen.AddInstruction(PushInstr{SexpMarker}) + for i := 0; i < n; i++ { + // must reverse order here to preserve order on rebuild + key := (*hash.KeyOrder)[(n-i)-1] + val, err := hash.HashGet(key) + if err != nil { + return err + } + // value first, since value comes second on rebuild + gen.AddInstruction(PushInstr{SexpMarker}) + gen.GenerateSyntaxQuote([]Sexp{val}) + gen.AddInstruction(SquashInstr(0)) + gen.AddInstruction(ExplodeInstr(0)) + + gen.AddInstruction(PushInstr{SexpMarker}) + gen.GenerateSyntaxQuote([]Sexp{key}) + gen.AddInstruction(SquashInstr(0)) + gen.AddInstruction(ExplodeInstr(0)) + } + gen.AddInstruction(HashizeInstr{ + HashLen: n, + TypeName: *(hash.TypeName), + }) + return nil +} diff --git a/interpreter/hashutils.go b/interpreter/hashutils.go index 452ef6d..10275f0 100644 --- a/interpreter/hashutils.go +++ b/interpreter/hashutils.go @@ -25,31 +25,39 @@ func HashExpression(expr Sexp) (int, error) { return 0, errors.New(fmt.Sprintf("cannot hash type %T", expr)) } -func MakeHash(args []Sexp) (SexpHash, error) { - hash := SexpHash(make(map[int][]SexpPair)) - +func MakeHash(args []Sexp, typename string) (SexpHash, error) { if len(args)%2 != 0 { - return SexpHash(nil), + return SexpHash{}, errors.New("hash requires even number of arguments") } + var iface interface{} + var memberCount int + hash := SexpHash{ + TypeName: &typename, + Map: make(map[int][]SexpPair), + KeyOrder: &[]Sexp{}, + GoStruct: &iface, + NumKeys: &memberCount, + } + k := 0 for i := 0; i < len(args); i += 2 { key := args[i] val := args[i+1] - err := HashSet(hash, key, val) + err := hash.HashSet(key, val) if err != nil { return hash, err } + k++ } - return hash, nil } -func HashGet(hash SexpHash, key Sexp) (Sexp, error) { +func (hash *SexpHash) HashGet(key Sexp) (Sexp, error) { // this is kind of a hack // SexpEnd can't be created by user // so there is no way it would actually show up in the map - val, err := HashGetDefault(hash, key, SexpEnd) + val, err := hash.HashGetDefault(key, SexpEnd) if err != nil { return SexpNull, err @@ -62,12 +70,12 @@ func HashGet(hash SexpHash, key Sexp) (Sexp, error) { return val, nil } -func HashGetDefault(hash SexpHash, key Sexp, defaultval Sexp) (Sexp, error) { +func (hash *SexpHash) HashGetDefault(key Sexp, defaultval Sexp) (Sexp, error) { hashval, err := HashExpression(key) if err != nil { return SexpNull, err } - arr, ok := hash[hashval] + arr, ok := hash.Map[hashval] if !ok { return defaultval, nil @@ -82,15 +90,17 @@ func HashGetDefault(hash SexpHash, key Sexp, defaultval Sexp) (Sexp, error) { return defaultval, nil } -func HashSet(hash SexpHash, key Sexp, val Sexp) error { +func (hash *SexpHash) HashSet(key Sexp, val Sexp) error { hashval, err := HashExpression(key) if err != nil { return err } - arr, ok := hash[hashval] + arr, ok := hash.Map[hashval] if !ok { - hash[hashval] = []SexpPair{Cons(key, val)} + hash.Map[hashval] = []SexpPair{Cons(key, val)} + *hash.KeyOrder = append(*hash.KeyOrder, key) + (*hash.NumKeys)++ return nil } @@ -105,28 +115,32 @@ func HashSet(hash SexpHash, key Sexp, val Sexp) error { if !found { arr = append(arr, Cons(key, val)) + *hash.KeyOrder = append(*hash.KeyOrder, key) + (*hash.NumKeys)++ } - hash[hashval] = arr + + hash.Map[hashval] = arr return nil } -func HashDelete(hash SexpHash, key Sexp) error { +func (hash *SexpHash) HashDelete(key Sexp) error { hashval, err := HashExpression(key) if err != nil { return err } - arr, ok := hash[hashval] + arr, ok := hash.Map[hashval] // if it doesn't exist, no need to delete it if !ok { return nil } + (*hash.NumKeys)-- for i, pair := range arr { res, err := Compare(pair.head, key) if err == nil && res == 0 { - hash[hashval] = append(arr[0:i], arr[i+1:]...) + hash.Map[hashval] = append(arr[0:i], arr[i+1:]...) break } } @@ -136,17 +150,35 @@ func HashDelete(hash SexpHash, key Sexp) error { func HashCountKeys(hash SexpHash) int { var num int - for _, arr := range hash { + for _, arr := range hash.Map { num += len(arr) } + if num != (*hash.NumKeys) { + panic(fmt.Errorf("HashCountKeys disagreement on count: num=%d, (*hash.NumKeys)=%d", num, (*hash.NumKeys))) + } return num } func HashIsEmpty(hash SexpHash) bool { - for _, arr := range hash { + for _, arr := range hash.Map { if len(arr) > 0 { return false } } return true } + +func SetHashKeyOrder(hash *SexpHash, keyOrd Sexp) error { + // truncate down to zero, then build back up correctly. + *(*hash).KeyOrder = (*(*hash).KeyOrder)[:0] + + keys, isArr := keyOrd.(SexpArray) + if !isArr { + return fmt.Errorf("must have SexpArray for keyOrd, but instead we have: %T with value='%#v'", keyOrd, keyOrd) + } + for _, key := range keys { + *hash.KeyOrder = append(*hash.KeyOrder, key) + } + + return nil +} diff --git a/interpreter/vm.go b/interpreter/vm.go index 6ba44ac..bc623ae 100644 --- a/interpreter/vm.go +++ b/interpreter/vm.go @@ -334,3 +334,96 @@ func (s SquashInstr) Execute(env *Glisp) error { env.pc++ return nil } + +// bind these symbols to the SexpPair list found at +// datastack top. +type BindlistInstr struct { + syms []SexpSymbol +} + +func (b BindlistInstr) InstrString() string { + joined := "" + for _, s := range b.syms { + joined += s.name + " " + } + return fmt.Sprintf("bindlist %s", joined) +} + +func (b BindlistInstr) Execute(env *Glisp) error { + expr, err := env.datastack.PopExpr() + if err != nil { + return err + } + + arr, err := ListToArray(expr) + if err != nil { + return err + } + + nsym := len(b.syms) + narr := len(arr) + if narr < nsym { + return fmt.Errorf("bindlist failing: %d targets but only %d sources", nsym, narr) + } + + for i, bindThisSym := range b.syms { + env.scopestack.BindSymbol(bindThisSym, arr[i]) + } + env.pc++ + return nil +} + +type VectorizeInstr int + +func (s VectorizeInstr) InstrString() string { + return "vectorize" +} + +func (s VectorizeInstr) Execute(env *Glisp) error { + vec := make([]Sexp, 0) + + for { + expr, err := env.datastack.PopExpr() + if err != nil { + return err + } + if expr == SexpMarker { + break + } + vec = append([]Sexp{expr}, vec...) + } + env.datastack.PushExpr(SexpArray(vec)) + env.pc++ + return nil +} + +type HashizeInstr struct { + HashLen int + TypeName string +} + +func (s HashizeInstr) InstrString() string { + return "hashize" +} + +func (s HashizeInstr) Execute(env *Glisp) error { + a := make([]Sexp, 0) + + for { + expr, err := env.datastack.PopExpr() + if err != nil { + return err + } + if expr == SexpMarker { + break + } + a = append(a, expr) + } + hash, err := MakeHash(a, s.TypeName) + if err != nil { + return err + } + env.datastack.PushExpr(hash) + env.pc++ + return nil +} diff --git a/tests/macros.glisp b/tests/macros.glisp index 88df9ac..e8232ef 100644 --- a/tests/macros.glisp +++ b/tests/macros.glisp @@ -10,3 +10,4 @@ (assert (null? (when false 'c))) (assert (= 'a (when true 'c 'b 'a))) + diff --git a/tests/syntax-quote.glisp b/tests/syntax-quote.glisp new file mode 100644 index 0000000..201eacc --- /dev/null +++ b/tests/syntax-quote.glisp @@ -0,0 +1,3 @@ +(def a 7) +(def x `[{'g ({'b [~a]})}]) +(assert (= (str x) "[(hash (quote g) ((hash (quote b) [7])))]"))