basis/interpolate/interpolate.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors fry generalizations io io.streams.string kernel
   4 locals macros make math math.order math.parser multiline
   5 namespaces present sequences splitting strings vocabs.parser ;
   6 IN: interpolate
   7
   8 <PRIVATE
   9
  10 TUPLE: named-var name ;
  11
  12 TUPLE: stack-var n ;
  13
  14 : (parse-interpolate) ( str -- )
  15     [
  16         "${" split1-slice [
  17             [ >string , ] unless-empty
  18         ] [
  19             [
  20                 "}" split1-slice
  21                 [
  22                     >string dup string>number
  23                     [ stack-var boa ] [ named-var boa ] ?if ,
  24                 ]
  25                 [ (parse-interpolate) ] bi*
  26             ] when*
  27         ] bi*
  28     ] unless-empty ;
  29
  30 : parse-interpolate ( str -- seq )
  31     [ (parse-interpolate) ] { } make ;
  32
  33 : max-stack-var ( seq -- n/f )
  34     f [
  35         dup stack-var? [ n>> [ or ] keep max ] [ drop ] if
  36     ] reduce ;
  37
  38 :: interpolate-quot ( str quot -- quot' )
  39     str parse-interpolate :> args
  40     args max-stack-var    :> vars
  41
  42     args [
  43         dup named-var? [
  44             name>> quot call '[ _ @ present write ]
  45         ] [
  46             dup stack-var? [
  47                 n>> vars swap - 1 + '[ _ npick present write ]
  48             ] [
  49                 '[ _ write ]
  50             ] if
  51         ] if
  52     ] map concat
  53
  54     vars [
  55         1 + '[ _ ndrop ] append
  56     ] when* ; inline
  57
  58 PRIVATE>
  59
  60 MACRO: interpolate ( str -- )
  61     [ [ get ] ] interpolate-quot ;
  62
  63 : interpolate>string ( str -- newstr )
  64     [ interpolate ] with-string-writer ; inline
  65
  66 : interpolate-locals ( str -- quot )
  67     [ dup search [ [ ] ] [ [ get ] ] ?if ] interpolate-quot ;
  68
  69 SYNTAX: I[
  70     "]I" parse-multiline-string
  71     interpolate-locals append! ;