hyung-hwan/moo
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added Apex>>hash

Browse Source 
added Symbol>>asString
revised String>>&
added some methods to Dictionary
This commit is contained in:
hyunghwan.chung
2017-01-05 10:16:04 +00:00
parent c8f97832c5
commit af9c144a1c
12 changed files with 446 additions and 139 deletions
Download Patch File Download Diff File Expand all files Collapse all files

60
stix/kernel/Apex.st
View File

@ -121,29 +121,41 @@
self primitiveFailed.
}
#method basicAt: anInteger
#method basicAt: index
{
<primitive: #_basic_at>
## TODO: chagne it to 'self outOfRangeError' or something.
self error: 'out of range'.
self index: index outOfRange: (self basicSize).
}
#method basicAt: anInteger put: anObject
#method basicAt: index put: anObject
{
<primitive: #_basic_at_put>
self error: 'out of range'.
self index: index outOfRange: (self basicSize).
}
#method(#class) basicAt: anInteger
#method(#class) basicAt: index
{
<primitive: #_basic_at>
self error: 'out of range'.
self index: index outOfRange: (self basicSize).
}
#method(#class) basicAt: anInteger put: anObject
#method(#class) basicAt: index put: anObject
{
<primitive: #_basic_at_put>
self error: 'out of range'.
self index: index outOfRange: (self basicSize).
}
## -------------------------------------------------------
## -------------------------------------------------------
#method(#class) hash
{
<primitive: #_hash>
self subclassResponsibility: #hash
}
#method hash
{
<primitive: #_hash>
self subclassResponsibility: #hash
}
## -------------------------------------------------------
@ -270,7 +282,6 @@
}
"
## -------------------------------------------------------
## -------------------------------------------------------
## method(#class) primitiveFailed
@ -300,10 +311,31 @@
self class error: aString.
}
#method index: index outOfRange: ubound
{
self class index: index outOfRange: ubound.
}
#method cannotInstantiate
{
self class cannotInstantiate
}
#method subclassResponsibility: message_name
{
self class subclassResponsibility: message_name
}
#method cannotExceptionizeError
{
self class cannotExceptionizeError
}
#method exceptionizeError: trueOrFalse
{
<primitive: #_exceptionize_error>
self class cannotExceptionizeError
}
}
#class Object(Apex)
@ -332,14 +364,14 @@
}
}
(* --------------------
#pooldic Error
#pooldic ErrorCode
{
(* migrate it into Error class *)
#NONE := error(0).
#GENERIC := error(1).
#
#NOENT := error(2).
}
------------------- *)
#class Error(Apex)
{

127
stix/kernel/Collect.st
View File

@ -51,28 +51,47 @@
#class(#character) String(Array)
{
#method & aString
#method & string
{
## concatenate two strings.
## TOOD: make this a primitive for performance.
| newsize newstr self_ubound |
(* TOOD: make this a primitive for performance. *)
(* concatenate two strings. *)
| newsize newstr cursize appsize |
newsize := self basicSize + aString basicSize.
##newstr := self class basicNew: newsize.
newstr := String basicNew: newsize. ## TODO: redefine , for symbol... it's a work arouind... symbols are not concatenated to a symbol at this moment.
self_ubound := self ubound.
cursize := self basicSize.
appsize := string basicSize.
newsize := cursize + appsize.
(*newstr := self class basicNew: newsize.*)
newstr := String basicNew: newsize.
0 to: self_ubound do: [:i | newstr at: i put: (self at: i) ].
0 to: (aString ubound) do: [:i | newstr at: (i + self_ubound + 1) put: (aString at: i) ].
0 priorTo: cursize do: [:i | newstr at: i put: (self at: i) ].
0 priorTo: appsize do: [:i | newstr at: (i + cursize) put: (string at: i) ].
^newstr
}
#method asString
{
^self
}
}
## -------------------------------------------------------------------------------
#class(#character) Symbol(String)
{
#method asString
{
(* TODO: make this a primitive for performance *)
(* convert a symbol to a string *)
| size str |
size := self basicSize.
str := String basicNew: size.
0 priorTo: size do: [:i | str at: i put: (self at: i) ].
^str.
}
}
## -------------------------------------------------------------------------------
@ -95,6 +114,94 @@
#class Set(Collection)
{
#dcl tally bucket.
#method initialize
{
self.tally := 0.
self.bucket := Array new: 100.
}
#method size
{
^self.tally
}
#method at: key
{
| ass |
ass := self __find: key or_upsert: false with: nil.
(ass notNil) ifTrue: [^ass value].
^ErrorCode.NOENT
}
#method at: key ifAbsent: error_block
{
| ass |
ass := self __find: key or_upsert: false with: nil.
(ass notNil) ifTrue: [^ass value].
^error_block value.
}
#method at: key put: value
{
self __find: key or_upsert: true with: value.
^value
}
#method __find: key or_upsert: upsert with: value
{
| hv ass bs index ntally |
bs := self.bucket size.
hv := key hash.
index := hv rem: bs.
[(ass := self.bucket at: index) notNil]
whileTrue: [
[key == ass key] ifTrue: [
(* found *)
upsert ifTrue: [ass value: value].
^ass
].
index := (index + 1) rem: bs.
].
upsert ifFalse: [^nil].
ntally := self.tally + 1.
(ntally >= bs) ifTrue: [
(* expand the bucket *)
].
ass := Association key: key value: value.
self.tally := ntally.
self.bucket at: index put: ass.
^ass
}
#method do: block
{
| bs |
bs := self.bucket size.
0 priorTo: bs by: 1 do: [:i |
| ass |
(ass := self.bucket at: i) notNil ifTrue: [block value: ass value]
].
}
#method keysAndValuesDo: block
{
| bs |
bs := self.bucket size.
0 priorTo: bs by: 1 do: [:i |
| ass |
(ass := self.bucket at: i) notNil ifTrue: [block value: ass key value: ass value]
].
}
}
#class SymbolSet(Set)

164
stix/kernel/Except.st
View File

@ -28,6 +28,11 @@
^self.messageText
}
#method asString
{
^(self class name) & ' - ' & self.messageText.
}
#method __signal
{
self.signalContext := thisContext.
@ -36,24 +41,24 @@
#method signal
{
| excctx excblk retval actpos |
| exctx exblk retval actpos |
self.signalContext := thisContext.
excctx := (thisContext sender) findExceptionContext.
[excctx notNil] whileTrue: [
excblk := excctx findExceptionHandlerFor: (self class).
(excblk notNil and:
[actpos := excctx basicSize - 1. excctx basicAt: actpos]) ifTrue: [
self.handlerContext := excctx.
excctx basicAt: actpos put: false.
[ retval := excblk value: self ] ensure: [
excctx basicAt: actpos put: true
exctx := (thisContext sender) findExceptionContext.
[exctx notNil] whileTrue: [
exblk := exctx findExceptionHandlerFor: (self class).
(exblk notNil and:
[actpos := exctx basicSize - 1. exctx basicAt: actpos]) ifTrue: [
self.handlerContext := exctx.
exctx basicAt: actpos put: false.
[ retval := exblk value: self ] ensure: [
exctx basicAt: actpos put: true
].
thisContext unwindTo: (excctx sender) return: nil.
Processor return: retval to: (excctx sender).
thisContext unwindTo: (exctx sender) return: nil.
Processor return: retval to: (exctx sender).
].
excctx := (excctx sender) findExceptionContext.
exctx := (exctx sender) findExceptionContext.
].
## -----------------------------------------------------------------
@ -195,6 +200,14 @@
#method ensureBlock
{
## TODO: change 8 to a constant when stix is enhanced to support constant definition
(* [ value-block ] ensure: [ ensure-block ]
* assuming ensure block is a parameter the ensure: method to a
* block context, the first parameter is placed after the fixed
* instance variables of the method context. As MethodContex has
* 8 instance variables, the ensure block must be at the 9th position
* which translates to index 8 *)
(self.method preambleCode == 11) ifFalse: [^nil].
^self basicAt: 8.
}
@ -202,21 +215,26 @@
#method findExceptionHandlerFor: exception_class
{
## find an exception handler block for a given exception class.
##
## for this to work, self must be an exception handler context.
## For a single on:do: call,
## self class specNumInstVars must return 8.
## basicAt: 8 must be the on: argument.
## basicAt: 9 must be the do: argument
(* find an exception handler block for a given exception class.
*
* for this to work, self must be an exception handler context.
* For a single on:do: call,
* self class specNumInstVars must return 8.(i.e.MethodContext has 8 instance variables.)
* basicAt: 8 must be the on: argument.
* basicAt: 9 must be the do: argument *)
(self isExceptionContext) ifTrue: [
| bound exc |
## NOTE: if on:do: has a temporary varible, bound must be adjusted to reflect it.
bound := self basicSize - 1.
## TODO: change 8 to a constant when stix is enhanced to support constant definition
## or calcuate the minimum size using the class information.
8 to: bound by: 2 do: [ :i |
(self isExceptionContext) ifTrue: [
| size exc |
(* NOTE: the following loop scans all parameters to the on:do: method.
* if the on:do: method contains local temporary variables,
* those must be skipped from scanning. *)
size := self basicSize.
8 priorTo: size by: 2 do: [ :i |
exc := self basicAt: i.
((exception_class == exc) or: [exception_class inheritsFrom: exc]) ifTrue: [^self basicAt: (i + 1)].
]
@ -226,20 +244,20 @@
#method handleException: exception
{
## -------------------------------------------------------------------
## <<private>>
## called by Exception>>signal.
## this method only exists in the MethodContext and UndefinedObject.
## the caller must make sure that the receiver object is
## a method context or nil. Exception>>signal invokes this method
## only for an exception context which is a method context. it
## invokes it for nil when no exception context is found.
## -------------------------------------------------------------------
(* -----------------------------------------------------------------
* <<private>>
* called by Exception>>signal.
* this method only exists in the MethodContext and UndefinedObject.
* the caller must make sure that the receiver object is
* a method context or nil. Exception>>signal invokes this method
* only for an exception context which is a method context. it
* invokes it for nil when no exception context is found.
* ---------------------------------------------------------------- *)
| excblk retval actpos |
## position of the temporary variable 'active' in MethodContext>>on:do.
## for this code to work, it must be the last temporary variable in the method.
(* position of the temporary variable 'active' in MethodContext>>on:do.
* for this code to work, it must be the last temporary variable in the method. *)
actpos := (self basicSize) - 1.
excblk := self findExceptionHandlerFor: (exception class).
@ -252,13 +270,13 @@
exception handlerContext: self.
## -------------------------------------------------------------------
## if an exception occurs within an exception handler block,
## the search will reach this context again as the exception block
## is evaluated before actual unwinding. set the temporary variable
## in the exception context to mask out this context from the search
## list.
## -------------------------------------------------------------------
(* -----------------------------------------------------------------
* if an exception occurs within an exception handler block,
* the search will reach this context again as the exception block
* is evaluated before actual unwinding. set the temporary variable
* in the exception context to mask out this context from the search
* list.
* ---------------------------------------------------------------- *)
self basicAt: actpos put: false.
[ retval := excblk value: exception ] ensure: [
self basicAt: actpos put: true
@ -266,13 +284,11 @@
##(self.sender isNil) ifTrue: [ "TODO: CANNOT RETURN" ].
## -------------------------------------------------------------------
## return to self.sender which is a caller of the exception context (on:do:)
## pass the first ensure context between thisContext and self.sender.
##
## [ [Exception signal: 'xxx'] ensure: [20] ] on: Exception do: [:ex | ...]
##
## -------------------------------------------------------------------
(* -----------------------------------------------------------------
* return to self.sender which is a caller of the exception context (on:do:)
* pass the first ensure context between thisContext and self.sender.
* [ [Exception signal: 'xxx'] ensure: [20] ] on: Exception do: [:ex | ...]
* ---------------------------------------------------------------- *)
thisContext unwindTo: self.sender return: nil.
Processor return: retval to: self.sender.
}
@ -286,13 +302,14 @@
| exception_active |
<exception>
"thisContext isExceptionContext dump.
(* -------------------------------
thisContext isExceptionContext dump.
(thisContext basicSize) dump.
(thisContext basicAt: 8) dump. ## this should be anException
(thisContext basicAt: 9) dump. ## this should be anExceptionBlock
(thisContext basicAt: 10) dump. ## this should be handlerActive
'on:do: ABOUT TO EVALUE THE RECEIVER BLOCK' dump."
'on:do: ABOUT TO EVALUE THE RECEIVER BLOCK' dump.
---------------------------------- *)
exception_active := true.
^self value.
}
@ -334,6 +351,10 @@
##============================================================================
#class InstantiationFailureException(Exception)
{
}
#class NoSuchMessageException(Exception)
{
}
@ -342,6 +363,18 @@
{
}
#class IndexOutOfRangeException(Exception)
{
}
#class SubclassResponsibilityException(Exception)
{
}
#class ErrorExceptionizationFailureException(Exception)
{
}
#extend Apex
{
#method(#class) primitiveFailed
@ -362,14 +395,29 @@ ctx := thisContext.
#method(#class) cannotInstantiate
{
Exception signal: 'Cannot instantiate'.
## TOOD: accept a class
InstantiationFailureException signal: 'Cannot instantiate'.
}
#method(#class) doesNotUnderstand: messageSymbol
#method(#class) doesNotUnderstand: message_name
{
## TODO: implement this properly
NoSuchMessageException signal: (messageSymbol & ' not understood by ' & (self name)).
NoSuchMessageException signal: (message_name & ' not understood by ' & (self name)).
}
#method(#class) index: index outOfRange: ubound
{
IndexOutOfRangeException signal: 'Out of range'.
}
#method(#class) subclassResponsibility: message_name
{
SubclassResponsibilityException signal: ('Subclass must implment ' & message_name).
}
#method(#class) cannotExceptionizeError
{
## todo: accept the object
ErrorExceptionizationFailureException signal: 'Cannot exceptionize an error'
}
}

11
stix/kernel/Stix.st
View File

@ -11,6 +11,10 @@
{
#dcl key value.
#method(#class) key: key value: value
{
^self new key: key value: value
}
#method key: key value: value
{
self.key := key.
@ -154,6 +158,9 @@
#method bitShift: aNumber
{
(* positive number for left shift.
* negative number for right shift *)
<primitive: #_integer_bitshift>
self primitiveFailed.
}
@ -303,7 +310,7 @@
#method preambleCode
{
^self.preamble bitAnd: 16rFF.
^(self.preamble bitAnd: 16rFF) bitShift: -2.
}
#method owner
@ -396,4 +403,4 @@ f isNil ifTrue: [ self error: 'No such function' ].
#########################################################################################
#include 'Stdio.st'.
#include 'Console.st'.
#include 'Console.st'.

2
stix/kernel/test-014.st
View File

@ -226,7 +226,7 @@
#! [ a = error(10) ] ifTrue: [....].
#! self t001 (error:10).
#! self t001: (error:10)
#! self t001: (error:10)
}
}