The Common Lisp compiler is alive.

1 files changed, 0 insertions, 212 deletions

diff --git a/new-luxc/source/luxc/lang/translation/common-lisp.lux b/new-luxc/source/luxc/lang/translation/common-lisp.lux
deleted file mode 100644
index a9ea2c215..000000000
--- a/new-luxc/source/luxc/lang/translation/common-lisp.lux
+++ /dev/null
@@ -1,212 +0,0 @@
-(.module:
-  lux
-  (lux (control ["ex" exception #+ exception:]
-                pipe
-                [monad #+ do])
-       (data [bit]
-             [maybe]
-             ["e" error #+ Error]
-             [text "text/" Eq<Text>]
-             text/format
-             (coll [array]))
-       [macro]
-       [io #+ IO Process io]
-       [host #+ class: interface: object]
-       (world [file #+ File]))
-  (luxc [lang]
-        (lang [".L" variable #+ Register]
-              (host ["_" common-lisp #+ Expression]))
-        [".C" io]))
-
-(template [<name>]
-  [(exception: #export (<name> {message Text})
-     message)]
-
-  [No-Active-Module-Buffer]
-  [Cannot-Execute]
-
-  [No-Anchor]
-  )
-
-(host.import: java/lang/String
-  (getBytes [String] #try (Array byte)))
-
-(host.import: java/lang/CharSequence)
-
-(host.import: java/lang/Appendable
-  (append [CharSequence] Appendable))
-
-(host.import: java/lang/StringBuilder
-  (new [])
-  (toString [] String))
-
-(host.import: org/armedbear/lisp/LispObject)
-
-(host.import: org/armedbear/lisp/Interpreter
-  (#static getInstance [] Interpreter)
-  (#static createInstance [] #? Interpreter)
-  (eval [String] #try LispObject))
-
-(type: #export Anchor [Text Register])
-
-(type: #export Host
-  {#context [Text Nat]
-   #anchor (Maybe Anchor)
-   #loader (-> Expression (Error Any))
-   #interpreter (-> Expression (Error LispObject))
-   #module-buffer (Maybe StringBuilder)
-   #program-buffer StringBuilder})
-
-(def: ____ (Interpreter::createInstance []))
-
-(def: #export init
-  (IO Host)
-  (io (let [## interpreter ____
-            _ (Interpreter::createInstance [])
-            interpreter (Interpreter::getInstance [])]
-        {#context ["" +0]
-         #anchor #.None
-         #loader (function (_ code)
-                   (do e.Monad<Error>
-                     [_ (Interpreter::eval [(_.expression code)] interpreter)]
-                     (wrap [])))
-         #interpreter (function (_ code)
-                        (Interpreter::eval [(_.expression code)] interpreter))
-         #module-buffer #.None
-         #program-buffer (StringBuilder::new [])})))
-
-(def: #export file-extension ".lisp")
-
-(def: #export r-module-name Text (format "module" file-extension))
-
-(def: #export init-module-buffer
-  (Meta Any)
-  (function (_ compiler)
-    (#e.Success [(update@ #.host
-                          (|>> (:coerce Host)
-                               (set@ #module-buffer (#.Some (StringBuilder::new [])))
-                               (:coerce Nothing))
-                          compiler)
-                 []])))
-
-(def: #export (with-sub-context expr)
-  (All [a] (-> (Meta a) (Meta [Text a])))
-  (function (_ compiler)
-    (let [old (:coerce Host (get@ #.host compiler))
-          [old-name old-sub] (get@ #context old)
-          new-name (format old-name "f___" (%i (.int old-sub)))]
-      (case (expr (set@ #.host
-                        (:coerce Nothing (set@ #context [new-name +0] old))
-                        compiler))
-        (#e.Success [compiler' output])
-        (#e.Success [(update@ #.host
-                              (|>> (:coerce Host)
-                                   (set@ #context [old-name (inc old-sub)])
-                                   (:coerce Nothing))
-                              compiler')
-                     [new-name output]])
-
-        (#e.Error error)
-        (#e.Error error)))))
-
-(def: #export context
-  (Meta Text)
-  (function (_ compiler)
-    (#e.Success [compiler
-                 (|> (get@ #.host compiler)
-                     (:coerce Host)
-                     (get@ #context)
-                     (let> [name sub]
-                           name))])))
-
-(def: #export (with-anchor anchor expr)
-  (All [a] (-> Anchor (Meta a) (Meta a)))
-  (function (_ compiler)
-    (let [old (:coerce Host (get@ #.host compiler))]
-      (case (expr (set@ #.host
-                        (:coerce Nothing (set@ #anchor (#.Some anchor) old))
-                        compiler))
-        (#e.Success [compiler' output])
-        (#e.Success [(update@ #.host
-                              (|>> (:coerce Host)
-                                   (set@ #anchor (get@ #anchor old))
-                                   (:coerce Nothing))
-                              compiler')
-                     output])
-
-        (#e.Error error)
-        (#e.Error error)))))
-
-(def: #export anchor
-  (Meta Anchor)
-  (function (_ compiler)
-    (case (|> compiler (get@ #.host) (:coerce Host) (get@ #anchor))
-      (#.Some anchor)
-      (#e.Success [compiler anchor])
-
-      #.None
-      ((lang.throw No-Anchor "") compiler))))
-
-(def: #export module-buffer
-  (Meta StringBuilder)
-  (function (_ compiler)
-    (case (|> compiler (get@ #.host) (:coerce Host) (get@ #module-buffer))
-      #.None
-      ((lang.throw No-Active-Module-Buffer "") compiler)
-      
-      (#.Some module-buffer)
-      (#e.Success [compiler module-buffer]))))
-
-(def: #export program-buffer
-  (Meta StringBuilder)
-  (function (_ compiler)
-    (#e.Success [compiler (|> compiler (get@ #.host) (:coerce Host) (get@ #program-buffer))])))
-
-(template [<name> <field> <outputT>]
-  [(def: (<name> code)
-     (-> Expression (Meta <outputT>))
-     (function (_ compiler)
-       (let [runner (|> compiler (get@ #.host) (:coerce Host) (get@ <field>))]
-         (case (runner code)
-           (#e.Error error)
-           ((lang.throw Cannot-Execute error) compiler)
-           
-           (#e.Success output)
-           (#e.Success [compiler output])))))]
-
-  [load!     #loader      Any]
-  [interpret #interpreter LispObject]
-  )
-
-(def: #export variant-tag "LUX-VARIANT")
-
-(def: #export unit Text "")
-
-(def: #export (definition-name [module name])
-  (-> Name Text)
-  (lang.normalize-name (format module "$" name)))
-
-(def: #export (save code)
-  (-> Expression (Meta Any))
-  (do macro.Monad<Meta>
-    [module-buffer module-buffer
-     #let [_ (Appendable::append [(:coerce CharSequence (_.expression code))]
-                                 module-buffer)]]
-    (load! code)))
-
-(def: #export run interpret)
-
-(def: #export (save-module! target)
-  (-> File (Meta (Process Any)))
-  (do macro.Monad<Meta>
-    [module macro.current-module-name
-     module-buffer module-buffer
-     program-buffer program-buffer
-     #let [module-code (StringBuilder::toString [] module-buffer)
-           _ (Appendable::append [(:coerce CharSequence (format module-code "\n"))]
-                                 program-buffer)]]
-    (wrap (ioC.write target
-                     (format (lang.normalize-name module) "/" r-module-name)
-                     (|> module-code
-                         (String::getBytes ["UTF-8"])
-                         e.assume)))))