1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/r1/boot.thing	Sat Oct 08 15:36:03 2011 -0400
     1.3 @@ -0,0 +1,191 @@
     1.4 +"-*- slate -*-"
     1.5 +
     1.6 +l@(Location traits) addGlobal: name@(Symbol traits) value: val
     1.7 +[
     1.8 +  gg := Globals. "look up global 'Globals' outside the block, otherwise we deadlock"
     1.9 +  gg --> [ :g | gg <-- (g withSlot: name value: val) ].
    1.10 +  val
    1.11 +].
    1.12 +
    1.13 +"Make globals delegate to Oddball."
    1.14 +( gg := Globals. ob := Oddball traits.
    1.15 +  gg --> [ :g | gg <-- (g traits:* ob) ] ).
    1.16 +
    1.17 +g@(Globals peek) as: _@(String traits) [ 'Globals' ].
    1.18 +
    1.19 +val@(Root traits) ref
    1.20 +[
    1.21 +  c := Cell new.
    1.22 +  c <-- val.
    1.23 +  c
    1.24 +].
    1.25 +
    1.26 +c@(Cell traits) read
    1.27 +[
    1.28 +  p --> [ :v | v ]
    1.29 +].
    1.30 +
    1.31 +c@(Cell traits) update: block
    1.32 +[
    1.33 +  c --> [ :v | c <-- (block applyWith: v) ]
    1.34 +].
    1.35 +
    1.36 +c@(Cell traits) push: value
    1.37 +[
    1.38 +  c update: [ :cdr | value -> cdr ]
    1.39 +].
    1.40 +
    1.41 +block@(Block traits) fork
    1.42 +[
    1.43 +  here ( here fork: block. )
    1.44 +].
    1.45 +
    1.46 +block@(Block traits) loop
    1.47 +[
    1.48 +  loop := [ block do. loop do. ].
    1.49 +  loop do.
    1.50 +].
    1.51 +
    1.52 +p@Nil reverse [ Nil ].
    1.53 +p@(Pair traits) reverse [
    1.54 +  loop := [ :p :acc | p  ifNil: [ acc ] ifNotNil: [ loop applyWith: p value with: p key -> acc ] ].
    1.55 +  loop applyWith: p with: Nil
    1.56 +].
    1.57 +
    1.58 +n1@(Number traits) to: n2@(Number traits) do: block@(Block traits) [
    1.59 +  loop := [ :n | (n <= n2) ifTrue: [ block applyWith: n. loop applyWith: n + 1 ] ].
    1.60 +  loop applyWith: n1
    1.61 +].
    1.62 +
    1.63 +_@True ifTrue: b@(Block traits) [ b do ].
    1.64 +_@False ifTrue: b@(Block traits) [].
    1.65 +
    1.66 +_@True ifFalse: b@(Block traits) [].
    1.67 +_@False ifFalse: b@(Block traits) [ b do ].
    1.68 +
    1.69 +_@True ifTrue: b1@(Block traits) ifFalse: b2@(Block traits) [ b1 do ].
    1.70 +_@False ifTrue: b1@(Block traits) ifFalse: b2@(Block traits) [ b2 do ].
    1.71 +
    1.72 +_@Nil ifNil: b1@(Block traits) ifNotNil: b2@(Block traits) [ b1 do ].
    1.73 +_@(Root traits) ifNil: b1@(Block traits) ifNotNil: b2@(Block traits) [ b2 do ].
    1.74 +
    1.75 +_@Nil ifNil: b@(Block traits) [ b do ].
    1.76 +_@(Root traits) ifNil: b@(Block traits) [].
    1.77 +
    1.78 +_@Nil ifNotNil: b@(Block traits) [].
    1.79 +_@(Root traits) ifNotNil: b@(Block traits) [ b do ].
    1.80 +
    1.81 +p@Nil concatenate [ Nil ].
    1.82 +p@(Pair traits) concatenate [
    1.83 +  p value
    1.84 +    ifNil: [ p key ]
    1.85 +    ifNotNil: [ p key, p value concatenate ]
    1.86 +].
    1.87 +
    1.88 +s1@(String traits) , s2@(String traits)
    1.89 +[
    1.90 +  s1 primStringAppend: s2
    1.91 +].
    1.92 +
    1.93 +t@(Tuple traits) printString
    1.94 +[
    1.95 +  p := Nil ref.
    1.96 +  p push: '{'.
    1.97 +  0 to: (t size - 1) do: [ :index |
    1.98 +    (index = 0) ifFalse: [ p push: '. ' ].
    1.99 +    p push: (t at: index) printString.
   1.100 +  ].
   1.101 +  p push: '}'.
   1.102 +  p read reverse concatenate
   1.103 +].
   1.104 +
   1.105 +"I am a parallel map."
   1.106 +p@Nil map: block [ Nil ].
   1.107 +p@(Pair traits) map: block [ (block applyWith: p key) -> (p value map: block) ].
   1.108 +
   1.109 +"I am a sequential map."
   1.110 +p@Nil mapInOrder: block [].
   1.111 +p@(Pair traits) mapInOrder: block [
   1.112 +  h := (block applyWith: p key).
   1.113 +  h -> (p value mapInOrder: block)
   1.114 +].
   1.115 +
   1.116 +"I am a sequential for-each."
   1.117 +p@Nil do: block [].
   1.118 +p@(Pair traits) do: block [ block applyWith: p key. p value do: block ].
   1.119 +
   1.120 +"I am a parallel for-each."
   1.121 +p@Nil doInParallel: block [].
   1.122 +p@(Pair traits) doInParallel: block [ [block applyWith: p key] fork. p value doInParallel: block ].
   1.123 +
   1.124 +p@(Pair traits) printString
   1.125 +[
   1.126 +  '(', p key printString, ' -> ', p value printString, ')'
   1.127 +].
   1.128 +
   1.129 +s@(Symbol traits) printString [ '#', resend ].
   1.130 +
   1.131 +_@(Globals peek) shutDownImage
   1.132 +[
   1.133 +  ShutdownHooks peek do: [ :hook | hook shutDown do. ].
   1.134 +  'BOOTSTRAP.image' saveImage.
   1.135 +  primQuit.
   1.136 +].
   1.137 +
   1.138 +"---------------------------------------------------------------------------"
   1.139 +
   1.140 +"
   1.141 +[
   1.142 +  ({1. 2. 3. #four} -> ('Hello, world, from ThiNG!' -> (True -> (123 -> ((#a -> #b) -> Nil)))))
   1.143 +  do: [ :each |
   1.144 +    each printOn: Console.
   1.145 +    Console crlf.
   1.146 +  ].
   1.147 +] fork.
   1.148 +"
   1.149 +
   1.150 +here (
   1.151 +  here addGlobal: #TraitsTraits value: (Root traits traits). "!!"
   1.152 +
   1.153 +  t := (name := 'ReplServer' traits :* TraitsTraits).
   1.154 +  here addGlobal: #ReplServer value: (traits :* t serverSocket := Nil).
   1.155 +).
   1.156 +
   1.157 +rs0@(ReplServer traits) newOnPort: port@(Number traits)
   1.158 +[
   1.159 +  rs := (rs0 serverSocket := port primListen).
   1.160 +  [ rs acceptLoop ] fork.
   1.161 +].
   1.162 +
   1.163 +rs@(ReplServer traits) acceptLoop
   1.164 +[
   1.165 +  [
   1.166 +    sock := rs serverSocket accept.
   1.167 +    sock ifNotNil: [ [ rs replOn: sock ] fork. ].
   1.168 +  ] loop.
   1.169 +].
   1.170 +
   1.171 +rs@(ReplServer traits) replOn: sock
   1.172 +[ session (
   1.173 +  'Welcome to ThiNG!\n' printOn: sock.
   1.174 +  [
   1.175 +    'ThiNG> ' printOn: sock.
   1.176 +    compilationResult := sock compileOneStatement.
   1.177 +    compilationResult key
   1.178 +      ifTrue: [ compilationResult value do printOn: sock. ]
   1.179 +      ifFalse: [
   1.180 +        'PARSE ERROR\n' printOn: sock.
   1.181 +        compilationResult value printOn: sock.
   1.182 +        sock close.
   1.183 +        session return: Nil.
   1.184 +      ].
   1.185 +    '\n' printOn: sock.
   1.186 +  ] loop.
   1.187 +)].
   1.188 +
   1.189 +here (
   1.190 +  here addGlobal: #ShutdownHooks value: Nil ref.
   1.191 +  ShutdownHooks push: (shutDown:=[] startUp:=[ ReplServer newOnPort: 4444 ]).
   1.192 +  here addGlobal: #BootBlock value: [ ShutdownHooks peek do: [ :hook | hook startUp do. ] ].
   1.193 +  shutDownImage.
   1.194 +).