language: funktors kind of work?

language/eval/eval.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators compiler.units continuations debugger
 effects.parser io.streams.string kernel kernel.private multiline
-namespaces parser parser.notes sequences splitting ;
+namespaces parser parser.notes sequences splitting vocabs.parser ;
 IN: eval
 
 : parse-string ( str -- quot )
@@ -16,6 +16,11 @@ IN: eval
 
 SYNTAX: \ eval( \ eval parse-call-paren ;
 
+: eval-in-current ( string effect -- output )
+    [ (eval) ] with-current-manifest ; inline
+
+SYNTAX: \ eval-in-current( \ eval-in-current parse-call-paren ;
+
 SYNTAX: \ eval[[
     "]]" parse-multiline-string
     $[ get-datastack _ parse-string with-datastack set-datastack ] append! ;

language/funktors/funktors-tests.factor

@@ -0,0 +1,19 @@
+! Copyright (C) 2016 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: funktors math tools.test ;
+IN: funktors.tests
+
+COMPILE<
+
+FUNKTOR: define-box ( T -- ) [[
+TUPLE: ${T}-box { value ${T} } ;
+C: <${T}-box> ${T}-box
+]]
+
+\ float define-box
+
+COMPILE>
+
+{ 1 0 } [ define-box ] must-infer-as
+
+[ T{ float-box f 5.0 } ] [ 5.0 <float-box> ] unit-test

language/funktors/funktors.factor

@@ -1,20 +1,14 @@
-USING: accessors effects.parser eval grouping interpolate kernel
+! Copyright (C) 2016 Doug Coleman.
-multiline namespaces parser sequences sets splitting
+! See http://factorcode.org/license.txt for BSD license.
-vocabs.parser words ;
+USING: accessors arrays effects.parser eval interpolate
+io.streams.string kernel locals.parser namespaces parser
+sequences words ;
 IN: funktors
 
-SYNTAX: \ funktor[[ "]]" parse-multiline-string
-    manifest get search-vocab-names>>
-    { "syntax" } diff members
-    current-vocab name>> ".private" ?tail drop ".private" append suffix
-    $[
-        _ interpolate>string
-        current-vocab name>> "\nIN: " "\n" surround prepend
-        _ 5 group [ " " join ] map "\n" join
-        "USING: " " ;\n" surround prepend
-        eval( -- )
-    ] suffix! ;
-
 SYNTAX: \ FUNKTOR:
-    scan-new-escaped scan-effect scan-object
+    scan-new-escaped
-    $[ _ call ] swap define-declared ;
+    scan-effect dup in>> [ dup pair? [ first ] when ] map make-locals
+    drop [ name>> ] map reverse [ $[ _ namespaces:set ] ] map [ ] [ compose ] reduce
+    scan-object interpolate-locals-quot compose
+    $[ [ _ call ] with-string-writer eval-in-current( -- ) ] swap define-declared ;
+    ! $[ @ interpolate>string eval-in-current( -- ) ] swap define-declared ;

language/interpolate/interpolate.factor

@@ -88,3 +88,6 @@ MACRO: interpolate-locals ( str -- quot )
 SYNTAX: \ I[[
     "]]" parse-multiline-string
     interpolate-locals-quot append! ;
+
+SYNTAX: \ $[[
+    "]]" parse-multiline-string interpolate-locals-quot append! ;