smalltalk-tng

annotate r1/boot.thing @ 323:454c18798969

merger
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
date Tue Feb 07 11:34:20 2012 -0500 (3 months ago)
parents
children
rev   line source
tonyg@223 1 "-*- slate -*-"
tonyg@223 2
tonyg@223 3 l@(Location traits) addGlobal: name@(Symbol traits) value: val
tonyg@223 4 [
tonyg@223 5 gg := Globals. "look up global 'Globals' outside the block, otherwise we deadlock"
tonyg@223 6 gg --> [ :g | gg <-- (g withSlot: name value: val) ].
tonyg@223 7 val
tonyg@223 8 ].
tonyg@223 9
tonyg@223 10 "Make globals delegate to Oddball."
tonyg@223 11 ( gg := Globals. ob := Oddball traits.
tonyg@223 12 gg --> [ :g | gg <-- (g traits:* ob) ] ).
tonyg@223 13
tonyg@223 14 g@(Globals peek) as: _@(String traits) [ 'Globals' ].
tonyg@223 15
tonyg@223 16 val@(Root traits) ref
tonyg@223 17 [
tonyg@223 18 c := Cell new.
tonyg@223 19 c <-- val.
tonyg@223 20 c
tonyg@223 21 ].
tonyg@223 22
tonyg@223 23 c@(Cell traits) read
tonyg@223 24 [
tonyg@223 25 p --> [ :v | v ]
tonyg@223 26 ].
tonyg@223 27
tonyg@223 28 c@(Cell traits) update: block
tonyg@223 29 [
tonyg@223 30 c --> [ :v | c <-- (block applyWith: v) ]
tonyg@223 31 ].
tonyg@223 32
tonyg@223 33 c@(Cell traits) push: value
tonyg@223 34 [
tonyg@223 35 c update: [ :cdr | value -> cdr ]
tonyg@223 36 ].
tonyg@223 37
tonyg@223 38 block@(Block traits) fork
tonyg@223 39 [
tonyg@223 40 here ( here fork: block. )
tonyg@223 41 ].
tonyg@223 42
tonyg@223 43 block@(Block traits) loop
tonyg@223 44 [
tonyg@223 45 loop := [ block do. loop do. ].
tonyg@223 46 loop do.
tonyg@223 47 ].
tonyg@223 48
tonyg@223 49 p@Nil reverse [ Nil ].
tonyg@223 50 p@(Pair traits) reverse [
tonyg@223 51 loop := [ :p :acc | p ifNil: [ acc ] ifNotNil: [ loop applyWith: p value with: p key -> acc ] ].
tonyg@223 52 loop applyWith: p with: Nil
tonyg@223 53 ].
tonyg@223 54
tonyg@223 55 n1@(Number traits) to: n2@(Number traits) do: block@(Block traits) [
tonyg@223 56 loop := [ :n | (n <= n2) ifTrue: [ block applyWith: n. loop applyWith: n + 1 ] ].
tonyg@223 57 loop applyWith: n1
tonyg@223 58 ].
tonyg@223 59
tonyg@223 60 _@True ifTrue: b@(Block traits) [ b do ].
tonyg@223 61 _@False ifTrue: b@(Block traits) [].
tonyg@223 62
tonyg@223 63 _@True ifFalse: b@(Block traits) [].
tonyg@223 64 _@False ifFalse: b@(Block traits) [ b do ].
tonyg@223 65
tonyg@223 66 _@True ifTrue: b1@(Block traits) ifFalse: b2@(Block traits) [ b1 do ].
tonyg@223 67 _@False ifTrue: b1@(Block traits) ifFalse: b2@(Block traits) [ b2 do ].
tonyg@223 68
tonyg@223 69 _@Nil ifNil: b1@(Block traits) ifNotNil: b2@(Block traits) [ b1 do ].
tonyg@223 70 _@(Root traits) ifNil: b1@(Block traits) ifNotNil: b2@(Block traits) [ b2 do ].
tonyg@223 71
tonyg@223 72 _@Nil ifNil: b@(Block traits) [ b do ].
tonyg@223 73 _@(Root traits) ifNil: b@(Block traits) [].
tonyg@223 74
tonyg@223 75 _@Nil ifNotNil: b@(Block traits) [].
tonyg@223 76 _@(Root traits) ifNotNil: b@(Block traits) [ b do ].
tonyg@223 77
tonyg@223 78 p@Nil concatenate [ Nil ].
tonyg@223 79 p@(Pair traits) concatenate [
tonyg@223 80 p value
tonyg@223 81 ifNil: [ p key ]
tonyg@223 82 ifNotNil: [ p key, p value concatenate ]
tonyg@223 83 ].
tonyg@223 84
tonyg@223 85 s1@(String traits) , s2@(String traits)
tonyg@223 86 [
tonyg@223 87 s1 primStringAppend: s2
tonyg@223 88 ].
tonyg@223 89
tonyg@223 90 t@(Tuple traits) printString
tonyg@223 91 [
tonyg@223 92 p := Nil ref.
tonyg@223 93 p push: '{'.
tonyg@223 94 0 to: (t size - 1) do: [ :index |
tonyg@223 95 (index = 0) ifFalse: [ p push: '. ' ].
tonyg@223 96 p push: (t at: index) printString.
tonyg@223 97 ].
tonyg@223 98 p push: '}'.
tonyg@223 99 p read reverse concatenate
tonyg@223 100 ].
tonyg@223 101
tonyg@223 102 "I am a parallel map."
tonyg@223 103 p@Nil map: block [ Nil ].
tonyg@223 104 p@(Pair traits) map: block [ (block applyWith: p key) -> (p value map: block) ].
tonyg@223 105
tonyg@223 106 "I am a sequential map."
tonyg@223 107 p@Nil mapInOrder: block [].
tonyg@223 108 p@(Pair traits) mapInOrder: block [
tonyg@223 109 h := (block applyWith: p key).
tonyg@223 110 h -> (p value mapInOrder: block)
tonyg@223 111 ].
tonyg@223 112
tonyg@223 113 "I am a sequential for-each."
tonyg@223 114 p@Nil do: block [].
tonyg@223 115 p@(Pair traits) do: block [ block applyWith: p key. p value do: block ].
tonyg@223 116
tonyg@223 117 "I am a parallel for-each."
tonyg@223 118 p@Nil doInParallel: block [].
tonyg@223 119 p@(Pair traits) doInParallel: block [ [block applyWith: p key] fork. p value doInParallel: block ].
tonyg@223 120
tonyg@223 121 p@(Pair traits) printString
tonyg@223 122 [
tonyg@223 123 '(', p key printString, ' -> ', p value printString, ')'
tonyg@223 124 ].
tonyg@223 125
tonyg@223 126 s@(Symbol traits) printString [ '#', resend ].
tonyg@223 127
tonyg@223 128 _@(Globals peek) shutDownImage
tonyg@223 129 [
tonyg@223 130 ShutdownHooks peek do: [ :hook | hook shutDown do. ].
tonyg@223 131 'BOOTSTRAP.image' saveImage.
tonyg@223 132 primQuit.
tonyg@223 133 ].
tonyg@223 134
tonyg@223 135 "---------------------------------------------------------------------------"
tonyg@223 136
tonyg@223 137 "
tonyg@223 138 [
tonyg@223 139 ({1. 2. 3. #four} -> ('Hello, world, from ThiNG!' -> (True -> (123 -> ((#a -> #b) -> Nil)))))
tonyg@223 140 do: [ :each |
tonyg@223 141 each printOn: Console.
tonyg@223 142 Console crlf.
tonyg@223 143 ].
tonyg@223 144 ] fork.
tonyg@223 145 "
tonyg@223 146
tonyg@223 147 here (
tonyg@223 148 here addGlobal: #TraitsTraits value: (Root traits traits). "!!"
tonyg@223 149
tonyg@223 150 t := (name := 'ReplServer' traits :* TraitsTraits).
tonyg@223 151 here addGlobal: #ReplServer value: (traits :* t serverSocket := Nil).
tonyg@223 152 ).
tonyg@223 153
tonyg@223 154 rs0@(ReplServer traits) newOnPort: port@(Number traits)
tonyg@223 155 [
tonyg@223 156 rs := (rs0 serverSocket := port primListen).
tonyg@223 157 [ rs acceptLoop ] fork.
tonyg@223 158 ].
tonyg@223 159
tonyg@223 160 rs@(ReplServer traits) acceptLoop
tonyg@223 161 [
tonyg@223 162 [
tonyg@223 163 sock := rs serverSocket accept.
tonyg@223 164 sock ifNotNil: [ [ rs replOn: sock ] fork. ].
tonyg@223 165 ] loop.
tonyg@223 166 ].
tonyg@223 167
tonyg@223 168 rs@(ReplServer traits) replOn: sock
tonyg@223 169 [ session (
tonyg@223 170 'Welcome to ThiNG!\n' printOn: sock.
tonyg@223 171 [
tonyg@223 172 'ThiNG> ' printOn: sock.
tonyg@223 173 compilationResult := sock compileOneStatement.
tonyg@223 174 compilationResult key
tonyg@223 175 ifTrue: [ compilationResult value do printOn: sock. ]
tonyg@223 176 ifFalse: [
tonyg@223 177 'PARSE ERROR\n' printOn: sock.
tonyg@223 178 compilationResult value printOn: sock.
tonyg@223 179 sock close.
tonyg@223 180 session return: Nil.
tonyg@223 181 ].
tonyg@223 182 '\n' printOn: sock.
tonyg@223 183 ] loop.
tonyg@223 184 )].
tonyg@223 185
tonyg@223 186 here (
tonyg@223 187 here addGlobal: #ShutdownHooks value: Nil ref.
tonyg@223 188 ShutdownHooks push: (shutDown:=[] startUp:=[ ReplServer newOnPort: 4444 ]).
tonyg@223 189 here addGlobal: #BootBlock value: [ ShutdownHooks peek do: [ :hook | hook startUp do. ] ].
tonyg@223 190 shutDownImage.
tonyg@223 191 ).