modules/repl.st

   1 "
   2  coded by Ketmar // Vampire Avalon (psyc://ketmar.no-ip.org/~Ketmar)
   3  Understanding is not required. Only obedience.
   4
   5  This program is free software. It comes without any warranty, to
   6  the extent permitted by applicable law. You can redistribute it
   7  and/or modify it under the terms of the Do What The Fuck You Want
   8  To Public License, Version 2, as published by Sam Hocevar. See
   9  http://sam.zoy.org/wtfpl/COPYING for more details.
  10 "
  11 Requires [ quit ]
  12
  13 Package [
  14   Repl
  15 ]
  16
  17 class: ReplCommand [
  18 | aBlock descr |
  19
  20 ^newWith: blk descr: dsc [
  21   ^(super new) initWith: blk descr: dsc
  22 ]
  23
  24 initWith: blk descr: dsc [
  25   aBlock := blk.
  26   descr := dsc.
  27   ^self
  28 ]
  29
  30 doWith: args [
  31   ^aBlock value: args
  32 ]
  33
  34 descr [
  35   ^descr
  36 ]
  37 ]
  38
  39
  40 class: ReplCommands [
  41 | cmdList |
  42
  43 ^new [
  44   ^(super new) init
  45 ]
  46
  47 init [
  48   cmdList := Dictionary new.
  49   ^self
  50 ]
  51
  52 cmdList [
  53   ^cmdList
  54 ]
  55
  56 add: cmd descr: descr handler: hand [
  57   | co |
  58   co := ReplCommand newWith: hand descr: descr.
  59   cmdList at: cmd put: co.
  60 ]
  61
  62 do: cmdline [
  63   | args cmd |
  64   args := cmdline break: (' \t').
  65   args size < 1 ifTrue: [ ^nil ].
  66   cmd := cmdList at: (args at: 1)
  67     ifAbsent: [
  68       (args at: 1) = ':h'
  69         ifTrue: [
  70           'avaliable commands:' printNl.
  71           cmdList keysAndValuesDo: [ :key :value |
  72             '  ' print. key print. String tab print.
  73             value descr printNl.
  74           ].
  75          ]
  76         ifFalse: [
  77           'unknown command: ' print.
  78           (args at: 1) printNl.
  79         ].
  80       ^nil ].
  81   ^cmd doWith: args
  82 ]
  83 ]
  84
  85
  86 class: ExtREPL [
  87 | commands |
  88
  89 ^new [
  90   | obj clicmd |
  91   obj := super new.
  92   "initialize REPL commands"
  93   clicmd := ReplCommands new.
  94   clicmd
  95     add: ':q'
  96      descr: 'quit'
  97      handler: [ :args |
  98        System quit: 0.
  99        ^true
 100      ];
 101     add: ':x'
 102      descr: 'save current image and quit'
 103      handler: [ :args |
 104        System loadModule: 'binimage'.
 105       'writing "workimage.image"...' printNl.
 106       args := File image: 'workimage.image'.
 107       args print. ' objects written to image.' printNl.
 108       ^true
 109     ];
 110     add: ':w'
 111      descr: 'save current image'
 112      handler: [ :args |
 113        System loadModule: 'binimage'.
 114       'writing "workimage.image"...' printNl.
 115       args := File image: 'workimage.image'.
 116       args print. ' objects written to image.' printNl.
 117     ];
 118     add: ':Z'
 119      descr: 'save image w/o sources'
 120      handler: [ :args |
 121        System loadModule: 'binimage'.
 122       'writing "releaseimage.image"...' printNl.
 123       args := File imageNoSources: 'releaseimage.image'.
 124       args print. ' objects written to image.' printNl.
 125     ];
 126     add: ':l'
 127      descr: 'load file'
 128      handler: [ :args |
 129        args size = 2 ifTrue: [
 130          'loading file: ' print. (args at: 2) printNl.
 131          File fileIn: (args at: 2).
 132         ]
 133         ifFalse: [ 'ERROR: invalid number of arguments for ":l"' printNl. ].
 134     ];
 135     add: ':m'
 136      descr: 'load module'
 137      handler: [ :args |
 138        args size = 2 ifTrue: [ System loadModule: (args at: 2). ]
 139         ifFalse: [ 'ERROR: invalid number of arguments for ":m"' printNl. ].
 140     ];
 141     add: ':r'
 142      descr: 'reload module'
 143      handler: [ :args |
 144        args size = 2 ifTrue: [ System reloadModule: (args at: 2). ]
 145         ifFalse: [ 'ERROR: invalid number of arguments for ":r"' printNl. ].
 146     ];
 147     add: ':p'
 148      descr: 'show packages or package classes'
 149      handler: [ :args :pkg |
 150        args size = 1 ifTrue: [
 151          Package packages keysDo: [:obj | obj asString printNl. ].
 152        ] ifFalse: [
 153          args size = 2 ifTrue: [
 154           pkg := Package find: (args at: 2) asSymbol.
 155           pkg ifNil: [ 'ERROR: invalid package name' printNl ]
 156           ifNotNil: [
 157             pkg name asString printNl.
 158             pkg classes do: [:obj |
 159               (obj isKindOf: Class) ifTrue: [
 160                 obj isMeta ifFalse: [ ' ' print. obj asString printNl. ]
 161              ]].
 162            ]
 163          ] ifFalse: [
 164            'ERROR: invalid number of arguments for ":p"' printNl.
 165          ]
 166        ].
 167     ];
 168     add: ':cm'
 169       descr: 'show class methods'
 170       handler: [ :args :cls |
 171         args size = 2 ifTrue: [
 172           cls := globals at: ((args at: 2) asSymbol) ifAbsent: [ nil ].
 173           ((cls notNil) and: [ cls isKindOf: Class ]) ifTrue: [
 174             cls asString printNl.
 175             cls class methods do: [:mth | ' ^' print. mth name asString printNl. ].
 176             cls methods do: [:mth | ' ' print. mth name asString printNl. ].
 177           ].
 178         ] ifFalse: [
 179           'ERROR: invalid number of arguments for ":cm"' printNl.
 180         ].
 181     ];
 182     add: ':PW'
 183       descr: 'write package to Smalltalk source file'
 184       handler: [ :args :fname :pkg |
 185         args size > 1 ifTrue: [
 186           System loadModule: 'pkgwrite'.
 187           pkg := Package find: (args at: 2) asSymbol.
 188           pkg ifNil: [ 'ERROR: invalid package name' printNl ]
 189           ifNotNil: [
 190             args size > 2 ifTrue: [ fname := args at: 3 ]
 191             ifFalse: [ fname := (pkg name asString) + '.st'. ].
 192             'writing package ' print. pkg name asString print. ' to ' print. fname printNl.
 193             (globals at: #PackageWriter) write: pkg name to: fname.
 194           ].
 195         ] ifFalse: [
 196           'ERROR: invalid number of arguments for ":PW"' printNl.
 197         ].
 198     ];
 199     add: ':dis'
 200       descr: 'disasm method; args: class method'
 201       handler: [ :args :cls |
 202         args size = 3 ifTrue: [
 203           System loadModule: 'disasm'.
 204           (args at: 2) print. '>>' print. (args at: 3) printNl.
 205           cls := globals at: ((args at: 2) asSymbol) ifAbsent: [ nil ].
 206           ((cls notNil) and: [ cls isKindOf: Class ]) ifTrue: [
 207             (args at: 3) firstChar == $^ ifTrue: [
 208               args at: 3 put: ((args at: 3) from: 2).
 209               cls := cls class.
 210             ].
 211             "cls disasmMethod: (args at: 3) asSymbol."
 212             (cls := cls allMethods at: (args at: 3) asSymbol ifAbsent: [ nil ]) ifNil: [ 'no such method' printNl ]
 213               ifNotNil: [ cls disassemble ].
 214           ].
 215         ] ifFalse: [
 216           'ERROR: invalid number of arguments for ":dis"' printNl.
 217         ].
 218     ];
 219     add: ':gc'
 220       descr: 'run GC'
 221       handler: [ :args :cls | System gc. ];
 222   .
 223   obj commandsSet: clicmd.
 224   ^obj
 225 ]
 226
 227 commands [
 228   ^commands
 229 ]
 230
 231 commandsSet: clist [
 232   commands := clist
 233 ]
 234
 235 checkForAssign: cmd [
 236   | res s |
 237   cmd := cmd break: (' \t').
 238   ((cmd size < 3) or: [ (cmd at: 2) ~= 'is' ] ) ifTrue: [ ^false ].
 239   (res := cmd at: 1) isEmpty ifTrue: [ self error: 'empty var name in "is"' ].
 240   cmd := cmd removeFirst removeFirst.
 241   s := ''. cmd do: [ :elem | s := s + elem + ' ' ].
 242   s := s doIt.
 243   globals at: res asSymbol put: s.
 244   res print. ' set to ' print. s printNl.
 245   ^true
 246 ]
 247
 248 REPL [
 249   "main execution loop"
 250   | cmd res s |
 251   [
 252     System isStdInTTY ifTrue: [ '-> ' print ].
 253     cmd := String input.
 254     cmd
 255    ] whileNotNil: [
 256     cmd isEmpty
 257       ifTrue: [ 'type ":h" to get some help or ":q" to quit' printNl ]
 258       ifFalse: [
 259         Case test: (cmd firstChar);
 260           case: $: do: [ commands do: cmd ];
 261           case: $! do: [
 262             "create new global var"
 263             cmd := (cmd from: 2) break: (' \t').
 264             ((cmd size < 3) or: [ (cmd at: 2) ~= 'is' ] ) ifTrue: [ self error: 'invalid "=" command' ].
 265             (res := cmd at: 1) isEmpty ifTrue: [ self error: 'empty var name in "="' ].
 266             cmd := cmd removeFirst removeFirst.
 267             s := ''. cmd do: [ :elem | s := s + elem + ' ' ].
 268             s := s doIt.
 269             globals at: res asSymbol put: s.
 270             ];
 271           else: [ :fc |
 272             (self checkForAssign: cmd) ifFalse: [
 273               res := cmd doIt.
 274               cmd removeTrailingBlanks lastChar == $. ifFalse: [ res ifNotNil: [ res printNl ]].
 275             ]
 276           ].
 277       ].
 278   ].
 279 ]
 280 ]
 281
 282 "now hook '^new' method so REPL EP will get our new object"
 283 REPL extend [
 284 ^new [
 285   ^ExtREPL new
 286 ]
 287 ]