Skip to content

Commit

Permalink
Slightly better syntax for defining runtime-level functions.
Browse files Browse the repository at this point in the history
  • Loading branch information
@eduardoejp
eduardoejp committed Jan 1, 2024
1 parent 61e68fc commit a84d15f
Show file tree
Hide file tree
Showing 19 changed files with 2,645 additions and 2,665 deletions.
8 changes: 6 additions & 2 deletions stdlib/source/library/lux/meta.lux
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,11 @@
[monad (.only Monad
do)]]
[control
["[0]" try (.only Try)]]]]
["[0]" try (.only Try)]]
[data
[collection
[list
["[0]" property]]]]]]
[/
["[0]" location]])

Expand Down Expand Up @@ -182,7 +186,7 @@

[target [.#info .#target] Text]
[version [.#info .#version] Text]
[configuration [.#info .#configuration] (List [Text Text])]
[configuration [.#info .#configuration] (property.List Text)]
)

(the .public location
Expand Down
246 changes: 119 additions & 127 deletions ...b/source/library/lux/meta/compiler/language/lux/phase/translation/common_lisp/runtime.lux
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,8 @@

(.using
[library
[lux (.except Location)
[lux (.except Location
the)
[abstract
["[0]" monad (.only do)]]
[control
Expand Down Expand Up @@ -43,7 +44,7 @@
[archive (.only Output Archive)
["[0]" artifact (.only Registry)]]]]]])

(the module_id
(.the module_id
0)

(template.with [<name> <base>]
Expand All @@ -59,40 +60,40 @@
(every .public (Translator i)
(-> Phase Archive i (Operation (Expression Any))))

(the .public unit
(.the .public unit
(_.string /////synthesis.unit))

(the (flag value)
(.the (flag value)
(-> Bit Literal)
(if value
(_.string "")
_.nil))

(the (variant' tag last? value)
(.the (variant' tag last? value)
(-> (Expression Any) (Expression Any) (Expression Any) (Computation Any))
(_.list/* (list tag last? value)))

(the .public (variant [lefts right? value])
(.the .public (variant [lefts right? value])
(-> (Variant (Expression Any)) (Computation Any))
(variant' (_.int (.integer lefts)) (flag right?) value))

(the .public none
(.the .public none
(Computation Any)
(|> ..unit [0 #0] ..variant))

(the .public some
(.the .public some
(-> (Expression Any) (Computation Any))
(|>> [1 #1] ..variant))

(the .public left
(.the .public left
(-> (Expression Any) (Computation Any))
(|>> [0 #0] ..variant))

(the .public right
(.the .public right
(-> (Expression Any) (Computation Any))
(|>> [1 #1] ..variant))

(the .public with_vars
(.the .public with_vars
(syntax.macro (_ [vars (<code>.tuple (<>.some <code>.local))
body <code>.any])
(do [! meta.monad]
Expand All @@ -105,7 +106,7 @@
list.together))]
(, body))))))))

(the runtime
(.the the
(syntax.macro (_ [declaration (<>.or <code>.local
(<code>.form (<>.and <code>.local
(<>.some <code>.local))))
Expand All @@ -119,11 +120,11 @@
{.#Left name}
(let [g!name (code.local name)
code_nameC (code.local (%.message "@" name))]
(in (list (` (the .public (, g!name)
(in (list (` (.the .public (, g!name)
_.Var/1
(, runtime_name)))

(` (the (, code_nameC)
(` (.the (, code_nameC)
(_.Expression Any)
(_.defparameter (, runtime_name) (, code)))))))

Expand All @@ -134,169 +135,160 @@
inputsC (list#each code.local inputs)
inputs_typesC (list#each (function.constant (` (_.Expression Any)))
inputs)]
(in (list (` (the .public ((, g!name) (,* inputsC))
(in (list (` (.the .public ((, g!name) (,* inputsC))
(-> (,* inputs_typesC) (_.Computation Any))
(_.call/* (, runtime_name) (list (,* inputsC)))))

(` (the (, code_nameC)
(` (.the (, code_nameC)
(_.Expression Any)
(..with_vars [(,* inputsC)]
(_.defun (, runtime_name) (_.args (list (,* inputsC)))
(, code))))))))))))))

(runtime
(lux//try op)
(with_vars [error]
(_.handler_case
(list [(_.bool true) error
(..left (_.format/3 [_.nil (_.string "~A") error]))])
(..right (_.funcall/+ [op (list ..unit)])))))
(the (lux//try op)
(with_vars [error]
(_.handler_case
(list [(_.bool true) error
(..left (_.format/3 [_.nil (_.string "~A") error]))])
(..right (_.funcall/+ [op (list ..unit)])))))

... TODO: Use Common Lisp's swiss-army loop macro instead.
(runtime
(lux//program_args inputs)
(with_vars [loop input tail]
(_.labels (list [loop [(_.args (list input tail))
(_.if (_.null/1 input)
tail
(_.funcall/+ [(_.function/1 loop)
(list (_.cdr/1 input)
(..some (_.vector/* (list (_.car/1 input) tail))))]))]])
(_.funcall/+ [(_.function/1 loop)
(list (_.reverse/1 inputs)
..none)]))))

(the runtime//lux
(the (lux//program_args inputs)
(with_vars [loop input tail]
(_.labels (list [loop [(_.args (list input tail))
(_.if (_.null/1 input)
tail
(_.funcall/+ [(_.function/1 loop)
(list (_.cdr/1 input)
(..some (_.vector/* (list (_.car/1 input) tail))))]))]])
(_.funcall/+ [(_.function/1 loop)
(list (_.reverse/1 inputs)
..none)]))))

(.the runtime//lux
(List (Expression Any))
(list @lux//try
@lux//program_args))

(the last_index
(.the last_index
(|>> _.length/1 [(_.int +1)] _.-/2))

(expansion.let [<recur> (these (all _.then
(_.; (_.set lefts (_.-/2 [last_index_right lefts])))
(_.; (_.set tuple (_.nth last_index_right tuple)))))]
(these (the !recur
(these (.the !recur
(template.macro (_ <side>)
(<side> (_.-/2 [last_index_right lefts])
(_.elt/2 [tuple last_index_right]))))

(runtime
(tuple//left lefts tuple)
(with_vars [last_index_right]
(_.let (list [last_index_right (..last_index tuple)])
(list (_.if (_.>/2 [lefts last_index_right])
... No need for recursion
(_.elt/2 [tuple lefts])
... Needs recursion
(!recur tuple//left))))))

(runtime
(tuple//right lefts tuple)
(with_vars [last_index_right right_index]
(_.let (list [last_index_right (..last_index tuple)]
[right_index (_.+/2 [(_.int +1) lefts])])
(list (_.cond (list [(_.=/2 [last_index_right right_index])
(_.elt/2 [tuple right_index])]
[(_.>/2 [last_index_right right_index])
... Needs recursion.
(!recur tuple//right)])
(_.subseq/3 [tuple right_index (_.length/1 tuple)]))))))))
(the (tuple//left lefts tuple)
(with_vars [last_index_right]
(_.let (list [last_index_right (..last_index tuple)])
(list (_.if (_.>/2 [lefts last_index_right])
... No need for recursion
(_.elt/2 [tuple lefts])
... Needs recursion
(!recur tuple//left))))))

(the (tuple//right lefts tuple)
(with_vars [last_index_right right_index]
(_.let (list [last_index_right (..last_index tuple)]
[right_index (_.+/2 [(_.int +1) lefts])])
(list (_.cond (list [(_.=/2 [last_index_right right_index])
(_.elt/2 [tuple right_index])]
[(_.>/2 [last_index_right right_index])
... Needs recursion.
(!recur tuple//right)])
(_.subseq/3 [tuple right_index (_.length/1 tuple)]))))))))

... TODO: Find a way to extract parts of the sum without "nth", which
... does a linear search, and is thus expensive.
(runtime
(sum//get sum wantsLast wantedTag)
(with_vars [sum_tag sum_flag]
(let [no_match! (_.return sum)
sum_value (_.nth/2 [(_.int +2) sum])
test_recursion! (_.if sum_flag
... Must iterate.
(_.progn (list (_.setq wantedTag (_.-/2 [sum_tag wantedTag]))
(_.setq sum sum_value)))
no_match!)]
(_.while (_.bool true)
(_.let (list [sum_tag (_.nth/2 [(_.int +0) sum])]
[sum_flag (_.nth/2 [(_.int +1) sum])])
(list (_.cond (list [(_.=/2 [sum_tag wantedTag])
(_.if (_.equal/2 [wantsLast sum_flag])
(_.return sum_value)
test_recursion!)]

[(_.>/2 [sum_tag wantedTag])
test_recursion!]

[(_.and (_.</2 [sum_tag wantedTag])
wantsLast)
(_.return (variant' (_.-/2 [wantedTag sum_tag]) sum_flag sum_value))])

no_match!)))))))

(the runtime//adt
(the (sum//get sum wantsLast wantedTag)
(with_vars [sum_tag sum_flag]
(let [no_match! (_.return sum)
sum_value (_.nth/2 [(_.int +2) sum])
test_recursion! (_.if sum_flag
... Must iterate.
(_.progn (list (_.setq wantedTag (_.-/2 [sum_tag wantedTag]))
(_.setq sum sum_value)))
no_match!)]
(_.while (_.bool true)
(_.let (list [sum_tag (_.nth/2 [(_.int +0) sum])]
[sum_flag (_.nth/2 [(_.int +1) sum])])
(list (_.cond (list [(_.=/2 [sum_tag wantedTag])
(_.if (_.equal/2 [wantsLast sum_flag])
(_.return sum_value)
test_recursion!)]

[(_.>/2 [sum_tag wantedTag])
test_recursion!]

[(_.and (_.</2 [sum_tag wantedTag])
wantsLast)
(_.return (variant' (_.-/2 [wantedTag sum_tag]) sum_flag sum_value))])

no_match!)))))))

(.the runtime//adt
(List (Expression Any))
(list @tuple//left
@tuple//right
@sum//get))

(runtime
(i64//right_shifted shift input)
(_.if (_.=/2 [(_.int +0) shift])
input
(let [anti_shift (_.-/2 [shift (_.int +64)])
mask (|> (_.int +1)
[anti_shift] _.ash/2
[(_.int +1)] _.-/2)]
(|> input
[(_.*/2 [(_.int -1) shift])] _.ash/2
[mask] _.logand/2))))

(the runtime//i64
(the (i64//right_shifted shift input)
(_.if (_.=/2 [(_.int +0) shift])
input
(let [anti_shift (_.-/2 [shift (_.int +64)])
mask (|> (_.int +1)
[anti_shift] _.ash/2
[(_.int +1)] _.-/2)]
(|> input
[(_.*/2 [(_.int -1) shift])] _.ash/2
[mask] _.logand/2))))

(.the runtime//i64
(List (Expression Any))
(list @i64//right_shifted))

(runtime
(text//clip offset length text)
(_.subseq/3 [text offset (_.+/2 [offset length])]))
(the (text//clip offset length text)
(_.subseq/3 [text offset (_.+/2 [offset length])]))

(runtime
(text//index offset sub text)
(with_vars [index]
(_.let (list [index (_.search/3 [sub text offset])])
(list (_.if index
(..some index)
..none)))))
(the (text//index offset sub text)
(with_vars [index]
(_.let (list [index (_.search/3 [sub text offset])])
(list (_.if index
(..some index)
..none)))))

(the runtime//text
(.the runtime//text
(List (Expression Any))
(list @text//index
@text//clip))

(runtime
(io//exit code)
(_.progn (list (_.conditional+ (list "sbcl")
(_.call/* (_.var "sb-ext:quit") (list code)))
(_.conditional+ (list "clisp")
(_.call/* (_.var "ext:exit") (list code)))
(_.conditional+ (list "ccl")
(_.call/* (_.var "ccl:quit") (list code)))
(_.conditional+ (list "allegro")
(_.call/* (_.var "excl:exit") (list code)))
(_.call/* (_.var "cl-user::quit") (list code)))))

(the runtime//io
(the (io//exit code)
(_.progn (list (_.conditional+ (list "sbcl")
(_.call/* (_.var "sb-ext:quit") (list code)))
(_.conditional+ (list "clisp")
(_.call/* (_.var "ext:exit") (list code)))
(_.conditional+ (list "ccl")
(_.call/* (_.var "ccl:quit") (list code)))
(_.conditional+ (list "allegro")
(_.call/* (_.var "excl:exit") (list code)))
(_.call/* (_.var "cl-user::quit") (list code)))))

(.the runtime//io
(List (Expression Any))
(list @io//exit))

(the runtime
(.the runtime
(_.progn (all list#composite
runtime//adt
runtime//lux
runtime//i64
runtime//text
runtime//io)))

(the .public translate
(.the .public translate
(Operation [Registry Output])
(do ///////phase.monad
[_ (/////translation.execute! ..runtime)
Expand Down
Loading

0 comments on commit a84d15f

Please sign in to comment.