hl2b/bootstrap: Added definition for <hl>def

; front end to the bytecode compiler
; loads all the files and defines an entry function

; define the <hl> package and import functions and macros needed
; by the compiler from <arc>v3
; TODO: move in a file conditionally loaded only when bootstrapping
;       using hl-arc-f
(in-package hl)
(using <arc>v3)
; Should really use <hl>def, not just def, because def in this
; context will be <arc>def.  Same with <hl>type etc.
; Please see http://hl.webhop.net/item?id=103 ; I recommended
; using 3 sections, and specified which ones should specify
; specific packages, and which ones just use <arc> packages.
(interface v0 def mac if and no or each load string unpkg prn = w/infile
              let with withs fn afn require w/uniq coerce + push listtab
              givens make-br-fn ++ acons ssyntax isnt caris _ in type isa
              alist err is car cons cdr map orf awhen do trav+ when ontable
              list aif zap self rfn pos complement dotted len on
              index copy mappend cadr cddr len> it some assert given case
              >= > keep idfn rev - mem max mapeach atom bound rep apply
              ; types
              int num char table string sym bool)

(mac <hl>def (spec . rest)
  (if
    (acons spec)
      `((<axiom>symeval '<common>call-w/gvl)
         (<axiom>lambda ()
           (<axiom>set ,(car spec)
             ; should really be <hl>fn, but for now we use
             ; <axiom>lambda
             (<axiom>lambda ,(cdr spec)
               ,@rest))))
      `((<axiom>symeval '<common>call-w/gvl)
         (<axiom>lambda ()
           (<axiom>set ,spec
             ,(car rest))))))

(def <common>call-w/gvl (f) (f))

(set <hl>unpkg <arc>unpkg)
(set <hl>ssyntax <arc>ssyntax)
(set <hl>pos <arc>pos)

; fix differences between the host and the target
; this is actually a superset, i.e. they do *at least* what their hl
; counterpart do
(mac <axiom>lambda (args . body)
  `(fn ,args ,@body))

(set <axiom>tag <arc>annotate)
(set <axiom>cons <arc>cons)
(set <axiom>i- -)
(set <axiom>i+ +)
(set <axiom>i* *)
(set <axiom>i< <)
(set <axiom>is is)
(set <axiom>cdr cdr)
(set <axiom>car car)

; the compiler package
(in-package compiler)
(using <hl>v0)

(interface v0 compile)

; this var tells if we are bootstrapping the compiler or not
(set bootstrap* t)
; tells if the host should eval the code before compiling it
; eval is needed to get macros to work while bootstrapping
; but the host doesn't support some things (mainly async I/O & processes)
(set stop-host-eval* nil)

; strictly, "compiled-and-executed-files"
(set files* '("structs.hl" "bytecodegen.hl"
              "quote-lift.hl" "utils.hl" "closures.hl" "cps.hl"
              "sharedvars.hl"  "xe.hl" "macex.hl"))
; need also *another* set of files for "compiled-only-but-not-executed-files"

; load all the files
(each f files*
  (load f))

; entry point
; return a 0 arg function that executes expr
;(def compile (expr)
;  (<axiom>assemble (compile-to-bytecode expr)))
; above doesn't actually make sense from within
; Arc-F, because Arc-F doesn't support <axiom>assemble.
; Maybe should be in the "compiled-but-not-executed"
; set of files

(using <read-cs-dir>v1)

(if (> (len <arc>argv) 1)
    ; called from the command line
    ; compile and run the program
    (<arc>w/infile in (<arc>argv 1)
      (= exprs* (<arc>readall in)))
    (do (= exprs* (read-cs-dir))
        (= stop-host-eval* t)))

(do
  (do
    (withs (exprs exprs*
            prog `((<axiom>lambda () ,@exprs)))
      (<arc>w/outfile tmp "/tmp/hl-tmp"
        ; not the best thing to do, pipe-to would be better if we had it
        ; put the default continuation
        (<arc>write '(<bc>k-closure 0
                       (<bc>debug-name final-return)
                       (<bc>check-vars 2)
                       (<bc>local 1)
                       (<bc>halt))
                    tmp)
        (prn "pre-eval")
        (each expr exprs
          ; for each expression, we compile it & then eval it
          ; when bootstrapping evaluation is done in the host
          ; and the compiled result is not executed
          ; WARNING: the *whole* file is evaluated before compilation
          ; takes place. This means that if a global var is redefined
          ; by the compiled code, during compilation only the last definition
          ; will be available. This shouldn't be a problem in practice.
          (if
            (and (isa expr 'sym) (is (unpkg expr) (unpkg '>stop-host-eval)))
              (set stop-host-eval* t)
            (and (isa expr 'sym) (is (unpkg expr) (unpkg '>start-host-eval)))
              (set stop-host-eval* nil)
            (and bootstrap* (no stop-host-eval*))
              (<arc>eval (<compiler>macex expr))))
        (prn "compile")
        (each bc (compile-to-bytecode prog)
          (prn bc) ; for debugging
          (<arc>write bc tmp)))))
  ; run the bytecode (only for testing, will be removed in the future)
  (<arc>system:string "../src/hl --bc /tmp/hl-tmp"))

