(.module: [library [lux {"-" [Code int or and if cond let]} ["@" target] [abstract [equivalence {"+" [Equivalence]}] [hash {"+" [Hash]}]] [control [pipe {"+" [new> cond> case>]}]] [data ["." text ["%" format {"+" [format]}]] [collection ["." list ("#\." functor monoid)]]] [macro ["." template]] [math [number ["n" nat] ["f" frac]]] [type abstract]]]) (def: nested (-> Text Text) (.let [nested_new_line (format text.new_line text.tab)] (text.replaced text.new_line nested_new_line))) (abstract: .public (Code k) {} Text (implementation: .public equivalence (All (_ brand) (Equivalence (Code brand))) (def: (= reference subject) (\ text.equivalence = (:representation reference) (:representation subject)))) (implementation: .public hash (All (_ brand) (Hash (Code brand))) (def: &equivalence ..equivalence) (def: hash (|>> :representation (\ text.hash hash)))) (template [ +] [(abstract: .public ( brand) {} Any) (`` (type: .public (|> Any (~~ (template.spliced +)))))] [Expression Expression' [Code]] ) (template [ +] [(abstract: .public {} Any) (`` (type: .public (|> (~~ (template.spliced +)))))] [Var Var' [Expression' Code]] [Computation Computation' [Expression' Code]] ) (type: .public Arguments (Record [#mandatory (List Var) #rest (Maybe Var)])) (def: .public manual (-> Text Code) (|>> :abstraction)) (def: .public code (-> (Code Any) Text) (|>> :representation)) (def: .public var (-> Text Var) (|>> :abstraction)) (def: (arguments [mandatory rest]) (-> Arguments (Code Any)) (case rest (#.Some rest) (case mandatory #.End rest _ (|> (format " . " (:representation rest)) (format (|> mandatory (list\each ..code) (text.interposed " "))) (text.enclosed ["(" ")"]) :abstraction)) #.None (|> mandatory (list\each ..code) (text.interposed " ") (text.enclosed ["(" ")"]) :abstraction))) (def: .public nil Computation (:abstraction "'()")) (def: .public bool (-> Bit Computation) (|>> (case> #0 "#f" #1 "#t") :abstraction)) (def: .public int (-> Int Computation) (|>> %.int :abstraction)) (def: .public float (-> Frac Computation) (|>> (cond> [(f.= f.positive_infinity)] [(new> "+inf.0" [])] [(f.= f.negative_infinity)] [(new> "-inf.0" [])] [f.not_a_number?] [(new> "+nan.0" [])] ... else [%.frac]) :abstraction)) (def: .public positive_infinity Computation (..float f.positive_infinity)) (def: .public negative_infinity Computation (..float f.negative_infinity)) (def: .public not_a_number Computation (..float f.not_a_number)) (def: safe (-> Text Text) (`` (|>> (~~ (template [ ] [(text.replaced )] ["\" "\\"] ["|" "\|"] [text.alarm "\a"] [text.back_space "\b"] [text.tab "\t"] [text.new_line "\n"] [text.carriage_return "\r"] [text.double_quote (format "\" text.double_quote)] )) ))) (def: .public string (-> Text Computation) (|>> ..safe %.text :abstraction)) (def: .public symbol (-> Text Computation) (|>> (format "'") :abstraction)) (def: form (-> (List (Code Any)) Code) (.let [nested_new_line (format text.new_line text.tab)] (|>> (case> #.End (:abstraction "()") (#.Item head tail) (|> tail (list\each (|>> :representation ..nested)) (#.Item (:representation head)) (text.interposed nested_new_line) (text.enclosed ["(" ")"]) :abstraction))))) (def: .public (apply/* args func) (-> (List Expression) Expression Computation) (..form (#.Item func args))) (template [ ] [(def: .public ( members) (-> (List Expression) Computation) (..apply/* members (..var )))] [vector/* "vector"] [list/* "list"] ) (def: .public apply/0 (-> Expression Computation) (..apply/* (list))) (template [ ] [(def: .public (apply/0 (..var )))] [newline/0 "newline"] ) (template [ + + +] [(`` (def: .public ( procedure) (-> Expression (~~ (template.spliced +)) Computation) (function (_ (~~ (template.spliced +))) (..apply/* (list (~~ (template.spliced +))) procedure)))) (`` (template [ ] [(def: .public ( (..var )))] (~~ (template.spliced +))))] [apply/1 [_0] [Expression] [[exact/1 "exact"] [integer->char/1 "integer->char"] [char->integer/1 "char->integer"] [number->string/1 "number->string"] [string->number/1 "string->number"] [floor/1 "floor"] [truncate/1 "truncate"] [string/1 "string"] [string?/1 "string?"] [length/1 "length"] [values/1 "values"] [null?/1 "null?"] [car/1 "car"] [cdr/1 "cdr"] [raise/1 "raise"] [error_object_message/1 "error-object-message"] [make_vector/1 "make-vector"] [vector_length/1 "vector-length"] [not/1 "not"] [string_hash/1 "string-hash"] [reverse/1 "reverse"] [display/1 "display"] [exit/1 "exit"] [string_length/1 "string-length"] [load_relative/1 "load-relative"]]] [apply/2 [_0 _1] [Expression Expression] [[append/2 "append"] [cons/2 "cons"] [make_vector/2 "make-vector"] ... [vector_ref/2 "vector-ref"] [list_tail/2 "list-tail"] [map/2 "map"] [string_ref/2 "string-ref"] [string_append/2 "string-append"] [make_string/2 "make-string"]]] [apply/3 [_0 _1 _2] [Expression Expression Expression] [[substring/3 "substring"] [vector_set!/3 "vector-set!"] [string_contains/3 "string-contains"]]] [apply/5 [_0 _1 _2 _3 _4] [Expression Expression Expression Expression Expression] [[vector_copy!/5 "vector-copy!"]]] ) ... TODO: define "vector_ref/2" like a normal apply/2 function. ... "vector_ref/2" as an 'invoke' is problematic, since it only works ... in Kawa. ... However, the way Kawa defines "vector-ref" causes trouble, ... because it does a runtime type-check which throws an error when ... it checks against custom values/objects/classes made for ... JVM<->Scheme interop. ... There are 2 ways to deal with this: ... 0. To fork Kawa, and get rid of the type-check so the normal ... "vector-ref" can be used instead. ... 1. To carry on, and then, when it's time to compile the compiler ... itself into Scheme, switch from 'invoke' to normal 'vector-ref'. ... Either way, the 'invoke' needs to go away. (def: .public (vector_ref/2 vector index) (-> Expression Expression Computation) (..form (list (..var "invoke") vector (..symbol "getRaw") index))) (template [ ] [(def: .public ( param subject) (-> Expression Expression Computation) (..apply/2 (..var ) subject param))] [=/2 "="] [eq?/2 "eq?"] [eqv?/2 "eqv?"] [/2 ">"] [>=/2 ">="] [string=?/2 "string=?"] [string ] [(def: .public (-> (List Expression) Computation) (|>> (list& (..var )) ..form))] [or "or"] [and "and"] ) (template [
]
    [(def: .public ( bindings body)
       (-> (List [ Expression]) Expression Computation)
       (..form (list (..var )
                     (|> bindings
                         (list\each (function (_ [binding/name binding/value])
                                      (..form (list (|> binding/name 
)
                                                    binding/value))))
                         ..form)
                     body)))]

    [let           "let"           Var       (<|)]
    [let*          "let*"          Var       (<|)]
    [letrec        "letrec"        Var       (<|)]
    [let_values    "let-values"    Arguments ..arguments]
    [let*_values   "let*-values"   Arguments ..arguments]
    [letrec_values "letrec-values" Arguments ..arguments]
    )

  (def: .public (if test then else)
    (-> Expression Expression Expression Computation)
    (..form (list (..var "if") test then else)))

  (def: .public (when test then)
    (-> Expression Expression Computation)
    (..form (list (..var "when") test then)))

  (def: .public (lambda arguments body)
    (-> Arguments Expression Computation)
    (..form (list (..var "lambda")
                  (..arguments arguments)
                  body)))

  (def: .public (define_function name arguments body)
    (-> Var Arguments Expression Computation)
    (..form (list (..var "define")
                  (|> arguments
                      (revised@ #mandatory (|>> (#.Item name)))
                      ..arguments)
                  body)))

  (def: .public (define_constant name value)
    (-> Var Expression Computation)
    (..form (list (..var "define") name value)))

  (def: .public begin
    (-> (List Expression) Computation)
    (|>> (#.Item (..var "begin")) ..form))

  (def: .public (set! name value)
    (-> Var Expression Computation)
    (..form (list (..var "set!") name value)))

  (def: .public (with_exception_handler handler body)
    (-> Expression Expression Computation)
    (..form (list (..var "with-exception-handler") handler body)))

  (def: .public (call_with_current_continuation body)
    (-> Expression Computation)
    (..form (list (..var "call-with-current-continuation") body)))

  (def: .public (guard variable clauses else body)
    (-> Var (List [Expression Expression]) (Maybe Expression) Expression Computation)
    (..form (list (..var "guard")
                  (..form (|> (case else
                                #.None
                                (list)
                                
                                (#.Some else)
                                (list (..form (list (..var "else") else))))
                              (list\composite (list\each (function (_ [when then])
                                                           (..form (list when then)))
                                                         clauses))
                              (list& variable)))
                  body)))
  )