devel/compiler/Compile.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

module Compile where

import AbsSrc
import AbsTgt
import SMacros
import TMacros

import Eval
import Param

import STM
import Env

import qualified Data.Map as M

compile :: Grammar -> Env
compile (Gr defs) = err error snd $ appSTM (mapM_ compDef defs) emptyEnv

compDef :: Def -> STM Env ()
compDef d = case d of
  DLin f ty exp -> do
    val <- eval exp
    addType f ty
    addVal f val
  DOper f ty exp -> do
    addType f ty
    addOper f exp
  DPar  p cs -> do
    v <- sizeParType cs
    let ty = TBas p
    addParsize ty $ fst v
    vals <- allParVals cs
    addPartype ty vals
    mapM_ (uncurry addParVal) (zip vals (map VPar [0..])) 
  DOpty a ty -> do
    addTypedef a ty