; front end to the bytecode compiler
; loads all the files and defines an entry function

; define the <hl> package and import functions and macros needed
; by the compiler from <arc>v3
; TODO: move in a file conditionally loaded only when bootstrapping
;       using hl-arc-f
(in-package hl)
(using <arc>v3)
; Should really use <hl>def, not just def, because def in this
; context will be <arc>def.  Same with <hl>type etc.
; Please see http://hl.webhop.net/item?id=103 ; I recommended
; using 3 sections, and specified which ones should specify
; specific packages, and which ones just use <arc> packages.
(interface v0 def mac if and no or each load string unpkg prn = w/infile
              let with withs fn afn require w/uniq coerce + push listtab
              givens make-br-fn ++ acons ssyntax isnt caris _ in type isa
              alist err is car cons cdr map orf awhen do trav+ when ontable
              list aif zap self rfn pos complement dotted len on
              index copy mappend cadr cddr len> it some assert given case
              >= > keep idfn rev - mem max mapeach atom bound rep apply
              ; types
              int num char table string sym bool)

(set <hl>unpkg <arc>unpkg)
(set <hl>ssyntax <arc>ssyntax)
(set <hl>pos <arc>pos)

; fix differences between the host and the target
; this is actually a superset, i.e. they do *at least* what their hl
; counterpart do
(mac <axiom>lambda (args . body)
  `(fn ,args ,@body))

(set <axiom>tag <arc>annotate)
(set <axiom>cons <arc>cons)
(set <axiom>i- -)
(set <axiom>i+ +)
(set <axiom>i* *)
(set <axiom>i< <)
(set <axiom>is is)
(set <axiom>cdr cdr)
(set <axiom>car car)

; the compiler package
(in-package compiler)
(using <hl>v0)

(interface v0 compile)

; this var tells if we are bootstrapping the compiler or not
(set bootstrap* t)
; tells if the host should eval the code before compiling it
; eval is needed to get macros to work while bootstrapping
; but the host doesn't support some things (mainly async I/O & processes)
(set stop-host-eval* nil)

; strictly, "compiled-and-executed-files"
(set files* '("structs.hl" "bytecodegen.hl"
              "quote-lift.hl" "utils.hl" "closures.hl" "cps.hl"
              "sharedvars.hl"  "xe.hl" "macex.hl"))
; need also *another* set of files for "compiled-only-but-not-executed-files"

; load all the files
(each f files*
  (load f))

; entry point
; return a 0 arg function that executes expr
;(def compile (expr)
;  (<axiom>assemble (compile-to-bytecode expr)))
; above doesn't actually make sense from within
; Arc-F, because Arc-F doesn't support <axiom>assemble.
; Maybe should be in the "compiled-but-not-executed"
; set of files

(using <read-cs-dir>v1)

(if (> (len <arc>argv) 1)
    ; called from the command line
    ; compile and run the program
    (<arc>w/infile in (<arc>argv 1)
      (= exprs* (<arc>readall in)))
    (do (= exprs* (read-cs-dir))
        (= stop-host-eval* t)))

(do
  (do
    (withs (exprs exprs*
            prog `((<axiom>lambda () ,@exprs)))
      (<arc>w/outfile tmp "/tmp/hl-tmp"
        ; not the best thing to do, pipe-to would be better if we had it
        ; put the default continuation
        (<arc>write '(<bc>k-closure 0
                       (<bc>debug-name final-return)
                       (<bc>check-vars 2)
                       (<bc>local 1)
                       (<bc>halt))
                    tmp)
        (prn "pre-eval")
        (each expr exprs
          ; for each expression, we compile it & then eval it
          ; when bootstrapping evaluation is done in the host
          ; and the compiled result is not executed
          ; WARNING: the *whole* file is evaluated before compilation
          ; takes place. This means that if a global var is redefined
          ; by the compiled code, during compilation only the last definition
          ; will be available. This shouldn't be a problem in practice.
          (if
            (and (isa expr 'sym) (is (unpkg expr) (unpkg '>stop-host-eval)))
              (set stop-host-eval* t)
            (and (isa expr 'sym) (is (unpkg expr) (unpkg '>start-host-eval)))
              (set stop-host-eval* nil)
            (and bootstrap* (no stop-host-eval*))
              (<arc>eval (<compiler>macex expr))))
        (prn "compile")
        (each bc (compile-to-bytecode prog)
          (prn bc) ; for debugging
          (<arc>write bc tmp)))))
  ; run the bytecode (only for testing, will be removed in the future)
  (<arc>system:string "../src/hl --bc /tmp/hl-tmp"))


