Skip to content

Commit 209fc7e

Browse files
author
btj12
committed
Merge branch 'fix-super' into 'master'
Entirely change super to make it work See merge request btj12/Interpreter!79
2 parents c669f85 + 80b7907 commit 209fc7e

1 file changed

Lines changed: 103 additions & 29 deletions

File tree

‎state-manipulation.scm‎

Lines changed: 103 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@
2525
(lambda (program state)
2626
(evaluate-parse-tree-with-cfuncs->retval_state program state empty-cfuncs)))
2727

28+
2829
(define evaluate-parse-tree-with-cfuncs->retval_state
2930
(lambda (program state cfuncsinstance)
3031
(call/cc
@@ -37,7 +38,7 @@
3738
(else (list '() (evaluate-statement-list->state program state
3839
(cfuncs-update-return cfuncsinstance return)))))))))
3940

40-
;(trace evaluate-parse-tree->retval_state)
41+
;(trace evaluate-parse-tree-with-cfuncs->retval_state)
4142

4243

4344
(define evaluate-statement-list->state
@@ -122,40 +123,87 @@
122123
(lambda (name args state cfuncsinstance)
123124
(cond
124125
((and (dot-expr? name) (eq? (dotted-class-instance (arglist-dot name)) 'this))
125-
(eval-function-post-name-eval (dotted-class-call (arglist-dot name)) args state state default-superclass cfuncsinstance))
126+
(let* ([evaled-function (eval-function-post-name-eval (dotted-class-call (arglist-dot name))
127+
args
128+
state
129+
state
130+
(get-base-class state cfuncsinstance)
131+
#t
132+
cfuncsinstance)]
133+
[function-return (get-value-from-pair evaled-function)]
134+
[function-state (get-state-from-pair evaled-function)])
135+
(list function-return function-state)))
126136
((and (dot-expr? name) (eq? (dotted-class-instance (arglist-dot name)) 'super))
127137
(eval-function-post-name-eval (dotted-class-call (arglist-dot name))
128138
args
129139
state
130140
state
131-
(get-value-from-pair (G-value-lookup->value_state '.class state cfuncsinstance))
141+
(get-current-class state cfuncsinstance)
142+
#f
132143
cfuncsinstance))
133144
((dot-expr? name)
134145
(let* ([dottedname (arglist-dot name)]
135146
[evaled-function (eval-function-post-name-eval (evaluate-dotted-function-name dottedname state)
136147
args
137148
state
138149
(construct-dotted-state dottedname state)
139-
default-superclass
150+
(get-current-class (construct-dotted-state dottedname state) cfuncsinstance)
151+
#t
140152
cfuncsinstance)]
141153
[function-return (get-value-from-pair evaled-function)]
142154
[function-state (get-state-from-pair evaled-function)])
143-
;possible error, extract should be called on function state
144155
(list function-return (update-class-instance (dotted-class-instance dottedname) (extract-new-class-instance-state function-state) state))))
145156

146-
(else (eval-function-post-name-eval name args state state default-superclass cfuncsinstance)))))
157+
(else (eval-function-post-name-eval name args state state default-currentclass #t cfuncsinstance)))))
147158
;(trace G-eval-function->value_state)
148-
(define default-superclass '())
159+
(define get-base-class
160+
(lambda (state cfuncsinstance)
161+
(get-value-from-pair (G-value-lookup->value_state '.class state cfuncsinstance))))
162+
(define get-current-class
163+
(lambda (state cfuncsinstance)
164+
(cond
165+
((G-initialized? '.this state) (get-value-from-pair (G-value-lookup->value_state '.this state cfuncsinstance)))
166+
(else (get-value-from-pair (G-value-lookup->value_state '.class state cfuncsinstance))))))
167+
168+
(define get-super-class
169+
(lambda (currentclass state)
170+
(cond
171+
((null? state) '())
172+
((null? currentclass) default-currentclass)
173+
((declared-in-scope? (get-variable-section-state (get-top-scope state)) '.class)
174+
(cond
175+
((and (eq? (car (get-value-section-state (get-top-scope state))) currentclass)
176+
(G-initialized? '.class (get-tail-scope state)))
177+
(get-value-from-pair (G-value-lookup->value_state '.class (get-tail-scope state) empty-cfuncs)))
178+
(else (get-super-class currentclass (get-tail-scope state)))))
179+
(else (get-super-class currentclass (get-tail-scope state))))))
180+
181+
182+
(define default-currentclass '())
149183

150184
(define eval-function-post-name-eval
151-
(lambda (name args state function-state superclass cfuncsinstance)
152-
(let* ([popped-state (G-add-empty-scope-to-state->state
153-
(G-push-stack-divider-to-state->state superclass
154-
(G-pop-scope-to-function->state
155-
name
156-
superclass
157-
function-state)))]
158-
[function-in-state (variable-value-lookup name popped-state)]
185+
(lambda (name args state function-state current-class preserve-current-class cfuncsinstance)
186+
(let* ([super-popped-state (G-add-empty-scope-to-state->state
187+
(G-push-stack-divider-to-state->state current-class
188+
(G-pop-scope-to-function->state
189+
name
190+
(if preserve-current-class
191+
current-class
192+
(get-super-class current-class state))
193+
function-state)))]
194+
[popped-state
195+
(push-variable-as-literal->state '.this
196+
(if preserve-current-class
197+
current-class
198+
(get-value-from-pair (G-value-lookup->value_state '.class super-popped-state cfuncsinstance)))
199+
(G-add-empty-scope-to-state->state
200+
(G-push-stack-divider-to-state->state current-class
201+
(G-pop-scope-to-function-or-class->state
202+
name
203+
current-class
204+
function-state))))]
205+
206+
[function-in-state (variable-value-lookup name super-popped-state)]
159207
[evaluate-function-call
160208
(evaluate-parse-tree-with-cfuncs->retval_state
161209
(get-funcall-body function-in-state)
@@ -178,6 +226,7 @@
178226
(G-pop-to-stack-divider->state
179227
(get-state-from-pair
180228
evaluate-function-call)))))))
229+
181230
;(trace eval-function-post-name-eval)
182231
(define evaluate-actual-args-for-state
183232
(lambda (actual state cfuncsinstance)
@@ -223,14 +272,14 @@
223272
(define extract-new-class-instance-state
224273
(lambda (state)
225274
(reverse (extract-new-class-instance-state-sub (get-tail-scope (reverse state))))))
226-
;(trace extract-new-class-instance-state)
275+
227276
(define extract-new-class-instance-state-sub
228277
(lambda (state)
229278
(cond
230279
((null? state) '())
231280
((is-top-scope-class-divider? state) '())
232281
(else (cons (get-top-scope state) (extract-new-class-instance-state-sub (get-tail-scope state)))))))
233-
;(trace extract-new-class-instance-state-sub)
282+
234283
(define update-class-instance
235284
(lambda (instancename new-instance-state state)
236285
(G-push-state->state
@@ -477,7 +526,7 @@
477526
(list (get-instance-initialization-value arglist state) state))
478527
(else (error "not a valid atomic statement" arglist state)))))
479528

480-
;(trace G-eval-atomic-statement->value_state)
529+
481530
; STUB
482531
(define dot-expr?
483532
(lambda (arglist)
@@ -576,7 +625,7 @@
576625
(get-value-from-pair evaluate-assign)
577626
(get-state-from-pair evaluate-assign)) cfuncsinstance))
578627
(else (error "variable undeclared args:" arglist "state" state))))))
579-
;(trace G-eval-assign->value_state)
628+
580629
(define evaluate-dotted-assign->value_state
581630
(lambda (dot-expression assign-value state cfuncsinstance)
582631
(cond
@@ -600,7 +649,7 @@
600649
(G-eval-assign->value_state `(= ,(dotted-class-call dot-expression) ,assign-value) (construct-dotted-state dot-expression state) cfuncsinstance)))
601650
state)))))
602651

603-
;(trace evaluate-dotted-assign->value_state)
652+
604653

605654

606655
; Determines whether or not an assignment argument is reached
@@ -800,7 +849,7 @@
800849
((state-empty? state) #f)
801850
((declared-in-scope? (get-variable-section-state (get-top-scope state)) variable-name) #t)
802851
(else (G-declared? variable-name (get-tail-scope state))))))
803-
;(trace G-declared?)
852+
804853
; Determines if a variable was declared in a scope
805854
(define G-declared-in-stack-frame?
806855
(lambda (variable-name state)
@@ -978,30 +1027,55 @@
9781027
(G-type-lookup (variable-value-lookup variable state) state cfuncsinstance)))
9791028

9801029
; Pops scopes off of the state until the head scope contains a function
1030+
;pops to the scope after the currentclass
1031+
(define G-pop-scope-to-function-or-class->state
1032+
(lambda (fn desiredclass state)
1033+
(cond
1034+
((null? state) (error "function was not found in state"))
1035+
((null? desiredclass) (pop-scope-to-function-default fn state))
1036+
((declared-in-scope? (get-variable-section-state (get-top-scope state)) '.class)
1037+
(cond
1038+
((eq? (car (get-value-section-state (get-top-scope state))) desiredclass) state)
1039+
(else (G-pop-scope-to-function-or-class->state fn desiredclass (get-tail-scope state)))))
1040+
((declared-in-scope? (get-variable-section-state (get-top-scope state)) fn) state)
1041+
(else (G-pop-scope-to-function-or-class->state fn desiredclass (get-tail-scope state))))))
1042+
9811043
(define G-pop-scope-to-function->state
982-
(lambda (fn superclass state)
1044+
(lambda (fn desiredclass state)
9831045
(cond
9841046
((null? state) (error "function was not found in state"))
985-
((null? superclass) (pop-scope-to-function-default fn state))
1047+
((null? desiredclass) (pop-scope-to-function-default fn state))
9861048
((declared-in-scope? (get-variable-section-state (get-top-scope state)) '.class)
9871049
(cond
988-
((eq? (car (get-value-section-state (get-top-scope state))) superclass) (pop-scope-to-function-default fn (get-tail-scope state)))
989-
(else (G-pop-scope-to-function->state fn superclass (get-tail-scope state)))))
990-
(else (G-pop-scope-to-function->state fn superclass (get-tail-scope state))))))
1050+
((eq? (car (get-value-section-state (get-top-scope state))) desiredclass) (pop-scope-to-function-default fn state))
1051+
(else (G-pop-scope-to-function->state fn desiredclass (get-tail-scope state)))))
1052+
((declared-in-scope? (get-variable-section-state (get-top-scope state)) fn) state)
1053+
(else (G-pop-scope-to-function->state fn desiredclass (get-tail-scope state))))))
9911054

9921055
(define pop-scope-to-function-default
9931056
(lambda (fn state)
9941057
(cond
9951058
((null? state) (error "function was not found in state"))
9961059
((declared-in-scope? (get-variable-section-state (get-top-scope state)) fn) state)
9971060
(else (pop-scope-to-function-default fn (get-tail-scope state))))))
998-
;(trace G-pop-scope-to-function->state)
1061+
1062+
1063+
(define G-shortmerge-states->state
1064+
(lambda (origin-state mod-state)
1065+
(reverse (shortmerge (reverse origin-state) (reverse mod-state)))))
1066+
1067+
(define shortmerge
1068+
(lambda (orig-state mod-state)
1069+
(cond
1070+
((null? orig-state) '())
1071+
(else (cons (get-top-scope mod-state)
1072+
(shortmerge (get-tail-scope orig-state)(get-tail-scope mod-state)))))))
9991073
; Merges an original state with the state after a funciton call,
10001074
; assumes that the function call state has smaller airty than the original state
10011075
(define G-merge-states->state
10021076
(lambda (origin-state mod-state)
10031077
(reverse (merge (reverse origin-state) (reverse mod-state)))))
1004-
;(trace G-merge-states->state)
1078+
10051079
; merges two reversed states
10061080
(define merge
10071081
(lambda (orig-state mod-state)
@@ -1069,7 +1143,7 @@
10691143
((null? (G-get-class-superclass classname state)) (evaluate-closure->state classname state))
10701144
(else (cons (get-top-scope
10711145
(evaluate-closure->state classname state)) (G-eval-class-closure->state (G-get-class-superclass classname state) state))))))
1072-
;(trace G-eval-class-closure->state)
1146+
10731147
(define evaluate-closure->state
10741148
(lambda (classname state)
10751149
(push-variable-as-literal->state '.class

0 commit comments

Comments
 (0)