racketscript · samth · Feb 25, 2021 · Jul 13, 2021
diff --git a/racketscript-compiler/racketscript/compiler/absyn.rkt b/racketscript-compiler/racketscript/compiler/absyn.rkt
@@ -13,6 +13,11 @@
                  [forms   : (Listof ModuleLevelForm)])
   #:transparent)
 
+(struct Linklet ([imports : (Listof (Listof Symbol))]
+                 [exports : (Listof Symbol)]
+                 [forms : (Listof GeneralTopLevelForm)])
+  #:transparent)
+
 (define-language Absyn
   #:alias
   [Program      TopLevelForm]
@@ -24,6 +29,7 @@
   [TopLevelForm             GeneralTopLevelForm
                             Expr
                             Module
+                            Linklet
                             Begin]
 
   [GeneralTopLevelForm      Expr
@@ -84,7 +90,9 @@
 
   [Ident  (LocalIdent         [id : Symbol])
           (ImportedIdent      [id : Symbol] [src-mod : Module-Path] [reachable? : Boolean])
-          (TopLevelIdent      [id : Symbol])]
+          (TopLevelIdent      [id : Symbol])
+          (PrimitiveIdent     [id : Symbol])
+          (LinkletImportIdent [id : Symbol] [position : Integer])]
 
   [Begin   (Listof TopLevelForm)]
 

diff --git a/racketscript-compiler/racketscript/compiler/assembler.rkt b/racketscript-compiler/racketscript/compiler/assembler.rkt
@@ -17,6 +17,7 @@
          "il.rkt")
 
 (provide assemble
+         assemble-linklet
          assemble-module
          assemble-statement*
          assemble-statement)
@@ -252,6 +253,14 @@
           #:exists 'replace
           cb))))
 