more succinct version of parse-date suggested by Andrew Wilcox

(require "lib/lang.arc")

(def parse-date (str)
  (timedate
    (perl subprocess “
	  use Date::Language;
	  arcnum(Date::Language->new('English')->str2time(«str»));
	  ”))))

(load "lib/lang.arc")

(def parse-date (str)
  (timedate (int
	      (perl subprocess “
		    use Date::Parse;
		    use Date::Language;

		    my $lang = Date::Language->new('English');
		    my $time = $lang->str2time(«str»);
		    ”))))


old-tests.arc passing again

old-tests.arc passing again

;; unit tests in various styles prior to https://bitbucket.org/zck/unit-test.arc

(map load:string '(
    arc.arc.t.old
    lib/lru-cache.arc.t
    lib/tem.arc.t
))

; tests from conanite's rainbow
(load "lib/unit-test.arc")
(map load:string '(
    lib/tests/core-errors-continuations-test.arc
    lib/tests/core-evaluation-test.arc
    lib/tests/core-macros-test.arc
    lib/tests/core-predicates-test.arc
    lib/tests/core-special-forms-test.arc
    lib/tests/core-typing-test.arc
    lib/tests/foundation-test.arc
    lib/tests/misc-tests.arc
    ; currently failing; may be irrelevant to anarki
    ; lib/tests/parser-test.arc
))
(run-all-tests)

;; unit tests in various styles prior to https://bitbucket.org/zck/unit-test.arc
(map load:string '(
    arc.arc.t.old
    lib/lru-cache.arc.t
    lib/tem.arc.t

    ; tests from conanite's rainbow
    lib/tests/core-errors-continuations-test.arc
    lib/tests/core-evaluation-test.arc
    lib/tests/core-macros-test.arc
    lib/tests/core-predicates-test.arc
    lib/tests/core-special-forms-test.arc
    lib/tests/core-typing-test.arc
    lib/tests/foundation-test.arc
    lib/tests/misc-tests.arc
    ; currently failing; may be irrelevant to anarki
    ; lib/tests/parser-test.arc
))