Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 157 lines (139 sloc) 5.606 kB
203aec5 @zephyrfalcon ...
authored
1 ;; interpreter.scm
2
150bd45 @zephyrfalcon some progress with delta-eval
authored
3 (use srfi-1)
203aec5 @zephyrfalcon ...
authored
4 (use gauche.record)
5 (use namespace)
e6a4345 @zephyrfalcon much debugging and such
authored
6 (use tokenizer)
7 (use parser)
8 (use pretty)
9 (use tools)
203aec5 @zephyrfalcon ...
authored
10
cf11a2f @zephyrfalcon start streamlining creation of builtin protos
authored
11 (load "proto-tools")
d1a994b @zephyrfalcon removed some module declarations; they got in the way =/
authored
12 (load "builtin/object")
13 (load "builtin/string")
14 (load "builtin/integer")
c56010d @zephyrfalcon first stab at Symbol proto (builtin)
authored
15 (load "builtin/symbol")
a4e6e18 @zephyrfalcon first stab at List proto
authored
16 (load "builtin/list")
b41bc0c @zephyrfalcon updated code
authored
17 (load "builtin/bmethod")
2238304 @zephyrfalcon first stab at Block proto
authored
18 (load "builtin/block")
2226082 @zephyrfalcon skeleton for Method proto
authored
19 (load "builtin/umethod")
8717320 @zephyrfalcon started with builtin protos...
authored
20
203aec5 @zephyrfalcon ...
authored
21 (define-record-type interpreter #t #t
8717320 @zephyrfalcon started with builtin protos...
authored
22 builtin-ns ;; contains protos
23 toplevel-ns ;; user space
203aec5 @zephyrfalcon ...
authored
24 )
25
26 (define (new-interpreter)
8717320 @zephyrfalcon started with builtin protos...
authored
27 (let* ((builtin-ns (make-namespace #f))
28 (toplevel-ns (make-namespace builtin-ns)))
29 (let ((interp (make-interpreter builtin-ns toplevel-ns)))
30 (init-interpreter interp)
31 interp)))
203aec5 @zephyrfalcon ...
authored
32
33 (define (init-interpreter interp)
8717320 @zephyrfalcon started with builtin protos...
authored
34 (add-protos interp)
9fc5751 @zephyrfalcon adding of methods is delayed until all protos have been created
authored
35 (add-proto-methods interp)
203aec5 @zephyrfalcon ...
authored
36 interp)
37
0b13c2c @zephyrfalcon refactoring etc
authored
38 (define *protos*
9fc5751 @zephyrfalcon adding of methods is delayed until all protos have been created
authored
39 (list (list "Object" make-object-proto *object-methods*)
40 (list "Integer" make-integer-proto *integer-methods*)
41 (list "String" make-string-proto *string-methods*)
c56010d @zephyrfalcon first stab at Symbol proto (builtin)
authored
42 (list "Symbol" make-symbol-proto *symbol-methods*)
a4e6e18 @zephyrfalcon first stab at List proto
authored
43 (list "List" make-list-proto *list-methods*)
2238304 @zephyrfalcon first stab at Block proto
authored
44 (list "BuiltinMethod" make-bmethod-proto *bmethod-methods*)
45 (list "Block" make-block-proto *block-methods*)
2226082 @zephyrfalcon skeleton for Method proto
authored
46 (list "Method" make-umethod-proto *umethod-methods*)
2238304 @zephyrfalcon first stab at Block proto
authored
47 ))
0b13c2c @zephyrfalcon refactoring etc
authored
48
8717320 @zephyrfalcon started with builtin protos...
authored
49 (define (add-protos interp)
50 (let ((ns (interpreter-builtin-ns interp)))
0b13c2c @zephyrfalcon refactoring etc
authored
51 (for-each-pair
52 (lambda (name proto-constructor)
53 (namespace-set! ns name (proto-constructor interp)))
54 *protos*)
8717320 @zephyrfalcon started with builtin protos...
authored
55 interp))
56
9fc5751 @zephyrfalcon adding of methods is delayed until all protos have been created
authored
57 (define (add-proto-methods interp)
58 (let ((bns (interpreter-builtin-ns interp)))
59 (for-each
60 (lambda (proto-entry)
61 (let ((proto (namespace-get bns (first proto-entry))))
62 (add-proto-methods-1 interp proto (third proto-entry))))
5b138f6 @zephyrfalcon REPL: result is printed using the object's 'repr' method
authored
63 *protos*)))
9fc5751 @zephyrfalcon adding of methods is delayed until all protos have been created
authored
64
8717320 @zephyrfalcon started with builtin protos...
authored
65 (define (find-builtin-proto interp name)
66 (let ((ns (interpreter-builtin-ns interp)))
67 (namespace-get ns name)))
68
75f1811 @zephyrfalcon normalize MCCs if possible
authored
69 ;; Tokenize, parse and evaluate the Delta code in the given string.
5b138f6 @zephyrfalcon REPL: result is printed using the object's 'repr' method
authored
70 ;; XXX do we need to pass a namespace?
150bd45 @zephyrfalcon some progress with delta-eval
authored
71 (define (delta-eval-string s interp)
e6a4345 @zephyrfalcon much debugging and such
authored
72 (let* ((tokens (tokenize s))
1956654 @zephyrfalcon added *debug* variable
authored
73 (_ (when *debug* (printf "[tokens] ~s~%" tokens)))
5b138f6 @zephyrfalcon REPL: result is printed using the object's 'repr' method
authored
74 (stmts (match-program tokens))
75 (ns (interpreter-toplevel-ns interp)))
1956654 @zephyrfalcon added *debug* variable
authored
76 (when *debug*
77 (pretty-print stmts))
150bd45 @zephyrfalcon some progress with delta-eval
authored
78 (let ((result #f))
79 (for-each
80 (lambda (expr)
5b138f6 @zephyrfalcon REPL: result is printed using the object's 'repr' method
authored
81 (set! result (delta-eval expr ns interp)))
82 stmts)
89b130b @zephyrfalcon moved printing of result to a more appropriate place
authored
83 result)))
18c9cb0 @zephyrfalcon added rudimentary Object.get-slot method
authored
84 ;; FIXME: we should probably pass _all_ of the results, not just the last...
75f1811 @zephyrfalcon normalize MCCs if possible
authored
85
5b138f6 @zephyrfalcon REPL: result is printed using the object's 'repr' method
authored
86 ;; Get the representation of a Delta object by calling its 'repr'
87 ;; method. Returns a Delta object (presumably a String).
88 (define (get-delta-object-repr obj ns interp)
89 (let* ((method (delta-object-get-slot obj "repr"))
90 (f (delta-object-data method)))
91 (f obj '() ns interp)))
92
75f1811 @zephyrfalcon normalize MCCs if possible
authored
93 ;; Evaluate the Delta expression EXPR (an AST object) in namespace NS.
94 (define (delta-eval expr ns interp)
95 (cond ((ast-literal? expr)
150bd45 @zephyrfalcon some progress with delta-eval
authored
96 (case (second expr)
97 ((integer) (new-integer-object interp (third expr)))
98 ((float) ...)
cf11a2f @zephyrfalcon start streamlining creation of builtin protos
authored
99 ((string) (new-string-object interp (third expr)))
c56010d @zephyrfalcon first stab at Symbol proto (builtin)
authored
100 ((symbol) (new-symbol-object interp ;; remove leading "#"
101 (string-slice (third expr) 1)))
dd07cc0 @zephyrfalcon look up identifiers
authored
102 ((identifier) (delta-lookup-name (third expr) ns))
150bd45 @zephyrfalcon some progress with delta-eval
authored
103 (else ...)))
75f1811 @zephyrfalcon normalize MCCs if possible
authored
104 ((ast-block? expr)
2238304 @zephyrfalcon first stab at Block proto
authored
105 (let ((blk (make-delta-block-from-ast expr ns)))
106 (new-block-object interp blk)))
75f1811 @zephyrfalcon normalize MCCs if possible
authored
107 ((ast-method-call-chain? expr)
6d5c505 @zephyrfalcon evaluate method call chains (first attempt)
authored
108 (delta-eval-mcc expr ns interp))
75f1811 @zephyrfalcon normalize MCCs if possible
authored
109 (else (error "Unknown AST node type:" expr))))
110
dd07cc0 @zephyrfalcon look up identifiers
authored
111 (define (delta-lookup-name name ns)
112 (or (namespace-get ns name)
113 (error "Undefined name: " name)))
114
6d5c505 @zephyrfalcon evaluate method call chains (first attempt)
authored
115 ;; Evaluate a method call chain.
116 (define (delta-eval-mcc mcc ns interp)
117 (let ((head (ast-method-call-chain-head mcc))
118 (calls (ast-method-call-chain-calls mcc)))
119 (let* ((target (delta-eval head ns interp))
120 (result target))
121 (for-each (lambda (mc)
122 (let ((method-name (ast-method-call-method mc))
123 (args (ast-method-call-args mc)))
124 (let ((value (delta-eval-method-call result
125 method-name args
126 ns interp)))
127 (set! result value))))
128 calls)
129 result)))
130
131 ;; XXX for now, assumes it's a built-in method, i.e. we get an
132 ;; instance of BuiltinMethod with an actual built-in Scheme function
133 ;; associated with it. add other possibilities later.
134 ;; maybe add a general mechanism that looks for a 'call' method...
135 (define (delta-eval-method-call target method-name ast-args ns interp)
136 (let ((method (delta-object-get-slot target method-name)))
137 (if method
138 (let ((f (delta-object-data method))
139 (evaled-args (map (^a (delta-eval a ns interp)) ast-args)))
140 (f target evaled-args ns interp))
141 (error "Unknown method:" method-name))))
cc00937 @zephyrfalcon added delta-eval-block (untested)
authored
142
143 ;; Evaluate the expressions in the given delta-block record, in the
144 ;; given namespace. (Usually said namespace should derive from the
145 ;; block's associated namespace.)
146 ;; Will be used by built-in method calls.
147 (define (delta-eval-block block ns interp)
148 (let ((result #f))
149 (for-each
150 (lambda (expr)
151 (set! result (delta-eval expr ns interp)))
152 (delta-block-exprs block))
153 result))
154 ;; FIXME: if result is #f, look up and return the Null object
155 ;; (at point of writing, it doesn't exist yet :-)
156
Something went wrong with that request. Please try again.