+(: assemble-linklet (-> ILLinklet Output-Port Void))
+(define (assemble-linklet mod out)
+  (match-define (ILLinklet importss exports body) mod)
+  (log-rjs-info "[assemble-linklet] ~s" #f)
+  (for ([b (in-list body)])
+    (assemble-statement b out)))
+
+
 (: assemble-requires* (-> ILRequire* Output-Port Void))
 (define (assemble-requires* reqs* out)
   (define emit (curry fprintf out))

diff --git a/racketscript-compiler/racketscript/compiler/ident.rkt b/racketscript-compiler/racketscript/compiler/ident.rkt
@@ -8,9 +8,6 @@
          typed/rackunit
          "config.rkt")
 
-(require/typed racket/string
-  [string-prefix? (-> String String Boolean)])
-
 (provide fresh-id
          fresh-id-counter
          reserved-keyword?

diff --git a/racketscript-compiler/racketscript/compiler/il.rkt b/racketscript-compiler/racketscript/compiler/il.rkt
@@ -22,6 +22,11 @@
                   [body     : ILStatement*])
   #:transparent)
 
+(struct ILLinklet ([imports : (Listof (Listof Symbol))]
+                   [exports : (Listof Symbol)]
+                   [body    : ILStatement*])
+  #:transparent)
+
 (struct ILRequire ([mod         : ILModuleName]
                    [name        : Symbol]
                    [import-mode : (U 'default '*)]) #:transparent)

diff --git a/racketscript-compiler/racketscript/compiler/language.rkt b/racketscript-compiler/racketscript/compiler/language.rkt
@@ -1,10 +1,10 @@
-#lang typed/racket
+#lang typed/racket/base
 
 (provide define-language)
 
 (require racket/struct
-         (for-syntax syntax/parse
-                     syntax/parse/experimental/template
+         (for-syntax racket/base
+                     syntax/parse
                      racket/syntax
                      syntax/stx))
 

diff --git a/racketscript-compiler/racketscript/compiler/linklet-expand.rkt b/racketscript-compiler/racketscript/compiler/linklet-expand.rkt
@@ -0,0 +1,111 @@
+#lang racket/base
+
+;; convert a linklet s-exp into abstract syntax
+;; linklet grammar described here: https://docs.racket-lang.org/reference/linklets.html
+
+(require racket/match
+         racket/pretty
+         racket/hash
+         "absyn.rkt")
+(provide parse-linklet)
+
+(define (formals->absyn formals)
+  (match formals
+    [(list-rest x ... y) #:when (null? x) y]
+    [(list-rest x ... y) #:when (null? y) x]
+    [(list-rest x ... y) (list x y)]))
+
+(define (formals->bindings formals)
+  (match formals
+    [(list-rest x ... y)
+     (for/hash ([i (cons y x)]) (values i 'lexical))]))
+
+(define (to-absyn v bindings)
+  (define (t v [b bindings]) (to-absyn v b))
+  (match v
+    [(or (? string?) (? number?) (? boolean?) (? bytes?)) (Quote v)]
+    [`(quote ,v) (Quote v)]
+    [`(begin0 ,e0 ,e1 ...) (Begin0 (t e0) (map t e1))]
+    [`(begin ,e ...) (map t e)]
+    [`(if ,e0 ,e1 ,e2)
+     (If (t e0) (t e1) (t e2))]
+    [`(let-values (,[list xs es] ...) ,b)
+     (define bindings* (hash-union bindings
+                                   (for*/hash ([x xs] [i x]) (values i 'lexical))))
+     (LetValues (for/list ([x xs] [e es])
+                  (cons x (t e)))
+                (t b))]
+    [`(letrec-values (,[list xs es] ...) ,b)
+     (define bindings* (hash-union bindings
+                                   (for*/hash ([x xs] [i x]) (values i 'lexical))))
+     (LetValues (for/list ([x xs] [e es])
+                  (cons x (t e bindings*)))
+                (t b bindings*))]
+    [`(case-lambda . ,clauses)
+     (CaseLambda
+      (map (λ (c)
+             (match c
+               [(list formals body)
+                (PlainLambda (formals->absyn formals)
+                             (list (t body (hash-union bindings (formals->bindings formals))))
+                             #f)]))
+           clauses))]
+    [`(lambda ,formals ,body)
+     (define fabsyn (formals->absyn formals))
+     (PlainLambda fabsyn (list (t body (hash-union bindings (formals->bindings formals)))) #f)]
+    [`(define-values (,name) (#%js-ffi 'require (quote ,mod)))
+     ;; HACK: Special case for JSRequire
+     (JSRequire name mod 'default)]
+    [`(define-values (,name) (#%js-ffi 'require '* (quote ,mod)))
+     ;; HACK: Special case for JSRequire
+     (JSRequire name mod '*)]
+    [`(define-values (,id ...) ,b)
+     (DefineValues id (t b))]
+    [`(#%variable-reference ,x) (VarRef x)]
+    [`(#%variable-reference) (VarRef #f)]
+    [(? symbol? i)
+     #:when (eq? 'define (hash-ref bindings i #f))
+     (TopLevelIdent i)]
+    [(? symbol? i)
+     #:when (number? (hash-ref bindings i #f))
+     (LinkletImportIdent i (hash-ref bindings i))]
+    [(? symbol? i)
+     #:when (eq? 'lexical (hash-ref bindings i #f))
+     (LocalIdent i)]
+    [(? symbol? i)
+     ;; FIXME: not really always '#%kernel
+     (ImportedIdent i '#%kernel #t)]
+    [`(set! ,s ,e)
+     (Set! s (t e))]
+    [`(with-continuation-mark ,key ,value ,result)
+     (WithContinuationMark (t key)
+                           (t value)
+                           (t result))]
+    ;; application
+    [`(,rator . ,rands)
+     (PlainApp (t rator) (map t rands))]
+    [_ (displayln "unsupported form =>")
+       (pretty-print v)
+       (error 'linklet-expand)]))
+
+
+
+
+(define (parse-linklet v)
+  (match v
+    [`(linklet ,imports ,exports ,@body)
+     (define imps (for*/hash ([(j import) (in-indexed imports)]
+                              [i import])
+                    (values i j)))
+     (define defs (make-hash))
+     (for ([b body])
+       (match b
+         [`(define-values ,is ,_)
+          (for ([i is]) (hash-set! defs i 'define))]
+         [_ (void)]))
+     (Linklet imports exports (map (lambda (v) (to-absyn v (hash-union imps defs))) body))]))
+
+
+(module+ main
+  (parse-linklet `(linklet () () (lambda (x) (+ x 3))))
+  )
diff --git a/racketscript-compiler/racketscript/compiler/main.rkt b/racketscript-compiler/racketscript/compiler/main.rkt
@@ -234,6 +234,11 @@
        (= (get-module-timestamp ts mod)
           (file-or-directory-modify-seconds (actual-module-path mod)))))
 
+
+;; compile and convert a linklet s-exp
+(define (linklet->js s)
+  )
+
 ;; -> Void
 ;; For given global parameters starts build process starting
 ;; with entry point module and all its dependencies

diff --git a/racketscript-compiler/racketscript/compiler/transform.rkt b/racketscript-compiler/racketscript/compiler/transform.rkt
@@ -23,6 +23,9 @@
          "il.rkt"
          "il-analyze.rkt")
 
+(require/typed "linklet-expand.rkt"
+  [parse-linklet (-> Any Linklet)])
+
 (require/typed racket/syntax
   [format-symbol (-> String Any * Symbol)])
 
@@ -54,6 +57,31 @@
     [else (error "only modules supported at top level")]))
 
 
+(: absyn-linklet->il : Linklet -> ILLinklet)
+(define (absyn-linklet->il l)
+  (match-define (Linklet importss exports forms) l)
+  ;; Since we get identifiers directly from defining module, we keep
+  ;; track of defines, use this for exporting all defines or exclude
+  ;; re-exports here
+  (: top-level-defines (Setof Symbol))
+  (define top-level-defines
+    (list->set
+     (append
+      (append-map DefineValues-ids
+                  (filter DefineValues? forms))
+      (map JSRequire-alias
+           (filter JSRequire? forms)))))
+  (define forms* : (Listof ILStatement*)
+    (for/list ([form : GeneralTopLevelForm (in-list forms)])
+      (absyn-gtl-form->il form)))
+
+  (ILLinklet importss exports (apply append forms*)))
+
+
+(module+ main
+  (define l (parse-linklet `(linklet () () (lambda (x) (+ x 3)))))
+  (absyn-linklet->il l))
+
 (: absyn-module->il (-> Module ILModule))
 (define (absyn-module->il mod)
   (match-define (Module id path lang imports quoted-bindings forms) mod)